Posted to tcl by DS at Tue Nov 23 16:39:32 GMT 2010view raw

  1. #---------------------------------------------------------------------------------------------------
  2. proc lock {local_file_name {timeout 1000}} {
  3. set ms 0
  4. while {[catch {
  5. set file [open $local_file_name {CREAT RDWR EXCL}]
  6. close $file
  7. }]} {
  8. incr ms
  9. if {$ms > $timeout} {
  10. log [namespace current] {expired lock} $local_file_name
  11. file delete $local_file_name
  12. set timeout 0
  13. } else {
  14. after 1
  15. }
  16. }
  17. }
  18. #---------------------------------------------------------------------------------------------------
  19. proc unlock {local_file_name} {file delete $local_file_name}
  20.