<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package CmdArguments;

use strict;

use vars qw($VERSION);

$VERSION = '1.00';

=head1 NAME

CmdArguments - Module to process arguments passed on command line

=head1 SYNOPSIS

    # program name args.pl
    use CmdArguments;

    my $var1 = 10;          # initialize variable
    my $var2 = 0;           # with default values.
    my @var3 = ( 1, 2, 3);  # well, if you like to.
    my @var4;               # but, not necessary

    my $parse_ref = [
                     [ "arg1", \$var1 ], # argTypeScalar is assumed
                     [ "arg2", \$var2,
                       {TYPE =&gt; argTypeSwitch}], # explicit argTypeSwitch
                     [ "arg3", \@var3 ], # argTypeArray assumed
                     [ "arg4", \@var4,
                       {UNIQUE =&gt; 1}], # argTypeArray assumed
                    ];

    CmdArguments::parse(@ARGV, $parse_ref);

    print "var1 = $var1\n";
    print "var2 = $var2\n";
    print "var3 = @var3\n";
    print "var4 = @var4\n";

    exit 0;

test command ...

    args.pl -arg1 23 -arg2 -arg3 2 4 3 2 5 -arg4 2 4 3 2 4

should generate following output...

    var1 = 23
    var2 = 1
    var3 = 2 4 3 2 5
    var4 = 2 4 3

=head1 DESCRIPTION

This module provides some handy functions to process
command line options.

When this module is included it introduces following
constants in the calling program namespace...

    argTypeScalar = 0
    argTypeArray  = 1
    argTypeSwitch = 2

=cut

sub BEGIN {
    use constant argTypeScalar =&gt; 0;
    use constant argTypeArray  =&gt; 1;
    use constant argTypeSwitch =&gt; 2;
    use constant argTypeHash   =&gt; 3;

    my $pkg = caller;
    no strict 'refs';
    *{"${pkg}::argTypeScalar"} = sub () { argTypeScalar };
    *{"${pkg}::argTypeArray"}  = sub () { argTypeArray };
    *{"${pkg}::argTypeSwitch"} = sub () { argTypeSwitch };
    *{"${pkg}::argTypeHash"}   = sub () { argTypeHash };
}

=over 1

=item B&lt;CmdArguments::parse&gt;

Simplest way to use this program is to call B&lt;parse&gt; (static function).

Calling syntax is...

I&lt;parse(L&lt;@arguments|@arguments&gt;, L&lt;$array_ref|$array_ref&gt;,
I&lt;L&lt;$text_or_func1|$text_or_func1&gt;&gt;, I&lt;L&lt;$text_or_func2|$text_or_func2&gt;&gt;)&gt;

=over 2

=item I&lt;@arguments&gt;

array of command line arguments. So, @ARGV could be passed instead.

=item I&lt;$array_ref&gt;

reference to an array containing information about how to
parse data in @arguments.

basic structure of $array_ref is...

$array_ref = [ I&lt;$array_ref_for_individual_tag&gt;, ...];

$array_ref_for_individual_tag = [I&lt;L&lt;$option_tag|$option_tag&gt;&gt;
, I&lt;L&lt;$ref_of_variable|$ref_of_variable&gt;&gt;,
I&lt;L&lt;$hash_ref|$hash_ref&gt;&gt;]; # $hash_ref is optional

=over 3

=item I&lt;$hash_ref&gt;

reference to a hash containing supplementary information about $option_tag

  $hash_ref = {
    TYPE   =&gt; argType..., # argTypeSwitch
                          # argTypeArray or argTypeScalar

    UNIQUE =&gt; 1,          # 1 or 0

    USAGE  =&gt; "help information", # try giving -h or -help
                                  # on command line

    FUNC   =&gt; sub { eval $_[0] }
  };

=over 4

=item TYPE

this specifies what kind of variable reference is passed in
$ref_of_variable. If TYPE is argTypeScalar or argTypeSwitch
it assumes reference to a scalar. If TYPE is argTypeArray it
assumes reference to an array.

if TYPE tag is not provided then ...

1. I&lt;argTypeScalar&gt; is assumed if $ref_of_variable is a scalar reference

2. I&lt;argTypeArray&gt; is assumed if $ref_of_variable is an array reference

=over 5

=item What is argType...?

=over 6

=item argTypeSwitch

on command line you can not provide value for an option.

=item argTypeScalar

on command line you must provide one and only one value

=item argTypeArray

on command line you can provide zero or more values

=back 6

=back 5

=item UNIQUE

this tag is applicable for option type I&lt;argTypeArray&gt; only.
it can be 0 or 1. 1 means make unique array. So, if an
option is defined as UNIQUE then on command line if you
give say 2 3 4 5 3 4 6 7 then array will hold 2 3 4 5 6 7.
If it was not unique then it will hold 2 3 4 5 3 4 6 7.

=item FUNC

Holds a reference to a function. Function should take
a scalar argument and return a scalar if option is
argTypeScalar and return an array if option is
argTypeArray. This is not used for option type argTypeSwitch.

Example: if option type is an argTypeArray. and function is
defined like

FUNC =&gt; sub { eval $_[0] }

and if on the command line something like 1..3 or 1,2,3
is passed then it will generate an array having values 1 2 3.

=back 4

=item I&lt;$ref_of_variable&gt;

Can pass reference of a scalar or an array variable
depending on what require from command line.

=item I&lt;$option_tag&gt;

It is the name of the option tag. if option tag is I&lt;opt&gt; then
on command line you have to specify option like I&lt;-opt&gt;.

=back 3

=item $text_or_func1

=item $text_or_func2

pass text or reference to a function. If function is passed
it should return text or should itself print message on
STDERR. Try experimenting by passing -h or -help in the argument.
$text_or_func1 is printed after the help text is printed and
$text_or_func1 is used before printing helptext.

=back 2

=back 1

=cut

sub parse (\@@) {
    my ($arg_ref, $process, $postusage, $preusage) = @_;

    use constant argTagField  =&gt; 0;
    use constant argVarField  =&gt; 1;
    use constant argHashField =&gt; 2;

    my %functions = (argTypeScalar+0 =&gt; "argScalar",
		     argTypeArray+0  =&gt; "argArray",
		     argTypeHash+0  =&gt; "argHash",
		     argTypeSwitch+0 =&gt; "argSwitch");

    my $args = CmdArguments-&gt;beginArg(@$arg_ref);
    foreach my $argsyntax (@$process) {
	my $typehash = (defined $argsyntax-&gt;[argHashField]
			? $argsyntax-&gt;[argHashField] : {});

	my $tag     = $argsyntax-&gt;[argTagField];
	my $var     = $argsyntax-&gt;[argVarField];
	my $type    = _value($typehash-&gt;{TYPE});
	my $sub     = _value($typehash-&gt;{FUNC});
	my $unique  = _value($typehash-&gt;{UNIQUE});
	my $usage   = _value($typehash-&gt;{USAGE});
	my $dispOpt = _value($typehash-&gt;{DISPOPTION});
	my $params  = _value($typehash-&gt;{PARAMS});

	unless (defined $type) {
	    $type = argTypeScalar if ref($var) eq 'SCALAR';
	    $type = argTypeArray  if ref($var) eq 'ARRAY';
	    $type = argTypeHash   if ref($var) eq 'HASH';
	    unless (defined $type) {
		die "ERROR: option ($tag) - variable should be a reference\n";
	    }
	}

	my @arguments = ($tag =&gt; $var, usage =&gt; $usage,
			 dispOption =&gt; $dispOpt,
			 func =&gt; $sub, unique =&gt; $unique, params =&gt; $params);

	if (exists $functions{$type}) {
	    my $function = $functions{$type};
	    $args-&gt;$function(@arguments);
	} else {
	    die "Please check type ($type)\n";
	}
    }

    my @return = ();
    if (wantarray) {
	@return = $args-&gt;endArg;
    } else {
	$args-&gt;endArg;
    }
    $args-&gt;usage($preusage, $postusage);
    return @return;
}

# Start Argument processing
# usage: my $arg = CmdArguments-&gt;beginArg(@ARGV);
sub beginArg {
    my ($class, @argv) = @_;

    my $self = {};
    bless $self, $class;

    # trap the arguments
    $self-&gt;{ARGS} = @argv ? [@argv] : \@ARGV;
    # usage string in case of help or error
    $self-&gt;{USAGE} = "";
    # required for generating variable names
    $self-&gt;{_TMPNUM} = 0;

    # trap the original accumulator;
    $self-&gt;{_ACCUMULATOR} = $^A;

    # temporay variable
    # to store help status
    my $tmpHelpVar = 0;
    $self-&gt;{_HELPSAT} = \$tmpHelpVar;

    # hash where reference user supplied
    # variables are stored
    $self-&gt;{_VARIABLES} = {};
    # hash where user defined functions are stored
    $self-&gt;{_FUNCTIONS} = {};

    # used in case wrong option is given
    $self-&gt;{_UNKNOWN_OPTIONS} = [];

    # begin generating main loop
    $self-&gt;{LOOP_STRING} = &lt;&lt;'BEGINARG';
    while (@{$self-&gt;{ARGS}}) {
        $_ = shift @{$self-&gt;{ARGS}};
BEGINARG

    return $self;
}

# process scalar argument
# usage: $arg-&gt;argScalar(option =&gt; \$scalar_variable,
#                        usage =&gt; "description",
#                        func =&gt; sub { return $_[0] });
sub argScalar {
    my $self   = shift;

    # get user supplied argument and variable (where
    # value is to be stored) and other options
    my ($arg, $variable, %options) = _makeOptions(@_);

    # store user supplied function and variable
    my ($varName, $funName) = $self-&gt;_getVarAndFuncName($variable,
							$options{func}
							|| undef);
    # generate code to handle scalar option
    $self-&gt;{LOOP_STRING} .= &lt;&lt;OPRIONARG;
        \/^-($arg)\$\/ &amp;&amp; ( do { my \$value = shift(\@{\$self-&gt;{ARGS}});
                               \${\$self-&gt;{_VARIABLES}{$varName}}
                                  = \$self-&gt;{_FUNCTIONS}{$funName}-&gt;(\$value);
                          }, next
                        );
OPRIONARG

    # make usage
    $self-&gt;_makeUsage($arg, %options);
}

# process switch argument
# passed variable will be turned on or off
# usage: $arg-&gt;argScalar(option =&gt; \$switch_variable,
#                        usage =&gt; "description");
sub argSwitch {
    my $self = shift;

    # get user supplied argument and variable (where
    # value is to be stored) and other options
    my ($arg, $variable, %options) = _makeOptions(@_);

    # store user supplied function and variable
    my ($varName, $funName) = $self-&gt;_getVarAndFuncName($variable,
							$options{func}
							|| undef);

    # generate code to handle switch option
    $self-&gt;{LOOP_STRING} .= &lt;&lt;OPRIONARG;
        \/^-($arg)\$\/ &amp;&amp; ( \${\$self-&gt;{_VARIABLES}{$varName}}
                          = \!\${\$self-&gt;{_VARIABLES}{$varName}}+0 , next);
OPRIONARG

    # make usage
    $self-&gt;_makeUsage($arg, %options);
}

# process array argument
# usage: $arg-&gt;argArray(option =&gt; \@array_variable,
#                       usage =&gt; "description",
#                       unique =&gt; 1,
#                       func =&gt; sub { return @_ });
sub argArray {
    my $self = shift;

    # get user supplied argument and variable (where
    # value is to be stored) and other options
    my ($arg, $variable, %options) = _makeOptions(@_);

    # uniqe list required (default: yes)
    my $unique = exists $options{unique} ? ($options{unique} || 0) : 1;

    # store user supplied function and variable
    my ($varName, $funName) = $self-&gt;_getVarAndFuncName($variable,
							$options{func}
							|| undef);
    my $param = $options{params};
    $param = 'undef' unless defined $param;
    $self-&gt;{_PARAMS}{$varName} = $param;

    # generate code to handle array option
    $self-&gt;{LOOP_STRING} .= &lt;&lt;OPRIONARG;
        \/^-($arg)\$\/ &amp;&amp;
             (do { my \%tmp = map { (\$_, 1)
                              } \@{\$self-&gt;{_VARIABLES}{$varName}};
                   while (\@{\$self-&gt;{ARGS}} and \$self-&gt;{ARGS}[0] !~ /^-/) {
                          my \$value = shift \@{\$self-&gt;{ARGS}};
                          my \@values
                              = \$self-&gt;{_FUNCTIONS}
                                 {$funName}-&gt;(\$value,
                                              \$self-&gt;{_PARAMS}{$varName});
                          if ($unique) {
                              \@values = grep { my \$stat = exists \$tmp{\$_};
                                                \$stat ||= 0;
                                                \$tmp{\$_} = 1 unless \$stat;
                                                !\$stat
                                         } \@values;
                          }
                          push(\@{\$self-&gt;{_VARIABLES}{$varName}}, \@values)
                            if \@values;
                   }}, next
             );
OPRIONARG

    # make usage
    $self-&gt;_makeUsage($arg, %options);
}

# process hash argument
# usage: $arg-&gt;argHash(option =&gt; \%hash_variable,
#                      usage =&gt; "description",
#                      func =&gt; sub { ... });
sub argHash {
    my $self = shift;

    # get user supplied argument and variable (where
    # value is to be stored) and other options
    my ($arg, $variable, %options) = _makeOptions(@_);

    # uniqe list required (default: yes)
    my $unique = exists $options{unique} ? ($options{unique} || 0) : 1;

    # store user supplied function and variable
    my ($varName, $funName) = $self-&gt;_getVarAndFuncName($variable,
							$options{func}
							|| undef);
    my $param = $options{params};
    $param = 'undef' unless defined $param;
    $self-&gt;{_PARAMS}{$varName} = $param;

    # generate code to handle hash option
    $self-&gt;{LOOP_STRING} .= &lt;&lt;OPRIONARG;
        \/^-($arg)\$\/ &amp;&amp;
             (do { while (\@{\$self-&gt;{ARGS}} and \$self-&gt;{ARGS}[0] !~ /^-/) {
                          my \$value = shift \@{\$self-&gt;{ARGS}};
                          my \$values
                              = \$self-&gt;{_FUNCTIONS}
                                 {$funName}-&gt;(\$value,
                                              \$self-&gt;{_PARAMS}{$varName});
			  my \$ref = ref(\$values);
			  unless (\$ref) {
			      \$self-&gt;{_VARIABLES}{$varName}{\$values} = 1;
			  } elsif ( \$ref eq 'HASH') {
			      foreach my \$key (keys \%\$values) {
				  \$self-&gt;{_VARIABLES}{$varName}{\$key}
				    = \$values-&gt;{\$key};
			      }
			  }
                   }}, next
             );
OPRIONARG

    # make usage
    $self-&gt;_makeUsage($arg, %options);
}

# finish the main loop
# usage: $arg-&gt;endArg;
sub endArg {
    my $self = shift;

    # generate code to provide help
    $self-&gt;argSwitch("h|help" =&gt; $self-&gt;{_HELPSAT},
		     usage =&gt; &lt;&lt;HELP, dispOption =&gt; "      ");
show this help.
HELP

    my @return = ();


    my $wantarray = wantarray || 0;

    # end the main loop
    # and push unhandled options
    $self-&gt;{LOOP_STRING} .= &lt;&lt;ENDLOOP;
        if (\$wantarray &amp;&amp; \$_ !~ /^-/) {
            push \@return, \$_;
        } else {
            push \@{\$self-&gt;{_UNKNOWN_OPTIONS}}, \$_;
        }
    }
ENDLOOP

    # run the main loop
    eval "$self-&gt;{LOOP_STRING}";
    if ($@) {
	print STDERR "OPS: $@ \n";
	my @array = split "\n", $self-&gt;{LOOP_STRING};
	my $i = 1;
	print STDERR map { sprintf("%3d: %s\n", $i++, $_) } @array;
	exit 1;
    }

    # reset format accumulator
    $^A = $self-&gt;{_ACCUMULATOR};

    return @return;
}

# display usage if require
# usage: $arg-&gt;usage($pre, $post);
# $pre: string or function reference
# $post: string or function reference
# NOTE: if not used help will not be generated
sub usage {
    my ($self, $pre, $pst) = @_;

    # generate string for unknown options
    my $unknown_options = (@{$self-&gt;{_UNKNOWN_OPTIONS}}
			   ? "(@{$self-&gt;{_UNKNOWN_OPTIONS}})" : "");
    $unknown_options = "$0: Unknown options $unknown_options\n"
      if $unknown_options;

    # handle error or simply help...
    if (${$self-&gt;{_HELPSAT}} || $unknown_options) {
	my $prefunc = ref($pre) eq 'CODE' ? $pre : sub { $pre || "" };
	my $pstfunc = ref($pst) eq 'CODE' ? $pst : sub { $pst || "" };

	print STDERR $unknown_options;
	print STDERR &amp;$prefunc || "";
	print STDERR $self-&gt;{USAGE};
	print STDERR &amp;$pstfunc || "";
        $unknown_options ? exit 100 : exit 0;
    }
}

# core code for formatting help
sub _makeUsage {
    my ($self, $option, %desc) = @_;

    my $description = $desc{usage} || "not ready yet!.";
    my $opts = $desc{dispOption} || "opts";

    my $olen = length($option.$opts) + 2;
    my $format = '@&gt;&gt;&gt;&gt;&gt;&gt;&gt;&gt;&gt;&gt;&gt;&gt;&gt;&gt;&gt;&gt;&gt;&gt;: ';
    if ($olen &gt; 19) {
	$format = '@' . '&gt;' x $olen . "\n" . " " x 19 . ": ";
    }

    my $len = 60;
    my $dformat = '^' . '&lt;' x $len . '~';
    my $dlen = length($description);
    my $line = int($dlen / $len);

    $line += 2;
    $format .= join "\n" . " " x 21, map {$dformat} 1..$line;
    my $str = '$^A = ""; formline($format, "-" . $option . '
      . '" $opts ", ' . ('$description, ' x $line) . '  ); $^A;';
    $str = eval $str;
    chomp($str);
    $str .= "\n";
    $self-&gt;{USAGE} .= $str;
}

sub _getVariableName {
    my $self = shift;

    return "VAR_" . (++$self-&gt;{_TMPNUM});
}

sub _makeOptions {
    my $option   = shift;
    my $variable = shift;
    return ($option, $variable, @_);
}

sub _getVarAndFuncName {
    my ($self, $variable, $function) = @_;

    my $varName = $self-&gt;_getVariableName;
    $self-&gt;{_VARIABLES}{$varName} = $variable;
    my $funName = $self-&gt;_getVariableName;
    $self-&gt;{_FUNCTIONS}{$funName} = sub { $_[0] };
    if ($function) {
	if (ref($function) eq 'CODE') {
	    $self-&gt;{_FUNCTIONS}{$funName} = $function;
	} else {
	    die "ERROR: func should be a reference to a function\n";
	}
    }

    return ($varName, $funName);
}

sub _value {
    my $val = shift;
    return defined $val ? $val : undef;
}

=head1 AUTHOR

Navneet Kumar, E&lt;lt&gt;F&lt;navneet_k@hotmail.com&gt;E&lt;gt&gt;

=cut

1;
</pre></body></html>