home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / cpp_libs / cmdline.lha / cmdline / src / cmd / cmdparse.tcl < prev    next >
Encoding:
Text File  |  1992-08-03  |  3.6 KB  |  104 lines
  1. #########################################################################
  2. # ^FILE: cmdparse.tcl - cmdparse for tcl scripts
  3. #
  4. # ^DESCRIPTION:
  5. #    This file defines a tcl procedure named cmdparse to parse
  6. #    command-line arguments for tcl scripts.
  7. #
  8. # ^HISTORY:
  9. #    05/07/92  Brad Appleton   <brad@ssd.csd.harris.com>   Created
  10. ##^^#####################################################################
  11.  
  12. ########
  13. # ^PROCEDURE: cmdparse - parse command-line argument lists
  14. #
  15. # ^SYNOPSIS:
  16. #    cmdparse <options> -- $scriptName $list
  17. #
  18. #        where <options> is any valid option combination for cmdparse(1),
  19. #        $scriptName is the name of the user's tcl script (or procedure),
  20. #        and $list is a list (which will usually be $argv for scripts, and
  21. #        and $args for procedures).
  22. #
  23. # ^DESCRIPTION:
  24. #    Parseargs will invoke cmdparse(1) with the options and arguments
  25. #    specified by the caller.
  26. #
  27. # ^REQUIREMENTS:
  28. #    Any desired initial values for variables from the argument-description
  29. #    string should be assigned BEFORE calling this procedure.
  30. #
  31. # ^SIDE-EFFECTS:
  32. #    If cmdparse(1) exits with a non-zero status, then execution
  33. #    is terminated.
  34. #
  35. # ^RETURN-VALUE:
  36. #    A string of variable settings for the caller to evaluate.
  37. #
  38. # ^EXAMPLE:
  39. #     #!/usr/local/bin/tcl
  40. #
  41. #     load  "cmdparse.tcl"
  42. #
  43. #     set arguments {
  44. #        ArgStr   string  "[S|Str [string]]"          "optional string arg"
  45. #        ArgStr   groups  "[g|groups newsgroups ...]" "newsgroups to test"
  46. #        ArgInt   count   "[c|count integer]"         "group repeat count"
  47. #        ArgStr   dirname "[d|directory pathname]"    "working directory"
  48. #        ArgBool  xflag   "[x|xflag]"                 "turn on x-mode"
  49. #        ArgClear yflag   "[y|yflag]"                 "turn off y-mode"
  50. #        ArgChar  sepch   "[s|separator char]"        "field separator"
  51. #        ArgStr   files   "[f|files filename ...]"    "files to process"
  52. #        ArgStr   name    "[n|name] name"             "name to use"
  53. #        ArgStr   argv    "[arguments ...]"           "remaining arguments"
  54. #     }
  55. #
  56. #     set count 1 ;    set dirname "." ;   set sepch "," ;
  57. #     set xflag 0 ;    set yflag 1 ;
  58. #     set files {} ;   set groups {} ;
  59. #     set string "" ;
  60. #
  61. #     eval [ cmdparse -decls $arguments -- $scriptName $argv ]
  62. #
  63. ###^^####
  64. proc cmdparse args {
  65.       ## set temp-file name
  66.    if {( ! [info exists env(TMP)] )}  { set env(TMP) "/tmp" }
  67.    if {( $env(TMP) == "" )}  { set env(TMP) "/tmp" }
  68.    set tmpFileName "$env(TMP)/tmp[id process]"
  69.  
  70.        ## isolate the last argument (a list) from the rest
  71.    set last [expr {[llength $args] - 1}]
  72.    set cmdArgs [lindex $args $last]
  73.    set cmdOpts [lrange $args 0 [expr {$last - 1}]]
  74.  
  75.       ## fork and exec
  76.    if {( [set childPid [fork]] == 0 )} {
  77.          ## This is the child ...
  78.          ##    redirect stdout to temp-file and exec cmdparse(1)
  79.          ##
  80.       set tmpFile [open $tmpFileName "w"]
  81.       close stdout
  82.       dup $tmpFile stdout
  83.       close $tmpFile
  84.       execl cmdparse [concat -shell=tcl $cmdOpts $cmdArgs]
  85.    } else {
  86.          ## This is the parent ...
  87.          ##    wait for the child, check its status, then return its output
  88.          ##    dont forget to remove the temp-file.
  89.          ##
  90.       set childStatus [wait $childPid]
  91.       set how [lindex $childStatus 1]
  92.       set ret [lindex $childStatus 2]
  93.       if {( ($how == "EXIT")  &&  ($ret == 0) )} {
  94.          set variableSettings [exec cat $tmpFileName]
  95.          unlink -nocomplain $tmpFileName
  96.          return $variableSettings
  97.       } else {
  98.          unlink -nocomplain $tmpFileName
  99.          exit [expr {$how == "EXIT" ? $ret : 127}]
  100.       }
  101.    }
  102. }
  103.  
  104.