;# 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;
