Martin S. Weber
Ephaeton at gmx dot net Homepage still under construction :)
Wiki stuff:
Next to come:
This is for suchenwi/ tcl chatroom:
set ::bexec_runs 0
set ::bexec_result ""
set ::bnum 0
proc bexec what {
global bexec_runs bexec_result bnum
incr bnum
set fname [file join $::env(HOME) tmp cmd_run_lock_$::env(USER)_[pid]]
while {[catch {set fp [open $fname {WRONLY CREAT EXCL}]}]} {
puts stderr "($bnum) Lock busy, will retry."
after 200 "set ::retry 0"
vwait ::retry
}
puts stderr "($bnum)Got the Lock for \"[string range $what 0 99]...\"."
# reset results
set ::bexec_result ""
puts stderr "Executing $what..."
set bexec_runs 1
set f [open |$what]
#fconfigure $f -translation none
fileevent $f readable [list bexec_read $f]
vwait bexec_runs
file delete -force [file join $::env(HOME) tmp cmd_run_lock_$::env(USER)_[pid]]
puts stderr "($bnum)Released the Lock for \"[string range $what 0 99]...\"."
return $bexec_result
}
proc bexec_read {f} {
set data [read $f]
if [eof $f] {
close $f
set ::bexec_runs 0
}
append ::bexec_result $data
}
# demo1:
set tfile [open tst.sh w]
puts $tfile {#!/bin/sh
echo "output1"
sleep 3
echo "output2"}
close $tfile
puts [bexec "sh tst.sh"]
puts [bexec "sh tst.sh"] ;# <-- this one will wait.
# demo2:
pack [button .b -text "run" -command {puts [bexec "sh tst.sh"]}] -expand 1 -fill bothOutput:
(1)Got the Lock for "sh tst.sh...". (1)Executing sh tst.sh... (1)Released the Lock for "sh tst.sh...". output1 output2 (2)Got the Lock for "sh tst.sh...". (2)Executing sh tst.sh... (2)Released the Lock for "sh tst.sh...". output1 output2 (3)Got the Lock for "sh tst.sh...". (3)Executing sh tst.sh... (3)Released the Lock for "sh tst.sh...". output1 output2 (4)Got the Lock for "sh tst.sh...". (4)Executing sh tst.sh... (5) Lock busy, will retry. (6) Lock busy, will retry. (6) Lock busy, will retry. (6) Lock busy, will retry. (6) Lock busy, will retry. (6) Lock busy, will retry. (6) Lock busy, will retry. (6) Lock busy, will retry. (6) Lock busy, will retry. (6) Lock busy, will retry. (6) Lock busy, will retry. (6) Lock busy, will retry. (6) Lock busy, will retry. (6) Lock busy, will retry. (6) Lock busy, will retry. (6) Lock busy, will retry. (6) Lock busy, will retry. (6) Lock busy, will retry. (6) Lock busy, will retry. (6) Lock busy, will retry. (6) Lock busy, will retry. (6) Lock busy, will retry. (6) Lock busy, will retry. (6) Lock busy, will retry. (6) Lock busy, will retry. (6) Lock busy, will retry. (6) Lock busy, will retry. (6) Lock busy, will retry. (6) Lock busy, will retry. (6) Lock busy, will retry. (6) Lock busy, will retry. (6) Lock busy, will retry. (6) Lock busy, will retry. (6) Lock busy, will retry. (6) Lock busy, will retry. # ad infitum... lockfile never goes away.
DKF VERSION
set ::bexec_runs 0
set ::bexec_result ""
set ::bnum 0
proc bexec {what handler {uid -1}} {
global bexec_accum bnum
if {$uid == -1} {
set uid [incr bnum]
}
set fname [file join ~ tmp cmd_run_lock_[pid]]
if {[catch {open $fname {WRONLY CREAT EXCL}} fp]} {
puts stderr "($uid) Lock busy, will retry."
after 200 [list bexec $what $handler $uid]
return
}
set f [open |$what]
set bexec_accum($uid) {}
fileevent $f readable [list bexec_read $f $uid $fname $handler]
}
proc bexec_read {f uid fname handler} {
global bexec_accum
if {[gets $f line] == -1} {
close $f
file delete -force $fname
uplevel #0 $handler [list $bexec_accum($uid)]
unset bexec_accum($uid)
return
}
append bexec_accum($uid) $line \n
}
# demo1:
set tfile [open tst.sh w]
puts $tfile {#!/bin/sh
echo "output1"
sleep 3
echo "output2"}
close $tfile
bexec "sh tst.sh" puts
bexec "sh tst.sh" puts ;# <-- this one will wait.
# demo2:
pack [button .b -text "run" -command {bexec "sh tst.sh" puts}] -expand 1 -fill both
Output:
(2) Lock busy, will retry. (2) Lock busy, will retry. (2) Lock busy, will retry. (2) Lock busy, will retry. (2) Lock busy, will retry. (2) Lock busy, will retry. (2) Lock busy, will retry. (2) Lock busy, will retry. (2) Lock busy, will retry. (2) Lock busy, will retry. (2) Lock busy, will retry. (2) Lock busy, will retry. (2) Lock busy, will retry. (2) Lock busy, will retry. (2) Lock busy, will retry. output1 output2 output1 output2 (4) Lock busy, will retry. (4) Lock busy, will retry. (4) Lock busy, will retry. (4) Lock busy, will retry. (4) Lock busy, will retry. (4) Lock busy, will retry. (4) Lock busy, will retry. (4) Lock busy, will retry. (4) Lock busy, will retry. (4) Lock busy, will retry. (4) Lock busy, will retry. (4) Lock busy, will retry. (4) Lock busy, will retry. (4) Lock busy, will retry. output1 output2 (5) Lock busy, will retry. (5) Lock busy, will retry. (5) Lock busy, will retry. output1 output2 output1 output2