home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / perl / scripts-osu / getargs < prev    next >
Encoding:
Text File  |  1990-11-26  |  8.0 KB  |  272 lines
  1. Path: tut.cis.ohio-state.edu!pt.cs.cmu.edu!rochester!kodak!atexnet!lawrence
  2. From: lawrence@epps.kodak.com (Scott Lawrence)
  3. Newsgroups: comp.lang.perl
  4. Subject: getargs.pl (for use and comment)
  5. Message-ID: <5068@atexnet.UUCP>
  6. Date: 28 Nov 90 16:45:30 GMT
  7. Sender: news@atexnet.UUCP
  8. Reply-To: lawrence@epps.kodak.com
  9. Organization: Electronic Pre-Press Systems, a Kodak company
  10. Lines: 259
  11.  
  12.  
  13. I am a perl novice; as a learning exersize, and because I needed one, I am
  14. writing a document repository system in perl (assigns document numbers,
  15. stores and retrieves documents, searches by keywords, that sort of thing).
  16.  
  17. In the course of starting the system I found that the simple switch parsing
  18. stuff that comes with perl didn`t do all that I really wanted, so I wrote a
  19. more comprehensive package I call getargs. 
  20.  
  21. The getargs.pl package provides provides subroutine 'getargs' which takes a
  22. list which is interpreted as a picture of the expected arguments. It
  23. assigns values from ARGV into the variables specified in the list.  It 
  24. supports the model for arguments in which all switches come before any
  25. positional arguments, automatically handling '--', '-usage', and '-?'. If
  26. ARGV doesn`t parse correctly (too many or too few arguments or an
  27. unrecognized switch), it prints a usage message constructed from the picture
  28. and returns 0, otherwise it returns 1.  
  29.  
  30. Example:
  31.  
  32. &getargs( '-', 'test', 0, 'Test'
  33.          ,'-', 't', 0, 'Test'
  34.          ,'-', 'file', 1, 'File'
  35.          ,'m', 'required', 1, 'Required'
  36.          ,'o', 'optional-list', -1, 'OptionalList'
  37.         ) || exit 1;
  38.  
  39. produces:
  40.  
  41. > testget -usage
  42. Usage:
  43.     testget [-test] [-t] [-file <file>]
  44.             [--] <required> [<optional-list>] ...
  45.  
  46. Note that the -test and -t switches both assign to the same variable, so
  47. they are aliases (though the usage picture doesn't make that clear).
  48.  
  49. Any suggestions for improvements to the routine (or bug fixes) would be
  50. appreciated. 
  51.  
  52. ---
  53. Scott Lawrence         <lawrence@epps.kodak.com>       <s.lawrence@ieee.org>
  54. Atex Advanced Publishing Systems,     Voice: 508-670-4023  Fax: 508-670-4033
  55. Electronic Pre-Press Systems; 165 Lexington St. 400/165L; Billerica MA
  56. 01821
  57. ------- cut here ---------
  58. #!/usr/local/bin/perl
  59. #
  60. # Provides the routine getargs
  61. # which takes a picture of the expected arguments of the form:
  62. # ( <tuple> [, <tuple> ]... )
  63. # <tuple> ::= <type>, <keyword>, <size>, <variable>
  64. # <type>  ::= '-' for switch arguments
  65. #             'm' for mandatory positional arguments
  66. #             'o' for optional positional arguments
  67. # <keyword> ::= string to match for switch arguments 
  68. #               (also used to print for usage of postional arguments)
  69. # <size> ::= number of values to consume from ARGV ( 0 = set variable to 1 )
  70. # <variable> ::= name of variable (not including $ or @) to assign
  71. #                argument value into
  72. #
  73. # automatically provides -usage and -?
  74. # automatically provides --
  75. #
  76. # Copyright (c) 1990 by Scott Lawrence <s.lawrence@ieee.org>
  77. # May be copied and modified freely so long as the above copyright notice 
  78. # is retained. This program is distributed WITHOUT ANY WARRANTY and
  79. # without even the implied warranty of MERCHANTABILITY or FITNESS FOR 
  80. # A PARTICULAR PURPOSE. 
  81.  
  82. package getargs;
  83.  
  84. sub main'getargs 
  85. { 
  86. local(@Picture) = @_;
  87.  
  88. # Now  parse the argument picture 
  89. local( $Type,  $Keyword,  $Size, $Variable, $Tuple, %Sizes, %Switches ); 
  90. local( $Options, $Mandatories, @Positional, $Target, %Targets );
  91.  
  92. for ( $Tuple = 0; $Tuple < $#Picture; $Tuple += 4 )
  93. {
  94.     ( $Type, $Keyword, $Size, $Variable ) = @Picture[ $Tuple..$Tuple+3 ];
  95.  
  96.     $Sizes{ $Keyword } = $Size;
  97.     $Targets{ $Keyword } = $Variable;
  98.  
  99.     if ( $Type eq "-" ) # switch argument
  100.     {
  101.         # print "Switch: -$Keyword\n";
  102.     }
  103.     elsif ( $Type eq "m" ) # mandatory positional argument
  104.     {
  105.         $Options && die "Optional Arg in picture before Mandatory Arg\n";
  106.         $Mandatories++;
  107.         push( @Positional, $Keyword );
  108.     }
  109.     elsif ( $Type eq "o" ) # optional positional argument
  110.     {
  111.         $Options++;
  112.         push( @Positional, $Keyword );
  113.     }
  114.     else { die "Undefined Type: $Type\n"; } 
  115. }
  116.  
  117.     local( @ActualArgs ) = @ARGV; 
  118.  
  119. Switch: while ( $#Switches && ($_ = shift @ActualArgs) ) 
  120. {
  121.     if ( /^--/ ) ## force end of options processing
  122.         {
  123.             last Switch;
  124.         }
  125.     elsif ( /^-\d+/ ) ## numeric argument - not an option
  126.         {
  127.             unshift( @ActualArgs, $_ );
  128.             last Switch;
  129.         }
  130.     elsif ( /^-\?/ || /^-usage/ ) 
  131.         { 
  132.               &usage( @Picture ); 
  133.               return 0; 
  134.         }
  135.     elsif ( /^-(\w+)/ ) ## looks like a switch...
  136.         {
  137.             if ( $Target = $Targets{ $1 } )
  138.             {
  139.                 &assign_value( $Target, $Sizes{ $1 } );
  140.             }
  141.             else
  142.             {
  143.                 warn "Invalid switch $_\n";
  144.                 &usage( @Picture );
  145.                 return 0;
  146.             }
  147.         } 
  148.     else
  149.         {
  150.             unshift( @ActualArgs, $_ );
  151.             last Switch;
  152.         }
  153.     } # Switch
  154.  
  155.     Positional: while( $_ = shift( @Positional ) ) 
  156.     {
  157.         &assign_value( $Targets{ $_ }, $Sizes{ $_ } ) || last Positional; 
  158.         $Mandatories--;
  159.     }
  160.  
  161.     if ( @ActualArgs )
  162.     {
  163.         warn "Too many arguments: @ActualArgs\n";
  164.         &usage( @Picture );
  165.         0;
  166.     }
  167.     elsif ( $Mandatories > 0 ) 
  168.     { 
  169.         warn "Not enough arguments supplied\n";
  170.         &usage( @Picture );
  171.         0;
  172.     }
  173.     else
  174.     {
  175.         1;
  176.     }
  177.  
  178. } # sub getargs
  179.  
  180. sub assign_value 
  181. {
  182.     local ( $Target, $Size ) = @_;
  183.     local ( $Assignment );
  184.  
  185.     if ( $Size <= @ActualArgs )
  186.     {
  187.         Assign:
  188.         {
  189.           $Assignment = '$main\''.$Target.' = 1;'
  190.                                              , last Assign if ( $Size == 0 );
  191.           $Assignment = '$main\''.$Target.' = shift @ActualArgs;'
  192.                                              , last Assign if ( $Size == 1 );
  193.           $Assignment = '@main\''.$Target.' = @ActualArgs[ $[..$[+$Size-1 ],@ActualArgs = @ActualArgs[ $[+$Size..$#ActualArgs ];'
  194.                                              , last Assign if ( $Size > 1 );
  195.           $Assignment = '@main\''.$Target.' = @ActualArgs, @ActualArgs = ();'
  196.                                              , last Assign if ( $Size == -1 );
  197.           die "Invalid argument type in picture\n";
  198.         }
  199.  
  200.         eval $Assignment;
  201.         1;
  202.     }
  203.     else
  204.     {
  205.         @ActualArgs = ();
  206.         0;
  207.     }
  208. }
  209.  
  210. sub usage
  211. { 
  212.     print "Usage:\n"; 
  213.     print "    $0"; 
  214.     local( @Picture ) = @_;
  215.     local( $Type,  $Keyword,  $Size, $Tuple, $Switches );
  216.  
  217.     $Switches = 0;
  218.     Switch: for ( $Tuple = 0; $Tuple < $#Picture; $Tuple += 4 )
  219.     {
  220.         ( $Type, $Keyword, $Size ) = @Picture[ $Tuple..$Tuple+2 ];
  221.     
  222.         if ( $Type eq "-" ) # switch argument
  223.         {
  224.             $Switches++;
  225.             print " [-$Keyword";
  226.             if ( $Size == -1 )
  227.             {
  228.                 print " <$Keyword> ... ]"; 
  229.                 last Switch;
  230.             }
  231.             print " <$Keyword>" while ( $Size-- > 0 );
  232.             print "]";
  233.         }
  234.     }
  235.     
  236.     print "\n   "." " x length($0)."  [--]" if $Switches;
  237.     
  238.     Positional: for ( $Tuple = 0; $Tuple < $#Picture; $Tuple += 4 )
  239.     {
  240.         ( $Type, $Keyword, $Size ) = @Picture[ $Tuple..$Tuple+2 ];
  241.     
  242.         if ( $Type eq "m" ) # mandatory positional argument
  243.         {
  244.             if ( $Size == -1 )
  245.             {
  246.                 print " <$Keyword> ..."; 
  247.                 last Positional;
  248.             }
  249.             print " <$Keyword>" while ( $Size-- > 0 );
  250.         }
  251.         elsif ( $Type eq "o" ) # optional positional argument
  252.         {
  253.             if ( $Size == -1 )
  254.             {
  255.                 print " [<$Keyword>] ..."; 
  256.                 last Positional;
  257.             }
  258.             print " [<$Keyword>" while ( $Size-- > 0 );
  259.             print "]";
  260.         }
  261.     }
  262.     
  263.     print "\n";
  264. }
  265. 1;
  266. --
  267. ---
  268. Scott Lawrence         <lawrence@epps.kodak.com>       <s.lawrence@ieee.org>
  269. Atex Advanced Publishing Systems,     Voice: 508-670-4023  Fax: 508-670-4033
  270. Electronic Pre-Press Systems; 165 Lexington St. 400/165L; Billerica MA 01821
  271.  
  272.