Path: tut.cis.ohio-state.edu!pt.cs.cmu.edu!rochester!kodak!atexnet!lawrence
From: lawrence@epps.kodak.com (Scott Lawrence)
Newsgroups: comp.lang.perl
#Subject: getargs.pl (for use and comment)
Message-ID: <5068@atexnet.UUCP>
Date: 28 Nov 90 16:45:30 GMT
Sender: news@atexnet.UUCP
Reply-To: lawrence@epps.kodak.com
Organization: Electronic Pre-Press Systems, a Kodak company
Lines: 259


I am a perl novice; as a learning exersize, and because I needed one, I am
writing a document repository system in perl (assigns document numbers,
stores and retrieves documents, searches by keywords, that sort of thing).

In the course of starting the system I found that the simple switch parsing
stuff that comes with perl didn`t do all that I really wanted, so I wrote a
more comprehensive package I call getargs. 

The getargs.pl package provides provides subroutine 'getargs' which takes a
list which is interpreted as a picture of the expected arguments. It
assigns values from ARGV into the variables specified in the list.  It 
supports the model for arguments in which all switches come before any
positional arguments, automatically handling '--', '-usage', and '-?'. If
ARGV doesn`t parse correctly (too many or too few arguments or an
unrecognized switch), it prints a usage message constructed from the picture
and returns 0, otherwise it returns 1.  

Example:

&getargs( '-', 'test', 0, 'Test'
         ,'-', 't', 0, 'Test'
         ,'-', 'file', 1, 'File'
         ,'m', 'required', 1, 'Required'
         ,'o', 'optional-list', -1, 'OptionalList'
        ) || exit 1;

produces:

> testget -usage
Usage:
    testget [-test] [-t] [-file <file>]
            [--] <required> [<optional-list>] ...

Note that the -test and -t switches both assign to the same variable, so
they are aliases (though the usage picture doesn't make that clear).

Any suggestions for improvements to the routine (or bug fixes) would be
appreciated. 

---
Scott Lawrence         <lawrence@epps.kodak.com>       <s.lawrence@ieee.org>
Atex Advanced Publishing Systems,     Voice: 508-670-4023  Fax: 508-670-4033
Electronic Pre-Press Systems; 165 Lexington St. 400/165L; Billerica MA
01821
------- cut here ---------
#/usr/local/bin/perl
#
# Provides the routine getargs
# which takes a picture of the expected arguments of the form:
# ( <tuple> [, <tuple> ]... )
# <tuple> ::= <type>, <keyword>, <size>, <variable>
# <type>  ::= '-' for switch arguments
#             'm' for mandatory positional arguments
#             'o' for optional positional arguments
# <keyword> ::= string to match for switch arguments 
#               (also used to print for usage of postional arguments)
# <size> ::= number of values to consume from ARGV ( 0 = set variable to 1 )
# <variable> ::= name of variable (not including $ or @) to assign
#                argument value into
#
# automatically provides -usage and -?
# automatically provides --
#
# Copyright (c) 1990 by Scott Lawrence <s.lawrence@ieee.org>
# May be copied and modified freely so long as the above copyright notice 
# is retained. This program is distributed WITHOUT ANY WARRANTY and
# without even the implied warranty of MERCHANTABILITY or FITNESS FOR 
# A PARTICULAR PURPOSE. 

package getargs;

sub main'getargs 
{ 
local(@Picture) = @_;

# Now  parse the argument picture 
local( $Type,  $Keyword,  $Size, $Variable, $Tuple, %Sizes, %Switches ); 
local( $Options, $Mandatories, @Positional, $Target, %Targets );

for ( $Tuple = 0; $Tuple < $#Picture; $Tuple += 4 )
{
    ( $Type, $Keyword, $Size, $Variable ) = @Picture[ $Tuple..$Tuple+3 ];

    $Sizes{ $Keyword } = $Size;
    $Targets{ $Keyword } = $Variable;

    if ( $Type eq "-" ) # switch argument
    {
        # print "Switch: -$Keyword\n";
    }
    elsif ( $Type eq "m" ) # mandatory positional argument
    {
        $Options && die "Optional Arg in picture before Mandatory Arg\n";
        $Mandatories++;
        push( @Positional, $Keyword );
    }
    elsif ( $Type eq "o" ) # optional positional argument
    {
        $Options++;
        push( @Positional, $Keyword );
    }
    else { die "Undefined Type: $Type\n"; } 
}

    local( @ActualArgs ) = @ARGV; 

Switch: while ( $#Switches && ($_ = shift @ActualArgs) ) 
{
    if ( /^--/ ) ## force end of options processing
        {
            last Switch;
        }
    elsif ( /^-\d+/ ) ## numeric argument - not an option
        {
            unshift( @ActualArgs, $_ );
            last Switch;
        }
    elsif ( /^-\?/ || /^-usage/ ) 
        { 
              &usage( @Picture ); 
              return 0; 
        }
    elsif ( /^-(\w+)/ ) ## looks like a switch...
        {
            if ( $Target = $Targets{ $1 } )
            {
                &assign_value( $Target, $Sizes{ $1 } );
            }
            else
            {
                warn "Invalid switch $_\n";
                &usage( @Picture );
                return 0;
            }
        } 
    else
        {
            unshift( @ActualArgs, $_ );
            last Switch;
        }
    } # Switch

    Positional: while( $_ = shift( @Positional ) ) 
    {
        &assign_value( $Targets{ $_ }, $Sizes{ $_ } ) || last Positional; 
        $Mandatories--;
    }

    if ( @ActualArgs )
    {
        warn "Too many arguments: @ActualArgs\n";
        &usage( @Picture );
        0;
    }
    elsif ( $Mandatories > 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.' = 1;'
                                             , 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 = '@main\''.$Target.' = @ActualArgs, @ActualArgs = ();'
                                             , last Assign if ( $Size == -1 );
          die "Invalid argument type in picture\n";
        }

        eval $Assignment;
        1;
    }
    else
    {
        @ActualArgs = ();
        0;
    }
}

sub usage
{ 
    print "Usage:\n"; 
    print "    $0"; 
    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 " [-$Keyword";
            if ( $Size == -1 )
            {
                print " <$Keyword> ... ]"; 
                last Switch;
            }
            print " <$Keyword>" while ( $Size-- > 0 );
            print "]";
        }
    }
    
    print "\n   "." " x length($0)."  [--]" if $Switches;
    
    Positional: for ( $Tuple = 0; $Tuple < $#Picture; $Tuple += 4 )
    {
        ( $Type, $Keyword, $Size ) = @Picture[ $Tuple..$Tuple+2 ];
    
        if ( $Type eq "m" ) # mandatory positional argument
        {
            if ( $Size == -1 )
            {
                print " <$Keyword> ..."; 
                last Positional;
            }
            print " <$Keyword>" while ( $Size-- > 0 );
        }
        elsif ( $Type eq "o" ) # optional positional argument
        {
            if ( $Size == -1 )
            {
                print " [<$Keyword>] ..."; 
                last Positional;
            }
            print " [<$Keyword>" while ( $Size-- > 0 );
            print "]";
        }
    }
    
    print "\n";
}
1;
--
---
Scott Lawrence         <lawrence@epps.kodak.com>       <s.lawrence@ieee.org>
Atex Advanced Publishing Systems,     Voice: 508-670-4023  Fax: 508-670-4033
Electronic Pre-Press Systems; 165 Lexington St. 400/165L; Billerica MA 01821