iTCL

[darkone]

lockobject
open <lockname> <event/semaphore/spinlock> [autoreset value/semaphore count]
- returns lockId on success, 0 on error. If lock does exist, new lock is created
wait <lockId> <timeout/spincount> [wait count]
- returns 0 on success, 1 on timeout, -1 on error. Optional argument wait count is used by semaphores.
set <lockId> [set count]
- returns 0 on success, -1 on error. Optional argument set count is used by semaphores.
reset <lockId> [reset count]
- returns 0 on success, -1 on error. Optional argument wait count is used by semaphores.
delete <lockId>
- returns 0 on success, -1 on error
close <lockId>

*Note* Using invalid lockId results to daemon crash.

Sample code:


set filename "c:/tcltest"
## Sample for synchronized file access using global lock
if { [catch { set fd [open $filename "RDWR CREAT"]}] == 0 } {
## Open wait object
if { [catch { set wo [waitobject open "my_global_lock" event true]}] == 0 } {
## Wait for wait object (5000ms)
if { [catch { set result [waitobject wait $wo 5000]}] == 0 && $result == 0 } {
## Do stuff...
iputs "$filename is now open & locked"
## Release wait object
waitobject set $wo
}
waitobject close $wo
}
close $fd
}

## Something more advanced; using semaphore to allow multiple simultanous reads on file
if { [catch { set fd [open $filename "RDWR CREAT"]}] == 0 } {
## Open wait object
if { [catch { set wo [waitobject open "my_semaphore" semaphore 1000]}] == 0 } {
## We want to read
if { [catch { set result [waitobject wait $wo 5000]}] == 0 && $result == 0 } {
## Do stuff...
iputs "$filename is now open, and locked for reads"
## Release wait object
waitobject set $wo
}
## Now we want to write
if { [catch { set wo2 [waitobject open "my_event" semaphore 1000]}] == 0 } {
if { [catch { set result [waitobject wait $wo2 5000]}] == 0 && $result == 0 } {
if { [catch { set result [waitobject wait $wo 5000 1000]}] == 0 && $result == 0 } {
iputs "$filename is now open, and locked for writes"
waitobject set $wo 1000
}
waitobject set $wo2
}
waitobject close $wo2
}
waitobject close $wo
}
close $fd
}

[b>d>>s]

w0w0w0

thanks :)