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