1# mutl.tcl - messaging utilities
2#
3# (c) 1999 Marshall T. Rose
4# Hold harmless the author, and any lawful use is allowed.
5#
6
7
8package provide mutl 1.0
9
10
11namespace eval mutl {
12    namespace export exclfile tmpfile \
13                     firstaddress gathertext getheader
14}
15
16
17proc mutl::exclfile {fileN {stayP 0}} {
18    global errorCode errorInfo
19
20    for {set i 0} {$i < 10} {incr i} {
21        if {![catch { set xd [open $fileN { RDWR CREAT EXCL }] } result]} {
22            if {(![set code [catch { puts $xd [expr {[pid]%65535}]
23                                     flush $xd } result]]) \
24                    && (!$stayP)} {
25                if {![set code [catch { close $xd } result]]} {
26                    set xd ""
27                }
28            }
29
30            if {$code} {
31                set ecode $errorCode
32                set einfo $errorInfo
33
34                catch { close $xd }
35
36                file delete -- $fileN
37
38                return -code $code -errorinfo $einfo -errorcode $ecode $result
39            }
40
41            return $xd
42        }
43        set ecode $errorCode
44        set einfo $errorInfo
45
46        if {(([llength $ecode] != 3) \
47                || ([string compare [lindex $ecode 0] POSIX]) \
48                || ([string compare [lindex $ecode 1] EEXIST]))} {
49            return -code 1 -errorinfo $einfo -errorcode $ecode $result
50        }
51
52        after 1000
53    }
54
55    error "unable to exclusively open $fileN"
56}
57
58proc mutl::tmpfile {prefix {tmpD ""}} {
59    global env
60    global errorCode errorInfo
61
62    if {(![string compare $tmpD ""]) && ([catch { set tmpD $env(TMP) }])} {
63        set tmpD /tmp
64    }
65    set file [file join $tmpD $prefix]
66
67    append file [expr {[pid]%65535}]
68
69    for {set i 0} {$i < 10} {incr i} {
70        if {![set code [catch { set fd [open $file$i \
71                                             { WRONLY CREAT EXCL }] } \
72                              result]]} {
73            return [list file $file$i fd $fd]
74        }
75        set ecode $errorCode
76        set einfo $errorInfo
77
78        if {(([llength $ecode] != 3) \
79                || ([string compare [lindex $ecode 0] POSIX]) \
80                || ([string compare [lindex $ecode 1] EEXIST]))} {
81            return -code $code -errorinfo $einfo -errorcode $ecode $result
82        }
83    }
84
85    error "unable to create temporary file"
86}
87
88proc mutl::firstaddress {values} {
89    foreach value $values {
90        foreach addr [mime::parseaddress $value] {
91            catch { unset aprops }
92            array set aprops $addr
93
94            if {[string compare $aprops(proper) ""]} {
95                return $aprops(proper)
96            }
97        }
98    }
99}
100
101proc mutl::gathertext {token} {
102    array set props [mime::getproperty $token]
103
104    set text ""
105
106    if {[info exists props(parts)]} {
107        foreach part $props(parts) {
108            append text [mutl::gathertext $part]
109        }
110    } elseif {![string compare $props(content) text/plain]} {
111        set text [mime::getbody $token]
112    }
113
114    return $text
115}
116
117proc mutl::getheader {token key} {
118    if {[catch { mime::getheader $token $key } result]} {
119        set result ""
120    }
121
122    return $result
123}
124