#!perl ### ### (c) Copyright 1992,1993,1994,1995 Scott D. Lawrence ### All rights reserved. ### ### Permission is hereby granted to use, copy, and distribute this code ### in any way provided that the above copyright is included in all copies. ### No warranty is of suitability for any purpose is provided by the author. ### ### [That having been said, if you find a problem in this package (or use ### it and don't find a problem) I would love to hear from you: ### scott (at) skrb (dot) org ### ### This package provides the routine 'getargs' for parsing command line ### arguments. It automates most of a standard command line interface by ### taking a picture of the expected arguments of the form: ### ### ( <4tuple> [, <4tuple> ]... ) ### ### <4tuple> ::= , , , ### ### ::= '-' for switch arguments (these are order independent ### among themselves, but must all appear before any ### positional arguments) ### 'm' for mandatory positional arguments ### 'o' for optional positional arguments ### 'h' provides the help text; keyword and size are ignored. ### The contents of the scalar named in the variable ### are saved to print in the usage message. This may ### appear anywhere in the argument picture, but only ### one may be specified. ### ### ::= string to match for switch arguments ### (also used to print for usage of postional arguments) ### ### To provide a short form and long form for an argument, ### use '|'; the long form will be recognized ### only if preceded by a double dash. For example: ### '-', 'f|force' specifies the switches '-f' and '--force' ### as being equivalent. ### ### ::= number of values to consume from ARGV ### 0 ::= increment variable using '++' ### (used for flag switches) ### >1 ::= set list variable to next 'n' values ### -1 ::= set list variable to remaining values ### (for switch arguments, the values following ### '--' are not consumed) ### ### ::= name of variable (not including $ or @) to assign ### argument value into ### ### Provides -usage, --usage, -help, --help, and -? ### (if the 'usage' or 'help' switches are specified in the picture, ### the caller will get it like any other switch). ### ### Provides '--' for the end of switch arguments. ### ### Switch and Optional arguments not specified in @ARGV are not ### defined by getargs - you can either test for that or just assign ### them default values before calling getargs. ### ### @ARGV is not modified. ### The getargs routine can be used for interactive command parsing ### by reading the command, splitting the results into @ARGV, and ### calling getargs as you would for the real command line. ### ### Returns 1 if @ARGV parsed correctly according to the picture; if not, ### it prints the usage message and returns 0; ### ### Example: ### ### $HelpText = <<_help_text_ this is the help text for command. _help_text_ exit produces usage picture: testargs>] ### [-list ] ### [-a|--alternate ] ### [-values ... ] ### [--] ### ### ### [] ### ### This is the help text for this command. ################################################################ ### ### and sets the variables: $Mandatory, $Mandatory2 ### and (if specified): $Flag, $Value, @List, $Alternate, ### @Values, $Optional ### package getargs; sub main'getargs #' { local(@Picture) = @_; # Now parse the argument picture local( $Type, $Keyword, $Key, $Size, $Variable, $Tuple ); local( %Sizes, %Switches ); local( $Options, $Mandatories, @Positional, $Target, %Targets ); for ( $Tuple = 0; $Tuple < $#Picture; $Tuple += 4 ) { ( $Type, $Keyword, $Size, $Variable ) = @Picture[ $Tuple..$Tuple+3 ]; if ( $Keyword =~ /^([a-zA-Z])\|([a-zA-Z]+[-a-zA-Z]*)$/ ) { die "Only switch keywords may have alternate values ('|')" if ( $Type ne '-' ); local( $ShortKey, $LongKey ) = ( $1, "-$2" ); $Sizes{ $ShortKey } = $Size; $Targets{ $ShortKey } = $Variable; $Sizes{ $LongKey } = $Size; $Targets{ $LongKey } = $Variable; } elsif ( $Type ne 'h' ) { $Sizes{ $Keyword } = $Size; $Targets{ $Keyword } = $Variable; } if ( $Type eq '-' ) # switch argument { die "Switch Argument specified after Positionals\n" if ( $Options || $Mandatories ) } elsif ( $Type eq 'm' ) # mandatory positional argument { die "Optional Arg in picture before Mandatory Arg\n" if $Options; $Mandatories++; push( @Positional, $Keyword ); } elsif ( $Type eq 'o' ) # optional positional argument { $Options++; push( @Positional, $Keyword ); } elsif ( $Type eq 'h' ) # help message argument { defined( $HelpText ) && die "Only one help text parameter ('h') allowed.\n"; $Assignment = '$HelpText = $main\''.$Variable.';'; eval $Assignment; $HelpText || die "Help text specified in $Variable is empty\n"; } else { die "Undefined Type: $Type\n"; } } ### ### Parse Switch Arguments from Actual Argument List ### local( @ActualArgs ) = @ARGV; Switch: while ( $#Switches && ($_ = shift @ActualArgs) ) { if ( /^--$/ ) ## force end of options processing { #print "END OPTIONS\n"; # 0 ) { warn "Not enough arguments supplied\n"; &usage( @Picture ); 0; } else { 1; } } # sub getargs sub assign_value { local ( $Target, $Size ) = @_; local ( $Assignment ); if ( $Size <= @ActualArgs ) { Assign: { $Assignment = '$main\''.$Target.'++;' , last Assign if ( $Size == 0 ); $Assignment = '$main\''.$Target.' = shift @ActualArgs;' , last Assign if ( $Size == 1 ); $Assignment = '@main\''.$Target.' = @ActualArgs[ $[..$[+$Size-1 ],@ActualArgs = @ActualArgs[ $[+$Size..$#ActualArgs ];' , last Assign if ( $Size > 1 ); $Assignment = 'push( @main\''.$Target.', shift @ActualArgs ) while ($#ActualArgs >= $[) && ($ActualArgs[$[] ne \'--\');' , last Assign if ( $Size == -1 ); die "Invalid argument type in picture\n"; } eval $Assignment; 1; } else { @ActualArgs = (); 0; } } sub usage { local( $CommandName ) = $0; $CommandName =~ s\^.*/\\; print "Usage:\n"; print " $CommandName"; local( @Picture ) = @_; local( $Type, $Keyword, $Size, $Tuple, $Switches ); $Switches = 0; Switch: for ( $Tuple = 0; $Tuple < $#Picture; $Tuple += 4 ) { ( $Type, $Keyword, $Size ) = @Picture[ $Tuple..$Tuple+2 ]; if ( $Type eq "-" ) # switch argument { $Switches++; print "\n "." " x length($CommandName)." "; if ( $Keyword =~ s/(.+)\|(.+)/$2/ ) { print " [-$1|--$2"; } else { print " [-$Keyword"; } if ( $Size == -1 ) { print " ... "; } print " " while ( $Size-- > 0 ); print "]"; } } print "\n "." " x length($CommandName)." [--]" if $Switches; Positional: for ( $Tuple = 0; $Tuple < $#Picture; $Tuple += 4 ) { ( $Type, $Keyword, $Size ) = @Picture[ $Tuple..$Tuple+2 ]; print "\n "." " x length($CommandName)." " unless $Type eq '-'; if ( $Type eq "m" ) # mandatory positional argument { if ( $Size == -1 ) { print " ..."; last Positional; } print " " while ( $Size-- > 0 ); } elsif ( $Type eq "o" ) # optional positional argument { if ( $Size == -1 ) { print " [] ..."; last Positional; } print " [" while ( $Size-- > 0 ); print "]"; } } print "\n"; defined( $HelpText ) && print $HelpText; } 1; ### Local Variables: *** ### mode:perl *** ### End: ***