home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / cpp_libs / cmdline.lha / cmdline / src / cmd / cmdparse.pl < prev    next >
Encoding:
Text File  |  1992-08-03  |  3.7 KB  |  117 lines
  1. #########################################################################
  2. # ^FILE: cmdparse.pl - cmdparse for perl programs
  3. #
  4. # ^DESCRIPTION:
  5. #    This file defines a perl function named cmdparse to parse
  6. #    command-line arguments for perl scripts.
  7. #
  8. # ^HISTORY:
  9. #    05/14/91    Brad Appleton    <brad@ssd.csd.harris.com>    Created
  10. ##^^#####################################################################
  11.  
  12.  
  13. ########
  14. # ^FUNCTION: cmdparse - parse command-line argument vectors
  15. #
  16. # ^SYNOPSIS:
  17. #    eval  &cmdparse(@args);
  18. #
  19. # ^PARAMETERS:
  20. #    args -- The vector of arguments to pass to cmdparse(1);
  21. #            This will usually be the list ("-decls=$ARGS", "--", $0, @ARGV)
  22. #            where $ARGS is the variable containing all the argument
  23. #            declaration strings.
  24. #
  25. # ^DESCRIPTION:
  26. #    Cmdparse will invoke cmdparse(1) to parse the command-line.
  27. #
  28. # ^REQUIREMENTS:
  29. #    Any desired initial values for variables from the argument-description
  30. #    string should be assigned BEFORE calling this function.
  31. #
  32. # ^SIDE-EFFECTS:
  33. #    Terminates perl-script execution if command-line syntax errors are found
  34. #
  35. # ^RETURN-VALUE:
  36. #    A string of perl-variable settings to be evaluated.
  37. #
  38. # ^EXAMPLE:
  39. #     #!/usr/bin/perl
  40. #
  41. #     require  'cmdparse.pl';
  42. #
  43. #     $ARGS = '
  44. #       ArgStr   string  "[S|Str string]" : STICKY    "optional string argument"
  45. #       ArgStr   groups  "[g|groups newsgroups ...]"  "groups to test"
  46. #       ArgInt   count   "[c|count number]"           "group repeat count"
  47. #       ArgStr   dirname "[d|directory pathname]"     "directory to use"
  48. #       ArgBool  xflag   "[x|xmode]"                  "turn on X-mode"
  49. #       ArgClear yflag   "[y|ymode]"                  "turn off Y-mode"
  50. #       ArgChar  sepch   "[s|separator char]"         "field separator"
  51. #       ArgStr   files   "[f|files filenames ...]"    "files to process"
  52. #       ArgStr   name    "[n|name] name"              "name to use"
  53. #       ArgStr   ARGV    "[args ...]"                 "any remaining arguments"
  54. #     ';
  55. #
  56. #     $count = 1;
  57. #     $dirname = '.';
  58. #     $sepch = ',';
  59. #     $yflag = 'TRUE';
  60. #
  61. #     eval &cmdparse("-decls=$ARGS", "--", $0, @ARGV);
  62. #
  63. ##^^####
  64.  
  65. sub cmdparse {
  66.    local(@args) = @_ ;
  67.    local($output) = ("");
  68.    local($nforks, $tmpfile, $tmpdir, $exitrc, $_) = (0, "tmp$$");
  69.  
  70.    $tmpdir = $ENV{'TMP'};  ## use ${TMP:-/tmp}/tmp$$ as the temporary file
  71.    if (! $tmpdir) {
  72.       $tmpdir = '/tmp';
  73.    }
  74.    $tmpfile = $tmpdir . '/' . $tmpfile;
  75.  
  76.    ## I could just call cmdparse(1) using `cmdparse <options> <args>`
  77.    ## but then I would need to escape all shell meta-characters in each
  78.    ## argument. By using exec(), the arguments are passed directly to
  79.    ## the system and are not "globbed" or expanded by the shell.
  80.    ##
  81.    ## Hence I will need to fork off a child, redirect its standard output
  82.    ## to a temporary file, and then exec cmdparse(1).
  83.  
  84. FORK: {
  85.       ++$nforks;
  86.       if ($pid = fork) {
  87.             # parent here
  88.          waitpid($pid, 0);  ## wait for child to die
  89.          $exitrc = $?;
  90.          $output = `cat $tmpfile` unless $exitrc;   ## save the output-script
  91.          unlink($tmpfile);  ## remove the temporary file
  92.          if ($exitrc) {
  93.             $! = 0;
  94.             die "\n";
  95.          }
  96.       } elsif (defined $pid) { ## pid is zero here if defined
  97.             # child here
  98.          open(STDOUT, "> $tmpfile") || die "Can't redirect stdout";
  99.          exec("cmdparse", "-shell=perl", @args);
  100.       } elsif ($! =~ /No more process/ ) {
  101.             # EAGAIN, supposedly recoverable fork error
  102.          if ($nforks > 10) {
  103.             die "$0: Can't fork cmdparse(1) after 10 tries.\n" ;
  104.          } else {
  105.             sleep 1;
  106.             redo FORK;
  107.          }
  108.       } else {
  109.          die "$0: Can't fork cmdparse(1): $!\n" ;
  110.       }
  111.    } ##FORK
  112.  
  113.    return $output;
  114. }
  115.  
  116. 1;
  117.