Version 5 of FORTRAN via open pipe

Updated 2002-10-02 11:41:41

Martin Lemburg - 02.10.2002:

To execute and control a FORTRAN executable I've chosen to use open this executable using a pipe. The only things to be done is to configure the resulting channel and to setup the event handlers for the events readable and/or writable. But ... it's true, it depends not on a FORTRAN executable, any executable could be handled like that.

I wrote a package named runExe. I need this package explicitely to control a FORTRAN executable doing calculations. This package works with an callback, which is called when ...

  • the execution of the executable should be prepared
  • the executable delivers text, input occurs
  • the executable needs text, output is needed
  • the execution of the executable is finished

The bold words above are the keywords the callback could rely on to determine, which mode is currently active.

The callback could contain substitutes (like bind callbacks), which are replaced before the execution of the callback:

  • %m = execution mode of the blocking command (prepare, input, output or finished)
  • %e = name of the executable (including all parameters)
  • %s = success flag (boolean)
  • %t = timeout flag (boolean)
  • %o = output variable contents
  • %O = name of the output variable

If the callback is called in the input mode, than to the callback retrieves as additional argument the text the executable delivered. So the callback should be written like this:

 proc executableCallback { ... args } {
   ...
 }

If the callback is called in the output mode, than the callback has to return the text to be send to the executable.


The usage:

Syntax:

runExe options ?arg arg ...?

runExe run executable mode blocking callback timeout ?outputvar?

Description:

Runs the executable in the r/w mode, application blocking or not, executing the callback (if not empty), caring for the timeout and storing all text retrieved from the executable in the given output variable.

Arguments:

  • executable - string or list containing the path of the executable and all parameters.
  • mode - the open mode, which can be r, r+, w or w+.
  • blocking - flag to specify if the application should be blocked during the execution. If the execution should block the application the callback must be specified.
  • callback - string or list defining a script to be used as callback during the preparation, input, output and at the end of the executable execution. Must be given if blocking is false.
  • timeout - double value specifying the timeout duration in seconds. if the value is 0, the timeout is disabled.
  • outputvar - name of a global variable to be used to store every output of the executable in.

Result:

  • In the blocking mode the return value is a boolean for a succeeded (true) or failed (false) execution. If a timeout occurs, than it returns false.
  • In the non-blocking mode it returns the process channel id of the created process

runExe stop pid

Description:

Stops the executable belonging to the given process channel id and cleans up the internal datastructures. Only needed if the executable is executed in the non-blocking mode.

Arguments:

  • pid - process channel id (result of an open with pipe)

Result:

  • none

runExe cleanup pid

Description:

Cleans up the internal datastructures. Only needed if the executable is executed in the non-blocking mode.

Arguments:

  • pid - process channel id (result of an open with pipe)

Result:

  • none

runExe running pid

Description:

Cleans up the internal datastructures. Only needed if the executable is executed in the non-blocking mode.

Arguments:

  • pid - process channel id (result of an open with pipe)

Result:

  • if the given process is still running, than the return value is true, otherwise false

Example:

 runExe run 

Here the pkgIndex.tcl code:

 package ifneeded runExe 1.0 [list source [file join $dir runExe.tcl]];

Here the package runExe code:

 uplevel #0 {
   global auto_path env;

   if {[lsearch -exact $auto_path [file dirname [info script]]] < 0} {
     lappend auto_path [file dirname [info script]];
   }

   package provide runExe 1.0;

   proc runExe {args} {
     if {![llength $args]} {
       error "runExe option ?arg arg ...?";
     }

     set options {run stop cleanup running};
     set option  [lindex $args 0];
     set args    [lrange $args 1 end];

     if {[set idx [lsearch -glob $options ${option}*]] >= 0} {
       return [eval runExe::[lindex $options $idx] $args];
     }

     error "bad option \"$option\": must be [join [linsert [join [lsort -dictionary $options] {, }] end-1 {or}]]";
   }
 }

 namespace eval ::runExe {
   variable executables;

   proc this {} "return [namespace current];";

   # proc run
   #
   # args
   #
   #  executable - name of the executable and all parameters
   #  mode       - access mode to the pipe to be created (r, r+, w, or w+)
   #  blocking   - flag to signal if this proc should wait until the executable
   #               is finished
   #  callback   - script to be executed to prepare the execution, to return input
   #               for the executable, to get output of the executable, to be the
   #               execution finish callback. Must be given, if blocking is disabled!
   #  timeout    - double value in seconds, 0 disables the timeout handler
   #  outputVar  - (optional) name of the name of a variable to contain the
   #               output of the executable
   #
   proc run {executable mode blocking callback timeout {outputVar ""}} {
     if {[lsearch -exact {r r+ w w+} $mode] < 0} {
       error "bad mode \"$mode\": must be r, r+, w, or w+";
     }

     if {![string is boolean -strict $blocking]} {
       error "expected valid boolean as blocking flag, but got \"$blocking\"";
     }

     if {![string is double -strict $timeout]} {
       error "expected valid double as timeout in seconds, but got \"$timeout\"";
     }

     if {!$blocking && ($callback == "")} {
       error "expected callback script, because blocking is disabled";
     }

     # (re)set the variable to store outputs of the executable in
     #
     if {$outputVar != ""} {
       global $outputVar;

       set $outputVar  "";
     }

     # do preparations to be done before starting the executable
     #
     if {$callback != ""} {
       execCallback $callback prepare $executable $blocking 0 0 $outputVar;
     }

     if {[catch {set pid [open "|$executable" r];} reason]} {
       error "couldn't run executable with \"$executable\": $reason";
     }

     # set the process related variables
     #
     set [this]::executables($pid.executable) $executable;
     set [this]::executables($pid.success)    -1;
     set [this]::executables($pid.blocking)   $blocking;
     set [this]::executables($pid.callback)   $callback;
     set [this]::executables($pid.after)      "";
     set [this]::executables($pid.timeout)    $timeout;
     set [this]::executables($pid.outputVar)  $outputVar;

     # start if wanted the timeout handler
     #
     if {$timeout} {
       set [this]::executables($pid.after) [after \
         [expr {int($timeout * 1000)}] \
         [list [this]::timeoutCB $pid] \
       ];
     }

     # configure the process channel
     #
     fconfigure $pid -buffering none -blocking 0;

     if {[lsearch {r r+ w+} $mode] >= 0} {
       fileevent $pid readable [list [this]::inCB $pid];
     }

     if {[lsearch {r+ w w+} $mode] >= 0} {
       fileevent $pid readable [list [this]::outCB $pid];
     }

     # let this proc wait if blocking is wanted
     # and set the return value depending on the blocking flag
     #
     if {$blocking} {
       if {[info commands tk] == ""} {
         vwait [this]::executables($pid.success);
       } else {
         tkwait variable [this]::executables($pid.success);
       }

       set result  [set [this]::executables($pid.success)];

       cleanup $pid;
     } elseif {!$blocking && ($callback != "")} {
       set result $pid;
     }

     return $result;
   }

   proc stop {pid} {
     if {[running $pid]} {
       finishCB $pid;
     }

     cleanup $pid;

     return;
   }

   proc cleanup {pid} {
     array unset [this]::executables $pid.*;

     return;
   }

   proc running {pid} {
     if {[array names [this]::executables $pid.*] == ""} {
       return 0;
     }

     if {([file channels $pid] == "") || [eof $pid]} {
       return 0;
     }

     return 1;
   }

   proc execCallback {callback mode executable blocking success timeout outputVar args} {
     # replace all substitutes for ...
     #    %m = execution mode of the blocking command (prepare, input, output or finished)
     #    %e = name of the executable (including all parameters)
     #    %s = success flag (boolean)
     #    %t = timeout flag (boolean)
     #    %o = output variable contents
     #    %O = name of the output variable
     #
     regsub -all -- {%m} $callback $mode callback;
     regsub -all -- {%e} $callback $executable callback;
     regsub -all -- {%b} $callback $blocking callback;
     regsub -all -- {%s} $callback $success callback;
     regsub -all -- {%t} $callback $timeout callback;
     regsub -all -- {%O} $callback $outputVar callback;

     if {$outputVar != ""} {
       global $outputVar;

       set output  [set $outputVar];
     } else {
       set output  "";
     }

     regsub -all -- {%o} $callback $output callback;

     # execute the blocking command (or callback)
     #
     return [uplevel #0 $callback $args];
   } 

   proc finishCB {pid {timeout 0}} {
     if {[set [this]::executables($pid.after)] != ""} {
       after cancel [set [this]::executables($pid.after)];
     }

     fileevent $pid readable {};
     fconfigure $pid -blocking 1;

     if {[catch {close $pid;}] || $timeout} {
       set [this]::executables($pid.success)  0;
     } else {
       set [this]::executables($pid.success)  1;
     }

     # set the output variable, if given
     #
     set outputVar  [set [this]::executables($pid.outputVar)];

     if {$outputVar != ""} {
       global $outputVar;

       set $outputVar  [join [set $outputVar] "\n"];
     }

     # execute the callback, if set
     #
     set callback  [set [this]::executables($pid.callback)];

     if {$callback != ""} {
       execCallback \
         $callback \
         finished \
         [set [this]::executables($pid.executable)] \
         [set [this]::executables($pid.blocking)] \
         [set [this]::executables($pid.success)] \
         $timeout \
         [set [this]::executables($pid.outputVar)];
     }

     return;
   }

   proc inCB {pid} {
     if {[eof $pid]} {
       finishCB $pid;
     } else {
       set outputVar  [set [this]::executables($pid.outputVar)];

       if {$outputVar != ""} {
         upvar #0 $outputVar dummy;
       }

       lappend dummy  [set output [read $pid]];

       execCallback \
         [set [this]::executables($pid.callback)] \
         output \
         [set [this]::executables($pid.executable)] \
         [set [this]::executables($pid.blocking)] \
         [set [this]::executables($pid.success)] \
         [set [this]::executables($pid.timeout)] \
         [set [this]::executables($pid.outputVar)] \
         $output;
     }

     return;
   }

   proc outCB {pid} {
     if {[eof $pid]} {
       finishCB $pid;
     } else {
       puts $pid [execCallback \
         [set [this]::executables($pid.callback)] \
         input \
         [set [this]::executables($pid.executable)] \
         [set [this]::executables($pid.blocking)] \
         [set [this]::executables($pid.success)] \
         [set [this]::executables($pid.timeout)] \
         [set [this]::executables($pid.outputVar)] \
       ];

       flush $pid;
     }

     return;
   }

   proc timeoutCB {pid} {
     if {[file channels $pid] != ""} {
       finishCB $pid 1;
     }

     return;
   }

   namespace export [list run stop cleanup running];
 }