diff options
Diffstat (limited to 'mmuegel/libs/newgetopts.pl')
| -rw-r--r-- | mmuegel/libs/newgetopts.pl | 213 |
1 files changed, 213 insertions, 0 deletions
diff --git a/mmuegel/libs/newgetopts.pl b/mmuegel/libs/newgetopts.pl new file mode 100644 index 0000000..bc73348 --- /dev/null +++ b/mmuegel/libs/newgetopts.pl @@ -0,0 +1,213 @@ +;# NAME +;# newgetopts.pl - a better newgetopt (which is a better getopts which is +;# a better getopt ;-) +;# +;# AUTHOR +;# Mike Muegel (mmuegel@mot.com) +;# +;# mmuegel +;# /usr/local/ustart/src/mail-tools/dist/foo/libs/newgetopts.pl,v 1.1 1993/07/28 08:07:19 mmuegel Exp + +;############################################################################### +;# New_Getopts +;# +;# Does not care about order of switches, options, and arguments like +;# getopts.pl. Thus all non-switches/options will be kept in ARGV even if they +;# are not at the end. If $Pass_Invalid is set all unkown options will be +;# passed back to the caller by keeping them in @ARGV. This is useful when +;# parsing a command line for your script while ignoring options that you +;# may pass to another script. If this is set New_Getopts tries to maintain +;# the switch clustering on the unkown switches. +;# +;# Accepts the special argument -usage to print the Usage string. Also accepts +;# the special option -version which prints the contents of the string +;# $VERSION. $VERSION may or may not have an embeded \n in it. If -usage +;# or -version are specified a status of -1 is returned. Note that the usage +;# option is only accepted if the usage string is not null. +;# +;# $Switches is just like the formal arguemnt of getopts.pl. $Usage is a usage +;# string with or without a trailing \n. *Switch_To_Order is an optional +;# pointer to the name of an associative array which will contain a mapping of +;# switch names to the order in which (if at all) the argument was entered. +;# +;# For example, if @ARGV contains -v, -x, test: +;# +;# $Switch_To_Order {"v"} = 1; +;# $Switch_To_Order {"x"} = 2; +;# +;# Note that in the case of multiple occurances of an option $Switch_To_Order +;# will store each occurance of the argument via a string that emulates +;# an array. This is done by using join ($;, ...). You can retrieve the +;# array by using split (/$;/, ...). +;# +;# *Split_ARGV is an optional pointer to an array which will conatin the +;# original switches along with their values. For the example used above +;# Split_ARGV would contain: +;# +;# @Split_ARGV = ("v", "", "x", "test"); +;# +;# Another exciting ;-) feature that newgetopts has. Along with creating the +;# normal $opt_ scalars for the last value of an argument the list @opt_ is +;# created. It is an array which contains all the values of arguments to the +;# basename of the variable. They are stored in the order which they occured +;# on the command line starting with $[. Note that blank arguments are stored +;# as "". Along with providing support for multiple options on the command +;# line this also provides a method of counting the number of times an option +;# was specified via $#opt_. +;# +;# Automatically resets all $opt_, @opt_, %Switch_To_Order, and @Split_ARGV +;# variables so that New_Getopts may be called more than once from within +;# the same program. Thus, if $opt_v is set upon entry to New_Getopts and +;# -v is not in @ARGV $opt_v will not be set upon exit. +;# +;# Arguments: +;# $Switches, $Usage, $Pass_Invalid, *Switch_To_Order, *Split_ARGV +;# +;# Returns: +;# -1, 0, or 1 depending on status (printed Usage/Version, OK, not OK) +;############################################################################### +sub New_Getopts +{ + local($taint_argumentative, $Usage, $Pass_Invalid, *Switch_To_Order, + *Split_ARGV) = @_; + local(@args,$_,$first,$rest,$errs, @leftovers, @current_leftovers, + %Switch_Found); + local($[, $*, $Script_Name, $argumentative); + + # Untaint the argument cluster so that we can use this with taintperl + $taint_argumentative =~ /^(.*)$/; + $argumentative = $1; + + # Clear anything that might still be set from a previous New_Getopts + # call. + @Split_ARGV = (); + + # Get the basename of the calling script + ($Script_Name = $0) =~ s/.*\///; + + # Make Usage have a trailing \n + $Usage .= "\n" if ($Usage !~ /\n$/); + + @args = split( / */, $argumentative ); + + # Clear anything that might still be set from a previous New_Getopts call. + foreach $first (@args) + { + next if ($first eq ":"); + delete $Switch_Found {$first}; + delete $Switch_To_Order {$first}; + eval "undef \@opt_$first; undef \$opt_$first;"; + }; + + while (@ARGV) + { + # Let usage through + if (($ARGV[0] eq "-usage") && ($Usage ne "\n")) + { + print $Usage; + exit (-1); + } + + elsif ($ARGV[0] eq "-version") + { + if ($VERSION) + { + print $VERSION; + print "\n" if ($VERSION !~ /\n$/); + } + else + { + warn "${Script_Name}: no version information available, sorry\n"; + } + exit (-1); + } + + elsif (($_ = $ARGV[0]) =~ /^-(.)(.*)/) + { + ($first,$rest) = ($1,$2); + $pos = index($argumentative,$first); + + $Switch_To_Order {$first} = join ($;, split (/$;/, $Switch_To_Order {$first}), ++$Order); + + if($pos >= $[) + { + if($args[$pos+1] eq ':') + { + shift(@ARGV); + if($rest eq '') + { + $rest = shift(@ARGV); + } + + eval "\$opt_$first = \$rest;"; + eval "push (\@opt_$first, \$rest);"; + push (@Split_ARGV, $first, $rest); + } + else + { + eval "\$opt_$first = 1"; + eval "push (\@opt_$first, '');"; + push (@Split_ARGV, $first, ""); + + if($rest eq '') + { + shift(@ARGV); + } + else + { + $ARGV[0] = "-$rest"; + } + } + } + + else + { + # Save any other switches if $Pass_Valid + if ($Pass_Invalid) + { + push (@current_leftovers, $first); + } + else + { + warn "${Script_Name}: unknown option: $first\n"; + ++$errs; + }; + if($rest ne '') + { + $ARGV[0] = "-$rest"; + } + else + { + shift(@ARGV); + } + } + } + + else + { + push (@leftovers, shift (@ARGV)); + }; + + # Save any other switches if $Pass_Valid + if ((@current_leftovers) && ($rest eq '')) + { + push (@leftovers, "-" . join ("", @current_leftovers)); + @current_leftovers = (); + }; + }; + + # Automatically print Usage if a warning was given + @ARGV = @leftovers; + if ($errs != 0) + { + warn $Usage; + return (0); + } + else + { + return (1); + } + +} + +1; |