# FILE: tempfile.tcl # # Instances of this class represent temporary files -- files created by # an application for some purpose, but which should not remain after the # application terminates. Oc_Class Oc_TempFile { common unique 0 common maxUnique 1000 # This proc is now unused -- its contents should be migrated into # suitable configuration feature rules. private proc DefaultDirectory {} { global tcl_platform env set result "." ;# In case all else fails if {[string match windows $tcl_platform(platform)]} { if {[info exists env(TEMP)] && [file isdirectory $env(TEMP)] \ && [file writable $env(TEMP)]} { return $env(TEMP) } if {[info exists env(TMP)] && [file isdirectory $env(TMP)] \ && [file writable $env(TMP)]} { return $env(TMP) } if {[info exists env(TMPDIR)] && [file isdirectory $env(TMPDIR)] \ && [file writable $env(TMPDIR)]} { return $env(TMPDIR) } if {[file isdirectory C:/TEMP] && [file writable C:/TEMP]} { return C:/TEMP } if {[file isdirectory C:/] && [file writable C:/]} { return C:/ } } else { ;# Assume Unix if {[info exists env(TMP)] && [file isdirectory $env(TMP)] \ && [file writable $env(TMP)]} { return $env(TMP) } if {[info exists env(TMPDIR)] && [file isdirectory $env(TMPDIR)] \ && [file writable $env(TMPDIR)]} { return $env(TMPDIR) } if {[info exists env(TEMP)] && [file isdirectory $env(TEMP)] \ && [file writable $env(TEMP)]} { return $env(TEMP) } if {[file isdirectory /tmp] && [file writable /tmp]} { return /tmp } } if {[file writable .]} { return . } error "Can't find a directory with permission to write a temporary file" } const public variable stem = _ const public variable extension = {} const public variable directory private variable absoluteName private variable fileHandle Constructor {args} { eval $this Configure $args if {![info exists directory]} { if {[catch {[Oc_Config RunPlatform] GetValue \ path_directory_temporary} directory]} { set directory [$class DefaultDirectory] } } set absoluteDir [file join [pwd] $directory] # Should force into absolute form. Cheap check for now. if {![string match absolute [file pathtype $absoluteDir]]} { error "Programming error: Temp filename $absoluteDir not absolute." } if {![file isdirectory $absoluteDir]} { set msg "Temporary directory '$absoluteDir' does not exist" error $msg $msg } set base [file join $absoluteDir $stem-[info hostname]-[pid]-] set start $unique while {1} { set try $base$unique$extension incr unique if {$unique >= $maxUnique} { set unique 0 } if {![file exists $try]} { break } if {$unique == $start} { error \ "Unable to construct unique temporary filename after $maxUnique tries." } } set absoluteName $try set fileHandle [open $absoluteName w+] } Destructor { if {[info exists fileHandle]} { catch {close $fileHandle} } if {[info exists absoluteName]} { file delete $absoluteName } } method AbsoluteName {} { return $absoluteName } }