# <20230906.1831.54>
# This bit of tcl is an attempt to put together a way to run child programs
# while still haveing a LOT of control over them.
#
# We use the tcl 'open |..' command to open a pipe to the given program.
# depending on the options given we then:
#   allow writing to the pipe to pass info to the program
#   provide a call back capability to process info from the program
#   provide a kill call to eliminate the program if needed.
#
# Commands provided:
#
# pipeoExec command options ?call back functions?
#
#           command is the command passed to open with a "|" in front
#                   it opens a pipe with stdin and stdout being here
#                   This command must direct stderr as desired.
#                   Stdout will be readable (option r). Possible options:
#                   2>/dev/null 2>@1 2>&1 (see tcl exec man page).
#                   (see below how to access these)
#           options is the option(s) passed to open. 'r' for read only
#                   "r+". Other options are possible, see open(n).
#                   If this is a VFS URL, the command is passed to
#                   that VFS code.
#           call back functions is a list of one or two functions
#                    which are called with info on the progress of
#                    the pipe. If only one function is given it will
#                    be called with all info.  It two are given the
#                    first (log) will be called with log information and
#                    the second (data) with data from the pipe.
#
#       pipeoExec returns a list of two values:
#                 if the first is 0, the second is the pipe 'handle'
#                 if the first in !0, the second is the error information
#                                     on why the pipe was not opened.
#
#       The data output (send to the data call back) will be one of:
#                'handle' data <data from the pipe>   ; data packet
#                'handle' eof                         ; eof encounterd
#                                                       or pipe is aborted, 
#                                                       pipe is closed
#       The log call back will be one of:
#                'handle' abort      ; if the pipe aborts for what ever reason
#                'handle' done       ; pipe completes, it is closed, 
#                                      eof message sent 
#                                      to the data call back
#                'handle' kill       ; kill was called on the pipe
#                'handle' kill-soft  ; soft-kill was called on the pipe
#
# puts handle <data to write>        ; handle is what was passed back on 
#                                     pipeoExec call
#
# pipeoSoftAbort handle   ; or      ; Sends SIGINT to the pipe process(es)
# pipeoAbort handle 1  
#
# pipeoAbort handle 2 (default is 2); Aborts the pipe process(es) 
#                                    (kill -15, kill -9)
#                                   ; and closes the pipe, 
#                                     will force the call backs

# Usually you may have to supply proper termination on lines sent to the pipe
# (\n or \r\n) or. But see the fcontrol(n) man page. 'handle' is the
#  channelId if you want to call fcontrol to set this.

# We use Tclx for kill.  We want an equivalent for windows so we won't try
# to write our own... well, actually we did. See killCode.tcl

namespace eval pipeoExec {
  variable {}
}


proc pipeoExec { cmd options {callback {puts puts}} } {
    
  if {$::tcl_platform(platform) == "unix"} {
    set cmd [regsub -all {\\} $cmd {\\\\}]
  } else {
    set cmd [regsub -all {\\\\} $cmd {\\}]
  }
  frputs cmd options
  set VFStok 0
  if {[IsVFS $options]} {
    lassign [VFSasyncCommand $VFStok $cmd ::pipeoExec::pipeoComplete] r fid
  } else {
    set r [catch {open "|[list {*}$cmd]" $options} fid]
     frputs "pipeoExec open  " cmd r fid
  }
  if {$r == 0} {
    # If only one callback function, double it so we don't need to
    # check later
    lassign $callback cb1 cb2
    set ::pipeoExec::($fid,log) $cb1
    set ::pipeoExec::($fid,data) [expr {$cb2 == {} ? $cb1 : $cb2}]
    set ::pipeoExec::($fid,remains) {}
    set ::pipeoExec::($fid,state) {}
    set ::pipeoExec::($fid,busy) 0
    set ::pipeoExec::($fid,vfs) $VFStok
    # lappend ::pipeoExec::pipeoExParms [list $fid $callback]
    if {$VFStok == 0} {
      fconfigure $fid -buffering line
      fconfigure $fid -blocking 0
      fconfigure $fid -translation auto
      # schedule the completer...
      set rr [catch {chan event $fid readable\
		       "::pipeoExec::pipeoComplete $fid"} out]
      # frputs "pipeoExec: open success completion set  " rr out
    }
  }
  return [list $r $fid]
}

# Because the call back routines have the option of "waiting" it
# is possible and even likely that pipeoComplete will be re-entered.
# So, we make this a 2 step process.
# Step 1, collect and store the data. And if the handler (step 2)
#         is free, call it via "after 0" (to prevent our (step 1)
#         re-entry.
# Step 2, Keep a global busy flag and set about calling the call backs
#         as needed. This call may run out of data prior to the
#         end of the operation (channel close).
# This should eliminate the need for the call back routine to deal
# with reentry (and attendant data re-ordering).

proc ::pipeoExec::pipeoComplete {fid args} {
  variable {}
  
  # This is step 1. We keep the data in "remains" and completion flags
  # in state which will have one of three values: nil (still active),
  # "abort" (something went wrong), and "done"
  # frputs #1 #2 #3 #4 #5 #6 ::pipeoExec::($fid,log)
  if {![info exists ::pipeoExec::($fid,log)]} {
    error "pipeoComplete called but handle '$fid' is not an active handle."
  }
  if {[set vfs $::pipeoExec::($fid,vfs)] != 0} {
    if {[lindex $args 0] == "data"} {
      append ::pipeoExec::($fid,remains) [lindex $args 1]
    } else {
      set ::pipeoExec::($fid,state) "done"
    }
  } else {
    # Add new data to the remains. This is just a string which we
    # assume has new-lines in it. It is possible we will get any part
    # including bits between new-lines...
    set out ""
    set r [catch {set out [read $fid]} er]
    append ::pipeoExec::($fid,remains) $out
    frputs out ::pipeoExec::($fid,remains)
    if {$r || [catch {eof $fid} dr] != 0 || $dr} {
      
      # A bit of a problem we address here.  If the other side is fast
      # by the time we get around to reading, there may be more than
      # one line waiting.  Not only that, it is possible that the
      # last part of such a line is a fragment of the next line.
      # So, we split the line into records ending in "\n" here
      # and put any remains as the third entry in the pipeoExParms list
      catch {close $fid}
      #eval {*}$data $fid eof
      set ::pipeoExec::($fid,state) [expr {$r ? "abort" : "done"}]
    }
  }
  if {$::pipeoExec::($fid,busy) == 0} {
    set ::pipeoExec::($fid,busy) 1
    frputs ::pipeoExec::($fid,busy)
    after 0 ::pipeoExec::doCallBacks $fid
  }
}

proc ::pipeoExec::doCallBacks {fid} {
  upvar #0 ::pipeoExec::($fid,remains) remains
  upvar #0 ::pipeoExec::($fid,state) state
  upvar #0 ::pipeoExec::($fid,busy)  busy
  upvar #0 ::pipeoExec::($fid,data)  data
  if {![info exists busy] || $busy != 1} {
    puts $busy $remains $state $data $pipeoExec::($fid,busy)
    error "pipeoExec callback function called when not available"
  }
  if {$remains != ""} {
    # Here we split the lines on "\n".  Must use string code to
    # avoid nasty embeded special chars like {} [] and $ .
    # We also want to make this atomic with respect to remains and
    # the call back. This allows data to be added to remains
    # during a call back.
    while {[set eos [string first "\n" $remains]] != -1} {
      set line [string range $remains 0 $eos]
      set remains [string range $remains $eos+1 end]
      eval {*}$data $fid data {$line}
      frputs line remains
    }
  }
  # The data buffer is all sent except for a possible final bit
  # that does not have a new-line.
  # If the state is still nil, we are done
  if {$state != {}} {
    # frputs r er
    # We have an eof or abort indication, in any case there
    # will be no more data ...
    # if we have left over chars in remains...
    if {$remains != {}} {
      eval {*}$data $fid data {$remains}
    }
    if {[catch {eval {*}$data $fid eof} er] != 0} {frputs data er}
    if {[info exists ::pipeoExec::($fid,log)]} {
      set r [catch { {*}$::pipeoExec::($fid,log) $fid $state} er]
      if {$r != 0} {frputs er}
    }
    # Return the resources...
    array unset ::pipeoExec:: $fid,*
    after cancel ::pipeoExec::doCallBacks $fid
    return
  }
  set busy 0
  return
}

proc pipeoSoftAbort {fid} {
  pipeoAbort $fid 1
}

proc pipeoAbort {fid {soft 2}} {
  if {![info exists ::pipeoExec::($fid,log)]} {
    frputs "pipeoAbort called but $fid is not an active channel "
    return
  }
  # set id [lsearch -exact -index 0 $::pipeoExec::pipeoExParms $fid]
  # if {$id == -1} {
  #   return
  # }
  # lassign [lindex $::pipeoExec::pipeoExParms $id 1] log rtnv
  set s [expr {$soft == 0 ? "" : "-soft"}]
  if {[info exists ::pipeoExec::($fid,vfs)] &&\
	  $::pipeoExec::($fid,vfs) != 0} {
    VFSasyncKill $::pipeoExec::($fid,vfs) $fid
  } else {
    #array unset ::pipeoExec::pipeoExParms $fid,*
    catch {
      set pid [pid $fid]
      # We do both the sigterm and the kill, just to make sure...
      # if there is no tcl kill the system program will be called
      # it has a different parameter set to id the signal...
      kill $pid
      close $fid
    }
  }
  if {[catch {{*}$::pipeoExec::($fid,log) $fid kill$s} er] != 0} {
    frputs er
  }
  ::pipeoExec::pipeoComplete $fid
}

# Here is an exec call replacement using pipeo. The point is that
# the code does no-wait I/O, giving up the processor to the idle
# loop and other async tasks while waiting for the program to
# finish.

proc asyncExec {cmd args} {
  # set rtn [pipeoExec [frECF $cmd $args -f 1] r [list ::pipeoExec::asyncLog]]
  frputs cmd args
  set cmd [auto_execok $cmd]
  if {$cmd == {}} {
    return -code error "Can not find windows command: $cmd"
  }
  frputs cmd args
  set rtn [pipeoExec "$cmd $args" r [list ::pipeoExec::asyncLog]]
  lassign $rtn wh key
  if {$wh != 0} {
    return -code error $key
  }
  set ::pipeoExec::asyncState$key 0
  set ::pipeoExec::asyncData$key {}
  
  vwait ::pipeoExec::asyncState$key
  set rtn [set ::pipeoExec::asyncData$key]
  unset ::pipeoExec::asyncData$key
  unset ::pipeoExec::asyncState$key
  return $rtn
}

proc ::pipeoExec::asyncLog {Key why args} {
  switch -exact $why {
    data {append ::pipeoExec::asyncData$Key {*}$args}
    eof  -
    done -
    kill -
    kill-soft {incr ::pipeoExec::asyncState$Key }
  }
}
