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