namespace eval lock {
variable timeout 250; # 250ms standard-time to wait for lock and do locked operations; 0=no time limit
variable lockfile [file join $::env(temp) "[pid].lock"]
variable wait
proc acquireLock [list "timeout $timeout" "lockfile $lockfile"] {
set trystart [clock clicks -milliseconds]
while {[clock clicks -milliseconds] - $trystart < $timeout || $timeout == 0} {
if {![catch {open $lockfile {WRONLY CREAT EXCL}} rc]} {
puts $rc "locked by pid [pid] at [clock format [clock seconds]]"
flush $rc
return [list $rc $lockfile]
}
after 10 set lock::wait 1
vwait lock::wait
}
return -code error "Error: timeout after $timeout ms"
}
proc releaseLock {info} {
if {![catch {fconfigure [lindex $info 0]}]} {
if {![catch {
close [lindex $info 0]
file delete -force [lindex $info 1]
# only after file is deleted, a new open...WRONLY CREAT EXCL is possible!
} rc]} {
return ""
} else {
return -code error "Error releasing lockfile: '$rc'"
}
} else {
return "kein gültiger Lock, ignoriert"
}
}
proc withLock {code} {
# standard options take place, use ::vars to change behaviour
if {![catch {acquireLock} rc]} {
uplevel $code
catch {releaseLock $rc}
}
}
}Tests