# execcmd.tcl ---
# -------------------------------------------------------------------------
#  Copyright (c) 2009  Johann Oberdorfer, [email protected]
#  This source file is distributed under the BSD license.
#
#  $Id: execcmd.tcl,v0.1 2009/06/20 12:00:00 job Exp $
# -------------------------------------------------------------------------
# PURPOSE:
#
#   execcmd - A helper package to simplify the execution of programs and
#   batch files  which are distributed within (*)starpacks.
#   To execute such files, they need to be copied out from vfs into a
#   temporary directory beforehand.
#
# DESCRIPTION:
#   The following logic is implemented:
#
#   - determine, if the command is:
#
#       - a command, which is provided within the (*)starpack currently
#         running, and if so,
#            - recursively scan the starpack starting from the
#              vfs root or from a given entry point, within the current
#              starpack, specified by the argument -vfsroot
#              to find the rel.location 
#            - then, copy the executable (which can be of any kind,
#              typically a .tcl, .sh, .bat, .exe, ...) out of the vfs
#              into a temporary directory on your local hard disk
#            - and finally, execute it from here,
#            - after a delay, delete the local copy again
#
#         if no starpack / no vfs avail, fallback to:
#
#       - an external appl. and if so,
#            - check with auto_execok, it is directly executeable,
#            - append the -exeprefix to the executable's name and try
#              again to evaluate execution !
#
# SYNOPSIS:
#
#   execcmd ?options? exec_command
#
# OPTIONS:
#
#   -vfsroot ... vfs directory, from where to start searching to find
#                the specified executable
#                default = "", in this case, the complete vfs
#                starting from ::starkit::topdir is processed
#   -exeprefix . additional directory outside vfs which is used as prefix,
#                in case the executable can't be found neither in vfs nor
#                with auto_execok
#   -tempdir ... where to store a temporary copy of the executable
#                default = "", in this case, the "standard" dir
#                (os dependant) is used
#   -wishcmd ... for windows only and only relevant if a .tcl is to be
#                executed, specify your own wish binary executable
#                default = "", in this case, wish needs to be part of your
#                current PATH environment variable!
#
#  exec_command  a list, to specify system command + arguments
#                which is going to be executed
# EXAMPLE CALL:
#
#      use "list" to prevent from backslash substitution on windows:
#
#      eval ::execcmd::execcmd \
#              -vfsroot   [list $CONFIG_DIR] \
#               -exeprefix ""  \
#              -wishcmd   "" \
#              $exec_command &
#
# -------------------------------------------------------------------------
# Mod.History:
# June 09, Johann Oberdorfer, V0.1, initial release
# -------------------------------------------------------------------------

package provide execcmd 0.1


namespace eval ::execcmd:: {
  variable options
  variable tempDir
  variable delDelay 800
  variable debug_mode 0

  namespace export execcmd

  # valid options / default settings
  # -wishcmd is only required on windows
  array set options {

        -vfsroot   ""
        -exeprefix ""
        -tempdir   ""
        -wishcmd   ""
  }
}


##  -- unused right now --
 #  a workaround for "file normalize" under windows
 ##
proc ::execcmd::ShortName {fullPathName} {

  if { $::tcl_platform(platform) eq "windows" } {
     if { [catch {file attributes $fullPathName} attr] == 0 &&
          [set idx [lsearch -exact attr "-shortname"]] != -1 } {
       return [lindex $attr [expr {$idx + 1}]]
     }
  }

  if {[file exists $fullPathName]} {
    return [file normalize $fullPathName]
  }

  return $fullPathName
}


##
 #  determine, where to store temporary files...
 #  to-do: fileutil offers a function for temporary storage handling
 #        -> might be a good candidate ?!
 ##

proc ::execcmd::SetTempDir {} {
  switch -- $::tcl_platform(platform) {
    "windows"        { set tempDir $::env(TEMP) }
    "unix" - default { set tempDir "/tmp" }
  }
  return $tempDir
}

##
 # a helper function to remove all occurences of a
 # given option/value pair from an argument list,
 # returns the modified argument list,
 # and the option value is passed pack by reference in val
 ##

proc ::execcmd::GetArgument {args keystr val} {
  upvar $val cvalue

  set cvalue ""
  while {[set i [lsearch -exact $args $keystr]] >= 0} {
     set j [expr {$i + 1}]
     set cvalue [lindex $args $j]
     set args [lreplace $args $i $j]
  }
  return $args
}

##   recursively search within vfs for a given file name
 #   note: a vfs acts like a normal file system.
 #         except file normalize doesn't seem to work...
 ##
 
proc ::execcmd::VFSFileFind {searchDir fileName} {
  variable _dirCache
  variable _fileFind
  if { ![info exists _dirCache] } { set _dirCache {} }
  if { ![info exists _fileFind] } { set _fileFind "" }

  # return/start condition
  if { [file tail $fileName] == $_fileFind } {
      return $_fileFind
  } else {
      set _fileFind ""
  }

  # try to find file name in cache list:
  foreach f $_dirCache {
    if { [file tail $f] == $fileName } {
      set _fileFind $f
      return $_fileFind
    }
  }

  foreach item [glob -nocomplain -- [file join $searchDir "*"]] {
    # puts $item
    if { [file isdirectory $item] } {
         VFSFileFind $item $fileName
         continue
    } else {
         # puts "--> [file tail $item] == $fileName"
         # maintain cache list:
          if { [lsearch $_dirCache $item] == -1 } {
             lappend _dirCache $item
         }
         # try to find file:
         if { [file tail $item] == $fileName } {
           set _fileFind $item
           return $item
         }
    }
  }

  return $_fileFind
}


proc ::execcmd::exec_now { args rcode rc } {
  upvar $rcode _rcode
  upvar $rc _rc
  variable options
  variable debug_mode

  set fileExt  [file extension [lindex $args 0]]

  if { $debug_mode } {
     puts \
"--> Status prior to exec:
       vfs Root Dir:          $options(-vfsroot)

       Execution command:     $args
       File extension:        $fileExt
"
     catch {console show}
  }
  
  switch -- $::tcl_platform(platform) {
    "windows" {

        switch -- [string tolower $fileExt] {
          ".tcl" {
             # executing script, using tcl/tk' wish.exe 

             # prevents from backslash substitution
             # which otherwise might happen for WISHCMD string
             # which is a qualified WIN directory string like 
             #    "x:\mypath\to\command..."
             set _rcode [catch {eval exec [file normalize $options(-wishcmd)] $args} _rc]
          }
          ".bat" - ".exe" - default {
             set _rcode [catch {eval exec $args} _rc]
          }
        }
    }
    "unix" - default {
        set _rcode [catch {eval exec $args} _rc]
    }
  }

}


##
 # exec command implementation
 #
 ##

proc ::execcmd::execcmd {args} {
  variable options  
  variable delDelay
  variable tmpExecName ""
  variable debug_mode

  # argument processing comes 1st:
  # ------------------------------
  set args [GetArgument $args "-vfsroot" vfsRoot]
  set args [GetArgument $args "-exeprefix" exeprefix]
  set args [GetArgument $args "-tempdir" tempDir]
  set args [GetArgument $args "-wishcmd" wishcmd]

  if { [string length $vfsRoot] && [file isdirectory $vfsRoot] } {
      set options(-vfsroot) $vfsRoot
  }

  if { [string length $exeprefix] && [file isdirectory $exeprefix] } {
      set options(-exeprefix) $exeprefix
  }

  if { ![string length $tempDir] } {
      set options(-tempdir) [SetTempDir]
  }

  if { [string length $wishcmd] != "" } {
      set options(-wishcmd) $wishcmd
  } else {
      if { $::tcl_platform(platform) eq "windows"} {
         # a guess, no guarantee that it 'll work:
         # (has been left untested for the moment)
         set options(-wishcmd) [auto_execok "wish.exe"]
    }
  }

  if { ![string length $options(-vfsroot)] &&
        [info exists ::starkit::topdir] &&
        [file isdirectory $::starkit::topdir] } {

     set options(-vfsroot) $::starkit::topdir
  }

  # ------------------------------

  set execFullPath [lindex $args 0]
  set execName [file tail $execFullPath]

  if { $debug_mode } {
     puts \
"--> execFullPath ... \"$execFullPath\"
     execName ....... \"$execName\""
  }

  # -- if vfs is avail, then check out,
  #    if the executable is available the vfs file system:
  
  if { [string length $options(-vfsroot)] } {

      # ----------------------------------------------------------
      set _execFullPath [VFSFileFind $options(-vfsroot) $execName]
      # ----------------------------------------------------------

      if { $_execFullPath != "" } {
          # o.k. carry on with executing the file:

           if { $debug_mode } {
              puts "--> Executable \"$execName\" is available in the vfs!"
           }

           if {[catch {file copy -force -- $_execFullPath $options(-tempdir)} rc]} {
               return -code error $rc
           }

           set tmpExecName [file join $options(-tempdir) [file tail $_execFullPath]]

           # setting the executable flag is only required on unix:
           if { $::tcl_platform(platform) eq "unix" &&
                [catch {file attribute $tmpExecName -permissions +x} rc]} {
               return -code error $rc
           }

           set args [lreplace $args 0 0 $tmpExecName]
           # lset args 0 $tmpExecName

           exec_now $args rcode rc

           # cleanup:
           if { !$debug_mode && [string length $tmpExecName] } {
               after $delDelay {
                 catch {file delete -force -- $::execcmd::tmpExecName}
              }
           }

           # return PID / return code ...
           return -code $rcode $rc

      } else {
          if { $debug_mode } {
             puts "--> Executable \"$execName\" is not available in the vfs!"
          }
      }
  }

  # -- determine, if the command is an external appl.,
  #    but is *not* available in the temp dir (!)
  #    and if so, execute it directly

  set exeDir [file normalize [file rootname $execFullPath]]
  set exeDir [string range $exeDir 0 [expr {[string length $options(-tempdir)] - 1}]]

  if { $exeDir != $options(-tempdir) && [auto_execok $execName] != "" } {

      exec_now $args rcode rc
      return -code $rcode $rc
  }

  # -- last approach to find the executable is
  #    to add the execprefix option (if avail.)

  if { [string length $options(-exeprefix)] } {

      set _execFullPath [file join $options(-exeprefix) $execFullPath]
      set args [lreplace $args 0 0 $_execFullPath]

      exec_now $args rcode rc
      return -code $rcode $rc
  }

  return -code error "execution of $args was not successful!"
}


# test code ...
if 0 {

  puts "*** [::execcmd::execcmd ls -ltr] ***"
  # puts [::execcmd::execcmd netstat -i]

  set CONFIG_DIR [file join $::starkit::topdir "config"]
  set cmd "uname -n"

  # using list is to prevent from backslash substitution on windows !

  eval ::execcmd::execcmd \
          -vfsroot   [list $CONFIG_DIR] \
          -exeprefix ""  \
          -wishcmd   "" \
          $cmd &
}