jbr.tcl/execbg.tcl at main · jbroll/jbr.tcl · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149


proc _execbg { file } {
    upvar #0 $file F

    if { [eof $file] } {
        global $F(waitName)

        if { [string compare $F(dataName) {}] } {
            global $F(dataName)
            global $F(incrName)

            if { ![string compare $F(trim) {}] } {
                set $F(dataName) $F(incrName)
            } else {
                set $F(dataName) [string $F(trim) [set $F(incrName)]]
            }
        }

        close $file

        if { [file size $F(errFile)] } {
            if { [string compare $F(errName) {}] } {
                global $F(errName)

                set efile [open $F(errFile)]

                if { ![string compare $F(trim) {}] } {
                    set $F(errName) [read $efile]
                } else {
                    set $F(errName) [string $F(trim) [read $efile]]
                }
                close $efile
            }
            set $F(waitName) 1
        } else  {
            set $F(waitName) 0
        }
        file delete $F(errFile)
    } else {
        global $F(incrName)

        if { [string compare $F(incrName) {}] } {
            append $F(incrName) [read $file]
        } else {
            puts -nonewline [read $file]
        }
    }
}

set execbg 1

proc execbg { waitName args } {
    global $waitName
    global execbg

    while { [file exists [set errFile "/tmp/execbg[incr execbg].err"]] } { }

    set  errName {}
    set dataName {}
    set incrName {}

    set trim	 trim
    set trap	 0
    set wait	 0

    set eoo 0
    set command |
    for { set i 0 } { $i < [llength $args] } { incr i } {
        set arg [lindex $args $i]

        if { !$eoo } {
            switch -regexp -- $arg {
            -keepnewline 	{ set trim {} }
            -trim 	        { set trim     [lindex $args [incr i]] }
            -output 	{ set dataName [lindex $args [incr i]] }
            -onoutput 	{ set incrName [lindex $args [incr i]] }
            -error 		{ set  errName [lindex $args [incr i]] }
            -- 		{ set eoo  1 }
            -trap		{ set trap 1 }
            -wait		{ set wait 1 }
            "-.*" 		{
                error "execbg: unknown option: $arg"
            }
            ".*" {
                lappend command $arg
                    set eoo 1
            }
            }
        } else {
            lappend command $arg
        }
    }

    lappend command 2> $errFile

    print $command
    set file [open $command r]
    global $file

    if { [string compare $dataName {}] } {
    	global $dataName;  set $dataName {}

        if { ![string compare $incrName {}] } {
            set incrName _$dataName
        }
    }
    if { [string compare $incrName {}] } {
        global $incrName;  set $incrName {}
    }

    set ${file}(waitName) $waitName
    set ${file}(dataName) $dataName
    set ${file}(incrName) $incrName

    set ${file}(errFile)  $errFile
    set ${file}(errName)  $errName

    set ${file}(trim)	  $trim
    set ${file}(trap)	  $trap

    fconfigure $file -translation binary -blocking no
    fileevent $file r [list _execbg $file]

    if { $wait } {
        if { $trap && ![string compare $errName {}] } {
            set errName [set ${file}(errName) $errFile]
        }
        vwait $waitName
        if { $trap && [set ::$waitName] } {
            set err [set ::$errName]

            catch { unset ::${file}(errFile) }
            error $err
        }
    } else {
        return [pid $file]
    }
}

if { 0 } {
    set data {}
    execbg data -output wink runme zero dink

    vwait data
    puts "output: $wink"
    puts "status: $data"
    if { $data } { puts $errs }
}