#!/usr/local/bin/perl

package Argv ;

use strict 'vars' ;

# declare all internal variables for use of strict during testing.

my(
$opt, $opt_num, $opt_ref, $opt_name, $opt_names, $opt_count,
$opt_list_ref, $opt_ref_type, $env_opts, @env_opts, $env_name,
$short_name, $long_name, %long_name_to_opt, %short_name_to_opt, $var_name,
$arg, $arg_val, @arg_vals, @val_range, @set_vals, %set_vals,
$prefix, $long_prefix, $argv_end_opt, $argv_env_name, @argv_permuted_args,
$usage, $usage_text, $default_val, $mutex, %mutex_opt, $sub_opt, @sub_opts,
%file_is_to_op, $file_test, $control_hash_ref, $argv_end_token, $permute,
$debug, $opt_val, $bool_opt_val, $sub_name, %no_long_name_to_opt,
) ;

# initialize hash to convert from 'file_is' attributes to perl file test ops

%file_is_to_op = (

	'plain' => '-f',
	'dir' => '-d',
	'symlink' => '-l',
	'block' => '-b',
	'char' => '-c',
) ;

# Argv's main external routine

sub Parse {

	( $opt_list_ref, $control_hash_ref ) = @_ ;

# check that the options descriptions is a ref to an array

	if ( ref $opt_list_ref ne 'ARRAY' ) {

		die "Options ref is not ARRAY, it is ",
						ref $opt_list_ref, "\n" ;
	}

# parse the control hash ref

	&parse_control ;

# preprocess the option descriptions

	&preprocess_opt_list ;

# parse @ARGV for options

	&parse_argv ;

# assign option values and defaults to their variables

	&assign_opt_vals ;

# put the permuted argument in the front of @ARGV

	unshift( @ARGV, @argv_permuted_args ) ;
}

# parse the control value hash

sub parse_control {

# if no ref to the control value hash was passed in, make a empty one

	if ( ! defined( $control_hash_ref ) ) {

		$control_hash_ref = {} ;
	}

# check that this is is a ref to a hash

	if ( ref $control_hash_ref ne 'HASH' ) {

		die "Control ref is not HASH, it is ",
					ref $control_hash_ref, "\n" ;
	}

# assign control values from the hash or by default

	$long_prefix = exists( $control_hash_ref->{'long_prefix'} ) ?
			$control_hash_ref->{'long_prefix'} : '-' ;

	$argv_end_token = exists( $control_hash_ref->{'argv_end'} ) ?
			$control_hash_ref->{'argv_opt_end'} : '--' ;

	$argv_env_name = exists( $control_hash_ref->{'argv_env_name'} ) ?
			$control_hash_ref->{'argv_env_name'} : '' ;

	$permute = exists( $control_hash_ref->{'permute'} ) ?
			$control_hash_ref->{'permute'} : 1 ;

	$debug = exists( $control_hash_ref->{'debug'} ) ?
			$control_hash_ref->{'debug'} : 0 ;


	if ( $debug > 0 ) {

		print STDERR
"Control Values:
	Long Prefix = '$long_prefix'
	Permute = '$permute'
	Debug = '$debug'
	Argv_env_name = '$argv_env_name'
	Argv_end_token = '$argv_end_token'

" ;
	}
}


# preprocess all the option descriptions

sub preprocess_opt_list {

# loop over the option description list
# use index numbers for error messages

	foreach $opt_num ( 0 .. $#{$opt_list_ref } ) {

# get this item in the list and get its ref type

		$opt_ref = $opt_list_ref->[$opt_num] ;
		$opt_ref_type = ref $opt_ref ;

# see if it is a ref
		if ( ! defined( $opt_ref_type ) ) {

			print STDERR
				"Argv: Option number $opt_num' is not a ref\n" ;
			exit -1  ;
		}

# see if it is a HASH ref
		if ( $opt_ref_type ne 'HASH' ) {

			print STDERR
"Argv: Option number $opt_num is not a HASH ref, it is a $opt_ref_type\n" ;
			return ;
		}

# preprocess this option

		&preprocess_opt( $opt_num ) ;
	}
}

# This routine preprocesses each option description. These are the
# operations it performs on each option:
#
# It checks for the short and long names and sets the default
# value of the 'var' attribute if needed.
#
# It builds three hashes to convert command line option names to
# a ref to their option description: long name to opt, long name with
# 'no' prefix to to and short name to opt.
#
# It sets the default of boolean options if needed
#
# It converts a 'set' attribute to a 'set_vals' attribute

sub preprocess_opt {

# get the option number

	my( $opt_num ) = @_ ;

# get the short, long and variable names

	$short_name = $opt_ref->{'short'} ;
	$long_name = $opt_ref->{'long'} ;
	$var_name = $opt_ref->{'var'} ;

	if ( $debug > 3 ) {
		print STDERR "
Argv: short = '$short_name'
      long = '$long_name'
      var = '$var_name'\n" ;

	}

# see if a long name is defined

	if ( defined( $long_name ) ) {

# store the ref to this option indexed by the long name

		$long_name_to_opt{ $long_name } = $opt_ref ;

# set the default variable name unless it has one

		$var_name = "opt_$long_name" unless defined( $var_name ) ;

# save the long name for error messages

		$opt_names = $long_name ;

# see if this is a boolean with a 'no' attribute

		if ( ! defined( $opt_ref->{'count'} ) &&
		     defined( $opt_ref->{'no'} ) ) {

# store the ref to this option indexed by the long name with 'no' prefixed

			$no_long_name_to_opt{ "no$long_name" } = $opt_ref ;
		}
	}
	else {

# no long name found

		$opt_names = undef ;
	}

# see if a short name is defined

	if ( defined( $short_name ) ) {

# check the that the short name length is 1

		if ( length( $short_name ) != 1 ) {

			print STDERR
"Argv: Option number $opt_num's short name $short_name is longer than 1\n" ;
			exit -1 ;
		}

# store the ref to this option indexed by the short name

		$short_name_to_opt{ $short_name } = $opt_ref ;

# set the default variable name unless it has one

		$var_name = "opt_$short_name" unless defined( $var_name ) ;

		if ( defined( $opt_names ) ) {

# append the short name for error messages

			$opt_names = "$short_name/$opt_names" ;
		}
		else {

			$opt_names = $short_name ;
		}
	}

# check to see that either a long or short name was found

	if ( ! defined( $opt_names ) ) {
		print STDERR "Argv: Option number $opt_num has no name\n" ;
		exit -1 ;
	}

# save the names and the variable name in the option description

	$opt_ref->{'names'} = $opt_names ;
	$opt_ref->{'var'} = $var_name ;

# see if this is a boolean with no default

	if ( ! defined( $opt_ref->{'count'} ) &&
	     ! defined( $opt_ref->{'default'} ) ) {

# give the boolean a default of 0

	     $opt_ref->{'default'} = 0 ;
	}

# see if this is not a boolean and it has a 'set' attribute
	if ( defined( $opt_ref->{'count'} ) &&
	     defined( $opt_ref->{'set'} ) ) {

# get the array of values from the 'set' attribute

		@set_vals = @{$opt_ref->{'set'}} ;

# initialize the 'set_vals' attribute with the keys and values of the
# hash being the same.
# this uses a hash slice

		@{$opt_ref->{'set_vals'}}{ @set_vals } = @set_vals ;
	}
}

# parse the options in @ARGV

sub parse_argv {

# see if there is  program environment variable and it exists

	if ( defined( $argv_env_name ) ) {

		$env_opts = $ENV{ $argv_env_name } ;

		if ( defined( $env_opts ) ) {

# split the ENV value on white space

			@env_opts = split( ' ', $env_opts ) ;

			if ( $debug > 1 ) {

				print STDERR
			"Argv: Options from ENV $argv_env_name =\n\t\t'",
					join( "'\n\t\t'", @env_opts ),
					"'\n" ;
			}

# put these options in front of @ARGV for parsing

			unshift( @ARGV, @env_opts ) ;
		}
	}

# loop over the tokens in @ARGV
# NOTE: @ARGV can grow if bundled short options get parsed

	while( @ARGV ) {

# get option token

		$opt = shift @ARGV ;

		if ( $debug > 5 ) {

			print STDERR "Argv: Option token = '$opt'\n" ;
		}

# see if this mark the end @ARGV

		if ( $opt eq $argv_end_token ) {

			if ( $debug > 2 ) {
				print STDERR "Argv: argv end option found\n";
			}

# found end of @ARGV marker; done parsing

			return ;
		}

# here come the big re
#
# this matches the required prefix ('-' or the long prefix)
# followed by a string up an '=' and another string
#
# the '=' and its argument string are optional

		$opt =~ /^(-|\Q$long_prefix\E)([^=]+)(=(.+))?$/o ;

		if ( $debug > 3 ) {

			print STDERR
			"prefix: '$1' option: '$2' equal: '$3' arg: '$4'\n" ;
		}

		$prefix = $1 ;

# see if this has no prefix which means it is a positional argument

		if ( ! defined( $prefix ) ) {

# see if we permute the positional arg (move it past options in @ARGV)

			if ( $permute ) {

				if ( $debug > 4 ) {

					print STDERR
					"Argv: permuted arg = '$opt'\n" ;
				}

# save the permuted arg for later when it get put back in front of @ARGV

				push( @argv_permuted_args, $opt ) ;
				next ;
			}
			else {
				if ( $debug > 4 ) {

					print STDERR
				"Argv: first positional arg = '$opt'\n" ;
				}

# put the arg back in front of @ARGV and stop parsing

				unshift( @ARGV, $opt ) ;
				return ;
			}
		}

# get the option name from the re

		$opt_name = $2 ;

# see if the '=' was found

		if ( defined( $3 ) ) {

			if ( $debug > 5 ) {
				print STDERR "Argv: option=arg found\n" ;
			}

# put the argument back into @ARGV for later use

			unshift( @ARGV, $4 ) ;
		}

		if ( $debug > 5 ) {
			print STDERR "Argv: option name: '$opt_name'\n" ;
		}

# clear any old option ref we may have had

		$opt_ref = undef ;

# look for a long prefix

		if ( $prefix eq $long_prefix ) {

# see if this long name is found

			$opt_ref = $long_name_to_opt{ $opt_name } ;

# if not found look for a 'no' prefix long name

			if ( ! defined( $opt_ref ) ) {

				$opt_ref = $no_long_name_to_opt{ $opt_name } ;

# 'no' prefix found! make the boolean value 0

				if ( defined( $opt_ref ) ) {

					if ( $debug > 3 ) {

						print STDERR
				"Argv: option $opt_name has a 'no' prefix\n" ;
					}

					$bool_opt_val = 0 ;
				}

			}
		}

# see if the long name wasn't found

		if ( ! defined( $opt_ref ) ) {

# this must be a short name.
# see if it is bundled (if the string is more than 1 char)

			if ( length( $opt_name ) > 1 ) {

				&parse_bundled_opts ;
				next ;
			}

# a single letter name, get its option

			$opt_ref = $short_name_to_opt{ $opt_name } ;

# if the short name wasn't found, error

			if ( ! defined( $opt_ref ) ) {

				print STDERR
				"Argv: Option '$opt_name' is unknown\n" ;
				&print_usage ;
			}

# set the boolean option value

			$bool_opt_val = 1 ;
		}

# see if this is a 'usage' or a 'help' option and call thos routines if so

		if ( defined( $opt_ref->{'is_usage'} ) ) {

			&print_usage ;
		}

		if ( defined( $opt_ref->{'is_help'} ) ) {

			&print_help ;
		}


# store the the used name of this option in its description

		$opt_ref->{'argv_name'} = $opt_name ;

# see if this option has a mutex attribute

		$mutex = $opt_ref->{'mutex'} ;

		if ( defined( $mutex ) ) {

# see if this mutex was set before

			if ( defined( $mutex_opt{ $mutex } ) ) {

				print STDERR
"Options '$opt_name' and '$mutex_opt{ $mutex }' are mutually exclusive\n" ;

				&print_usage ;
			}

# mutex was not used before; mark it used

			$mutex_opt{ $mutex } = $opt_name ;

			if ( $debug > 5 ) {
				print STDERR
			"Argv: option: '$opt_name' has mutex '$mutex'\n" ;
			}

		}
#

		$var_name = $opt_ref->{'var'} ;

		$opt_count = $opt_ref->{'count'} ;

#print "var name $var_name count $opt_count\n" ;

		if ( ! defined( $opt_count ) ) {

			$opt_ref->{'value'} = $bool_opt_val ;
		}
		elsif ( $opt_count == 1 ) {

			if ( @ARGV < 1 ) {

				print STDERR
				"Missing argument for opt '$opt_name'\n" ;
				&print_usage ;
			}

			$arg_val = shift @ARGV ;

#print "ARGV arg val: $arg_val\n" ;
			if ( defined( $opt_ref->{'subopt'} ) ) {

				@sub_opts = split( ',', $arg_val ) ;

				@sub_opts = map { /(.+)=(.+)/ ?
					      ("$long_prefix$1", $2) :
					      "$long_prefix$_" } @sub_opts ;

				unshift( @ARGV, @sub_opts ) ;
#print "sub ARGV @ARGV\n" ;
			}

			&check_arg_vals( $arg_val ) ;

			if ( defined( $opt_ref->{'multi'} ) ) {

				push( @{$opt_ref->{'value'}}, $arg_val ) ;
			}
			else {

				$opt_ref->{'value'} = $arg_val ;
			}
		}
		else {

			if ( @ARGV >= $opt_count ) {

				@arg_vals = splice( @ARGV, 0, $opt_count ) ;

#print "ARGV arg vals: @arg_vals\n" ;

				&check_arg_vals( @arg_vals ) ;


				@{$opt_ref->{'value'}} = @arg_vals ;
			}
			else {

				print STDERR
				"Missing arguments for opt '$opt_name'\n" ;
				exit -1 ;
			}
		}
	}
}

# This routine parses a bundled string of single letter (short)
# options. When it is done the unbundled options (each with a '-'
# prefix) and a possible attached scalar argument are pushed back into
# @ARGV for parsing

sub parse_bundled_opts {

	my( $opt_char, $bundled_text, @flag_opts ) ;

# save the bundled text for the error message

	$bundled_text = $opt_name ;

# loop until no more letters in bundled string

	while( $opt_name ne '' ) {

# get the first letter and rest of the string

		$opt_char = substr( $opt_name, 0, 1 ) ;
		$opt_name = substr( $opt_name, 1 ) ;

		print STDERR "Argv: Bundled char $opt_char\n" if $debug > 2 ;

# look up this single letter option 

		$opt_ref = $short_name_to_opt{ $opt_char } ;

# see if it not found, then error

		if ( ! defined( $opt_ref ) ) {

			 print STDERR
	"Argv: Bundled option '$opt_char' in '$bundled_text' is unknown\n" ;
			 &print_usage ;
		}

# save this option with the 'short' prefix char

		push( @flag_opts, "-$opt_char" ) ;

# see if this was a scalar option

		if ( defined( $opt_ref->{'count'} ) ) {

# see if this is an attached scalar argument
# use the rest of the token for the argument if there are any chars in it

			push( @flag_opts, $opt_name ) if $opt_name ne '' ;
			last ;
		}
	}

# put these unbundled option back into @ARGV for parsing

	unshift( @ARGV, @flag_opts ) ;
}



sub check_arg_vals {

	my( @arg_values ) = @_ ;

	$sub_name = $opt_ref->{'sub'} ;
	if ( defined( $sub_name ) && defined( &{"::$sub_name"} ) ) {

		if ( &{"::$sub_name"}( $opt_ref, @arg_values ) == 1 ) {
			return ;
		}
		
		&print_usage ;
	}

#print "check vals: @arg_values\n" ;

	my( $arg_val ) ;

	foreach $arg_val ( @arg_values ) {


		if ( defined( $opt_ref->{'is_int'} ) ) {

			if ( $arg_val !~ /^[+-]?\d+$/ ) {

				print STDERR
"\nOption '$opt_ref->{'argv_name'}' value '$arg_val' is not an integer\n" ;
				&print_usage ;
			}
		}

		if ( defined( $opt_ref->{'is_hex'} ) ) {

			if ( $arg_val !~ /^(0[xX])?[a-fA-F\d]+$/ ) {

				print STDERR
"\nOption '$opt_ref->{'argv_name'}' value '$arg_val' is not hex\n" ;
				&print_usage ;
			}
		}

		if ( defined( $opt_ref->{'is_oct'} ) ) {

			if ( $arg_val !~ /^0[0-7]+$/ ) {

				print STDERR
"\nOption '$opt_ref->{'argv_name'}' value '$arg_val' is not octal\n" ;
				&print_usage ;
			}
		}

		if ( defined( $opt_ref->{'is_float'} ) ) {

#/^(\+|-)?(\d+\.?\d*|\.\d+)([eE](\+|-)?\d+)?$/

			unless ( $arg_val =~
				/^[+-]?(\d+)?(\.)?(\d+)?([eE][+-]?\d+)?$/ &&
			     ($1 ne '' || $3 ne '') && ( $2 || $4 ) ) {

				print STDERR
"\nOption '$opt_ref->{'argv_name'}' value '$arg_val' is not a float\n" ;
				&print_usage ;
			}
		}

		if ( defined( $opt_ref->{'file_is'} ) ) {

			$file_test = $file_is_to_op{$opt_ref->{'file_is'}} ;

#print "file test $file_test\n" ;

			if ( defined( $file_test ) &&
			     ! eval "$file_test '$arg_val'" ) {

				print STDERR
"\nOption '$opt_ref->{'argv_name'}' value '$arg_val' is not a $opt_ref->{'file_is'} file\n" ;
				&print_usage ;
			}
		}

		if ( defined( $opt_ref->{'set_vals'} ) ) {

			%set_vals = %{$opt_ref->{'set_vals'}} ;

			$arg_val = $set_vals{ $arg_val } ;

			if ( ! defined( $arg_val ) ) {

				print STDERR
"\nOption '$opt_ref->{'argv_name'}' value '$arg_val' is not in set:\n\t{",
join( ' | ', sort keys %set_vals ), " }\n" ;

				&print_usage ;
			}
		}


		if ( defined( $opt_ref->{'range'} ) ) {

			@val_range = @{$opt_ref->{'range'}} ;
#print "RANGE var $var_name range @val_range\n" ;

			if ( $arg_val < $val_range[0] ) {
				print STDERR
"\nOption '$opt_ref->{'argv_name'}' value '$arg_val' < range [@val_range]\n" ;
				&print_usage ;
			}

			if ( $arg_val > $val_range[1] ) {
				print STDERR
"\nOption '$opt_ref->{'argv_name'}' value '$arg_val' > range [@val_range]\n" ;
				&print_usage ;
			}
		}
	}
}

sub assign_opt_vals {

#	local( $opt_val ) ;

	foreach $opt_ref ( @{$opt_list_ref } ) {

		$var_name = $opt_ref->{'var'} ;
		$opt_count = $opt_ref->{'count'} ;
#		$opt_val = ( exists( $opt_ref->{'value'} ) ) ?
#					$opt_ref->{'value'} : undef ;
		$opt_val = $opt_ref->{'value'} ;


		if ( ! defined( $opt_val ) ) {

			$env_name = $opt_ref->{'env'} ;

			if ( defined( $env_name ) ) {

				if ( ! defined( $opt_count ) ) {

				     $opt_val = 1 ;
				}
				elsif ( $opt_count == 1 ) {

				     $opt_val = $ENV{ $env_name } ;
				}
				else {

				     $opt_val =
				     	[ split( ' ', $ENV{ $env_name } ) ] ;
				}
			}
		}

		if ( ! defined( $opt_val ) ) {

			$default_val = $opt_ref->{'default'} ;

			if ( defined( $default_val ) ) {

				$opt_val = $default_val ;
			}
		}

#print "var $var_name value $opt_val default $default_val\n" ;

		if ( ! defined( $opt_count ) ) {

			if ( defined( $opt_ref->{'invert'} ) ) {
#print "val $opt_val\n";

				$opt_val = ( $opt_val ) ? 0 : 1 ;
#print "ival $opt_val\n";
			}

			${"::$var_name"} = $opt_val ;
		}
		else {

#print "2name $var_name opt val $opt_val default $default_val \n" ;
			if ( defined( $opt_val ) ) {

				if ( defined( ref( $opt_val ) ) ) {
#print "name $var_name opt val $opt_val default $default_val \n" ;

					@{"::$var_name"} = @{$opt_val} ;

#print "var $var_name array: @{$opt_val}\n" ;
#print "main var $var_name array: ", @{"main::$var_name"}, "\n" ;
				}
				else {

#print "var $var_name scalar: $opt_val\n" ;
					${"::$var_name"} = $opt_val ;
			}
			}
			elsif ( defined( $opt_ref->{'required'} ) ) {

				print STDERR
		"\nRequired option '$opt_ref->{'names'}' has no value\n" ;
				&print_usage ;
			}
		}
	}
}


sub print_usage {

	if ( defined( &::usage ) ) {
		&::usage ;
		exit( -1 ) ;
	}

	$usage_text = "\nUsage: $0 " ;

	foreach $opt_ref ( @{$opt_list_ref } ) {

		$usage = $opt_ref->{'usage'} ;
#print "'$usage'\n" ;

		next unless defined( $usage_text ) ;

		if ( length( $usage_text ) + length( $usage ) < 70 ) {

			$usage_text .= " $usage" ;
		}
		else {

			print STDERR "$usage_text\n" ;
			$usage_text = "\t$usage" ;
		}
	}

	print STDERR "$usage_text\n\n" ;

	exit -1 ;
}

sub print_help {

	if ( defined( &::help ) ) {
		&::help ;
		exit( -1 ) ;
	}

	print STDERR  "\n\nHelp for $0\n\n" ;
	foreach $opt_ref ( @{$opt_list_ref } ) {

		print STDERR $opt_ref->{'help'} ;
	}

	print STDERR  "\n\n" ;

	exit -1 ;
}

1 ;

__END__

=head1 NAME

=item

B<Argv> - A flexible and extendable attribute based Argv parser for Perl5

=head1 SYNOPSIS

=item

The B<Argv> package is an attribute based parser for command line
options of Perl5 scripts. It is designed to be very easy to use,
highly flexible and user extendable. It handles all standard styles of
options and arguments including single character options and long
options with a user selectable prefix. It has a large set of argument
validation checks and support for usage and help strings.

=head1 DESCRIPTION

=item

Each B<Argv> option is described by a set of attribute/value pairs,
implemented as a hash reference. A ref to a list of these hashes is
the main argument to the B<Argv> parser (see I<USAGE> section). All
attributes are optional except for either I<short> or I<long>.
Attributes control the type of an option, how to get its arguments (if
any) and how to check the validity of those arguments.

Option attributes come in variety of flavors; boolean attributes just
need to be defined (their value is ignored but should be 1 for style
reasons), scalar attributes have a single scalar value and array and
hash attributes take those aggregates. A special case, the I<default>
attribute can take any type of value.

Options can be booleans, scalars, arrays or hashes and argument values
can be checked in a variety ways including numeric forms (integer,
hex, octal, float), file types (plain, directory, character and block
devices), value range, set membership, and by custom user code. Option
values can be set (in decreasing priority) by command line arguments,
a program specific environment variable, option specific environment
variables and option defaults. Options can have their own usage and
help text which and can be printed by the Argv package upon error
detection or if a specified option is parsed.

=head1 USAGE

=item

The B<Argv> package has one entry point, B<Argv::Parse> which takes 2
arguments, a reference to an array of option descriptions and an
optional reference to a hash of control values. An option description
is a hash comprised of attribute keys and their values. The control
argument is a hash of keys and values which affect global behavior of
the Argv package. The simplest option description has just either a
I<short> or a I<long> attribute (or both but it must have at least
one). These specify the string to look for in @ARGV with the
appropriate prefix. The Perl variable name that get the argument value
defaults to opt_<long> if that attribute is set or then
opt_<short>. You can set the variable name with the I<var> attribute.
The Perl data type of the variable is controlled by several
attributes: I<count>, I<multi> and I<subopt>. An option with no
I<count> attribute is a boolean and one with I<count> = 1 is a simple
scalar. See L<ATTRIBUTES> for more.

    NOTE:

    These are symbols used in the descriptions below:

    1		is used to enable boolean attributes
    <text>	is any text string
    <int>	is an integer
    <scalar>	is any scalar value
    <array>	is an array ref e.g. [ 1, 2 ]
    <hash>	is a hash ref e.g. { 'x' => 1, 'y' => 2 }
    <test>	is a file test name
                (plain, dir, symlink, block, char)

B<Argv::Parse> should be called in the BEGIN routine of main:: so it
can be executed before any other code and can affect internal perl
variable such as @INC. Emulation of the basic Getops package would
look like this:

    BEGIN {

        $argv_opts = [

    # boolean option -a sets variable $opt_a

            { 'short' => 'a' },

    # boolean option -bbb sets variable $opt_bbb

            { 'long' => 'bbb' },

    # boolean option -c or -ccc sets variable $opt_ccc

            {
                'short' => 'c',
                'long' => 'ccc'
            },

    # scalar option -d or -ddd sets variable $ddd_val

            {
                'short' => 'd',
                'long' => 'ddd'
                'count => 1,
                'var' => 'ddd_val'
            }
        ] ;

            &Argv::Parse( $argv_opts ) ;
    }

=head1 CONTROL VALUES

=item

These values control global behavior of the B<Argv> package. They are
passed to B<Argv::Parse> as a hash ref in the second argument. If it
is not used or any control values aren't set in the hash, the default
values will be used. Here is an example of how to set up the control
value hash:

    BEGIN {

        $argv_opts = [
            { 'short' => 'a' },
            { 'short' => 'b' },
        ] ;

        $argv_control = {
            'argv_env_name>' => 'OPT_ENV',
            'argv_end_token' => '++',
            'long_prefix>' => '--',
            'permute>' => 0,
     #      'debug>' => 1,		# comment out debug tracing
        } ;

        &Argv::Parse( $argv_opts, $argv_control ) ;
    }

These are the supported control values for the B<Argv> package. If this
argument is not used or a control key is not used, a default value is
assigned to each control variable.

=head2	Program Environment Variable

=item	'I<argv_env_name>'> => <text>	# name of env variable

=item

This sets the name of the program's environment variable which is
parsed for options before the command line is parsed. If this variable
exists it is split on white space and its tokens are unshifted into
@ARGV which is then parsed as usual. These options are parsed before
command line options and they can be overridden the command
line. There is no default value.

=head2 End of Argv Options

=item	'I<argv_end_token>' => '++'	# stop parsing after ++ is seen

This is the token which is recognized as the end of option tokens on
the command line. All tokens after this are left in @ARGV for the
program to use. The default is the POSIX value of '--'. The example
above changes it to '++'.

=head2 Long Name Prefix

=item	'I<long_prefix>' => '--'	# long options marked with --

=item

This is the prefix string which marks a token as a long name
option. Its default is '-' which is the same as for short options.
Commonly used values are C<'+' and '--'>.

=head2 Permute Arguments

=item	'I<permute>' => 0		# turn off permuting

=item

This is a boolean control value which allows positional arguments to
be permuted to after any named options. Any option token which doesn't
has a valid prefix is saved and later unshifted into @ARGV for use by
the program. For example, (assuming only boolean options) 'C<-a foo -b
bar>' would have the flags 'a' and 'b' set to 1 with @ARGV set to
('foo', 'bar' ). The default value for I<permute> is 1. The example
above turns of argument permuting.

=head2 Debug Trace Level

=item	'I<debug>' => 2			# print values and tokens

=item

This control value which set the debug trace level in Argv. If it is
grater than 0 the debug trace values are printed. The higher the
value, the more that gets printed. Its default value is 0 which mean
nothing gets printed. This is a rough description of what each debug
level prints:

	Level		Prints

	  0		Nothing
	  1		Control values
	  2		Program environment variable value
	  3		Prgogram flow and option values
	  4		Each token as it is parsed
	  5		Preprocess phase
	  6		Complete list of option descriptions
			after parsing

=head1 OPTION TYPES

=item

Argv options can be one of 5 types: boolean, scalar, multi-value
scalar, array and subopt. See L<USAGE> for examples of boolean and
scalar option descriptions.

=head2 Boolean

=item

Boolean options take no arguments and are guaranteed to have a value
of 0 or 1. They are stored into scalar variables.  Boolean option
short names can be bundled (e.g. -abc) The logical sense of the option
value is inverted by using the boolean attribute I<invert>
(e.g. option C<-a> has a value of 0 while its default value is 1). The
I<no> attribute allows an optional 'no' prefix in front of long
boolean option names and if the prefix is found, the option value is 0
instead of 1. If a boolean option has no I<default> attribute it is
given one with a value of 0.

=head2 Scalar

=item

Scalar options must have 1 argument and they are stored in scalar
variables. If the Scalar arguments can be attached (e.g. C<-I/dir1>)
or loose. A scalar option short name can be at the end of a bundled
set of boolean option short names and its argument can be attached or
loose (e.g. C<-abcI/dir1 -abcI> /dir1 ).

=head2 Multi-Value Scalar

=item

Multi-value scalar options have the same behavior as scalar options
but can appear multiple times in @ARGV. They are stored in array
variables. The most well known use is for multiple include path
options of the form C<-I/dir1 -I/dir2> ).  The following is an example
of that:

    {
        'short' => 'I',		# no long name
        'count => 1,		# scalar option
        'multi => 1,		# multiple values allowed
        'var' => 'inc_args	# store args in var @inc_args
    }

=head2 Array

=item

Array options must have the requested number of arguments and are
stored in array variables. If The following example describes a option
with three arguments. It would parse either:

    -A <one> <two> <three>
    -array <one> <two> <three>

    {
        'short' => 'A',		# short name
        'long' => 'array',	# long name
        'count => 3,		# 3 arguments needed
        'var' => 'array_args	# values into var @array_args
    }

=head2 Subopt

=item

A subopt option has an single argument which is in the form of a
suboption, i.e. a comma separated list of keywords, each with an
optional '=' and value (e.g C<-o> ro,root=foo,bg). It is stored in a
hash variable with the keys found in the argument and the values found
or 1 if there is no value.

=head1 OPTION ATTRIBUTES

=item

These are descriptions of all the supported optionsattributes in the
B<Argv> package. They are grouped int these catagories: B<Name>,
B<Type>, B<Help>, B<Default>, B<Validation>  and B<Miscelaneous>.

NOTE: You can add any custom attributes to an option description and
access them in the I<sub> to validate the argument. The B<Argv>
package ignores any attributes it doesn't use.

=head2 Name Attributes

These attributes control the names to be parsed in @ARGV and the
name of the option variable:

=item	'I<short>' => <text>	# Short name of option

=item	'I<long>' => <text>	# Long name of option

=item	'I<var>' => <text>	# Name of option variable

=item

The I<short> attribute defines the single letter name of an option and 
the I<long> attribute defines a long name for an option. One of these
MUST be defined or B<Argv> will print an error message and exit. These
attributes control the default name for the Perl variable name for
this option. If I<long> is set the the variable name is 'opt_' with
the value I<long> appended to it. If the I<long> attribute is not set
then the I<short> attribute value is appended.

You can define the name of the option variable directly with the
I<var> attribute.

Remember that these attributes only control the name of the variable
and not its type. You could have different options with the same
variable name but with differing types.

=head2 Type Attributes

=item

These attributes control the type of an option:

=item	'I<count>' => <int>	# Count of arguments for option

=item	'I<multi>' => 1		# Scalar opt is multivalued array

=item	'I<subopt>' => 1	# Scalar argument is suboption

The I<count> attribute divided options into three categories: boolean,
scalar and array. If I<count> is not defined, the option is boolean
and it takes no arguments and will have a value of 0 or 1.  If
I<count> equals one, the option is scalar and it takes one argument
which must exist.  If I<count> is greater than one, then it is an
array option and it takes I<count> arguments which must exist. All the
arguments are assigned to an array option variable. If the I<env>
attribute is set and the array option value comes from the
environment, the environment string is split on blanks. You can set
the I<split> attribute to change the split string.

The boolean attributes I<multi> and I<subopt> modify the
processing of the scalar value. If I<multi> is set, then the option
variable is an array and the scalar values are pushed onto the
array.

If I<subopt> is set then the scalar value is parsed for suboptions
keywords and optional values. The keywords and values are assigned to
a hash option variable. If a keyword has no value, it is given the
value 1.  If the I<env> attribute is set and array option value comes
from the environment, the environment string is split on ','
(comma). You can set the I<split> attribute to change the split
string. As a side effect, multiple occurences of a I<subopt> option
can be parsed and the suboptions are added to the same hash
variable. If this is not desired, you can set a unique value of the
I<mutex> attribute so only one I<subopt> option is allowed.
If the option has the I<set> attribute set, then only those keys found
in the set are allowed in the suboption.

See the I<USAGE> section for examples of boolean and scalar options.

See the I<OPTION TYPES> section for examples of multi-value and array
options.

This example of a I<subopt> option will create a hash variable with
this value:

    %mount_opts = ( 'rw' => 1, 'retry' => 4, 'bg' => 1 ) ;

    -o 'rw,retry=4,bg'

    {
        'short' => 'o',		# short name
        'count => 1,		# scalar option
        'subopt => 1,		# subopt option
        'var' => 'mount_opts	# use hash var %mount_opts
    }

=head2 Help Attributes

The B<Argv> package supports self documenting options. Each option
description can can a short I<usage> text and a longer I<help>
text. This is the only place where the order of the option
descriptions matters. The I<usage> and  I<help> texts are printed in
the order found in the list.

=item	'I<usage>' => <text>	# Usage text for option

=item	'I<help>' => <text>	# Help text for option

=item	'I<is_usage>' => 1	# Option prints usage

=item	'I<is_help>' => 1	# Option prints help

=item

The 'I<usage>' attribute has the text for the short "Usage"
message and the 'I<help>' attributes has the text for a longer
message. They are both optional.

The 'I<is_usage>' boolean attribute marks an option so that if it is
found a usage message is printed. First B<Argv> checks if the routine
B<main::usage> is defined, and if so it is called and the program
exits. This allows for a user supplied usage message.  Otherwise
B<Argv> will print on STDERR the string "Usage: $0 " and the text of
the 'I<usage>' attribute of each option in the order found in the
$argv_options array reference. The 'I<usage>' strings are line wrapped on
output.

A similar mechanism is supported for a longer help text. The
attributes are 'I<help>' for the help text and 'I<is_help>' to mark
the help option. The routine I<main::help> is called if
found. Otherwise the 'I<help>' strings are printed as is, with no
wrapping.

    $argv_opts = [
        {
            'short' => 'h'	# short option -h
            'is_usage' => 1,	# mark this as a usage option
            'usage' => '[-h]',	# usage text
            'help' =>
    "    [-h]            Print usage text\n",    # help text
        },
        {
            'short' => 'H'		# short option -H
            'long' => 'help'		# long option -help
            'is_help' => 1,		# mark this as a help option
            'usage' => '[-H] [-help]',	# usage text
            'help' =>
    "    [-H] [-help]    Print help text\n",     # help text
        },
    ] ;

=head2 Validation Attributes

=item

These attributes are used to check the validity of the option
arguments. In the case of a multiple argument values (either I<count>
> 1, I<multi> or I<subopt> is set). ALL arguments are checked for
validity. The keywords of a I<subopt> option argument are only checked
against the I<set> attribute values if it is defined.

=item	'I<sub>' => <text>	# Name of main:: sub to call

If the I<sub> attribute is set and the subroutine it names is defined
in main::, that routine is called. No other argument checking is done.
It is called with two arguments, a ref to the option description hash
and the argument value (or multiple values if it is an array
option). The check routine should return 1 if the arguments are valid
otherwise print an error message and return 0.

NOTE: You can add any custom attributes to an option description and
access them in the I<sub> to validate the argument. The B<Argv>
package ignores any attributes it doesn't use.

The following is a call of the I<sub> routine, its definition and an
example of a option which uses it:

    &{"::$sub_name"}( $opt_ref, @arg_values ) ;

    sub foo_check {

        my( $foo_ref, @foo_args ) = @_ ;

        ...

        return( 1 ) ;		# good values

        ...

	print STDERR 
    "\nOption '$foo_ref->{'argv_name'}' value '$arg_val' is lousy\n" ;
        return( 0 ) ;		# bad values
    }

    $argv_opts = [
        {
            'short' => 'f'		# short option -f
            'long' => 'foo'		# long option -foo
            'sub' => 'foo_check'	# call this to check args
            'help' =>
    "    [-f <arg>]
         [-foo <arg>]            Set foo value\n",    # help text
        },
    ] ;


=item	'I<is_int>' => 1	# Value must be an decimal integer

=item	'I<is_hex>' => 1	# Value must be a hex integer

=item	'I<is_oct>' => 1	# Value must be an octal integer

=item	'I<is_float>' => 1	# Value must be an float

=item

These boolean attributes check that the argument is a valid number.

NOTE: The I<is_float> attribute requires the float to have either a
decimal point or an exponent which means that plain integers will
fail. Let me know if you want to relax this restriction.

=item	'I<file_is>' => <test>	# Value must pass file test op

The I<file_is> attribute executes the associated file test operation
on the argument.  An error is printed if an argument fails the
test. They are used by name and more can be added if anyone asks for
them. The names and their corresponding ops are:

    'plain'	=> -f
    'dir'	=> -d
    'symlink'	=> -l
    'block'	=> -b
    'char'	=> -c

=item	'I<range>' => <array>	# value must in range

The I<range> attribute checks that an argument is inclusively between
two values. The attribute value is an array reference of length 2 with
the low range value first and then the high rnage value second.

    $argv_opts = [
        {
            'short' => 'n'		# short option -n
            'count' => 1,		# scalar option
            'range' => [ 1, 10 ],	# from 1 to 10 is allowed
            'usage' => '[-n <val>]',	# usage text
            'help' =>
    "    [-n <val>]            Set n  where 1 <= n <= 10\n",
        }
    ] ;


=item	'I<set>' => <array>	# values must be in array

=item	'I<set_vals>' => <hash>	# values must be key in hash

The I<set> and I<set_vals> attributes check that an argument exists in
a set of values. The I<set> attribute takes an array ref with contains
the allowed values. The argument value is stored in the option
variable. The I<set_vals> attribute takes a hash ref with the keys
being the allowed argument values The value stored in the option
variable is the hash value indexed by the argument value.  Internally
the I<set> attribute is converted to a I<set_vals> attribute with the
keys and values the same. 

    $argv_opts = [
        {
            'short' => 's'		# short option -s
            'count' => 1,		# scalar option
	    'var' => 'stooge_name',	# store in $stooge_name
            'set' => [ 'Moe', 'Larry', 'Curly' ],
            'usage' => '[-s <stooge>]',	# usage text
            'help' =>
    "    [-s <stooge>]            Pick a Stooge\n",
        },
        {
            'short' => 'p'		# short option -p
            'count' => 1,		# scalar option
            'multi' => 1,		# multi-value option
            'set_vals' => {
                'Moe' => 'Tom Christiansen',
                'Larry' => 'Larry Wall',
                'Curly' => 'Randal Schwartz'
            },
	    'var' => 'perl_stooges',	# store in @perl_stooges
            'usage' => '[-p <stooge>]',	# usage text
            'help' =>
    "    [-p <perl_stooge>]        Pick your favorite stooge\n",
        }
    ] ;


=head2 Default Attributes

These attributes are used to set default values and to name an
environment variable whose value is used.

=item	I<env> => <text>	# Name of ENV variable for option value

=item	I<default> => <boolean> | <scalar> | <array> | <hash>

=item

Options can get their values in one of four ways, (in decreasing
order of priority:

If an option is on the command line the value is taken from
there. 

Else if the control value 'I<argv_env_name> is set and the program
environment variable exists, it is split on white space and pushed
onto @ARGV before any parsing is done. Options set there can be
overridden on the command line (unless the I<mutex> attribute is
used. An option will mutex against itself!)

Else if the I<env> attribute is set and its value matches an environment
variable, that value is used.  Boolean options are set if this
environment variable exists and the value is ignored. If the I<multi>
atribute is set, the environment value is split on white space and
stored as an array. If the I<subopt> atribute is set, the environment
value is split on ',' (comma) and stored as a hash. The split string
may be set with the I<split> attribute.

Else if the I<default> attribute is set then its value is used. The
type of the I<default> should match the type of the option, but that
is not checked. Boolean options defaults should be 0 or 1, scalar
defaults should have a single scalar, array and multi-value defaults
should be an array reference and subopt defaults should be a hash
reference. If a boolean option has no I<default> attribute, it is
given one with a value of 0.

=head2 Miscellaneous Attributes

=item

These options modify parsing behavior

=item	'I<invert>' => 1		# Invert the boolean option value

The I<invert> attribute is only allowed on boolean options. It
inverts the value so that if it is set the value is 0 while its
default is normally 1. See the example following the I<no> attribute.

=item	'I<no>' => 1		# 'no' prefix for long name is ok

The I<no> attribute allows a boolean option to have its I<long> name
prefixed with 'no' and if the prefix is found the option value is 0
instead of 1. This is useful to turn off boolean options with default
values of 1 either from the environment or the I<default>
attribute.

        $argv_opts = [

            {
                'short' => 'c',
                'invert' => 1
            }

    # scalar option -d or -ddd sets variable $ddd_val

            {
                'short' => 'd',
                'long' => 'ddd'
                'count => 1,
                'var' => 'ddd_val'
            }
        ] ;

=item	'I<mutex>' => <text>	# Marks mutually exclusive options
	
=item

The I<mutex> attribute allows a set of options to be mutually
exclusive. Each of the options in a mutex set should have this
attribute set to a common string. If more than one of these
options is set an error is printed. You can have multiple
I<mutex> sets by using a different string for each set.
In this example, options 'a' and 'b' are mutually exclusive
and so are options 'c' and 'd'.

    {
        'short' => 'a',		# boolean option
        'mutex => 'foo',	# in mutex set 'foo'
    },
    {
        'short' => 'b',		# boolean option
        'mutex => 'foo',	# in mutex set 'foo'
    },
    {
        'short' => 'c',		# boolean option
        'mutex => 'bar',	# in mutex set 'bar'
    },
    {
        'short' => 'd',		# boolean option
        'mutex => 'bar',	# in mutex set 'bar'
    }

=item	'I<required>' => 1	# Option is required

The I<required> attribute is boolean and makes this option
required. If no option is found ARGV or from the environment then an
error is printed. If I<required> is set on an option which also has
the I<mutex> attribute set, then one of the set of options with the
same I<mutex> value must be found. NOTE: it makes little sense to use
this attribute with I<default> and in boolean options.

=item	'I<split>' => <text>	# split environment string on <text>

The I<split> attribute has as its value the string you want to use to
split environment variables. It is only used for array optionsIn this example

    {
        'long' => 'array',	# long name
        'count => 3,		# 3 arguments needed
        'split' => ':',		# split env on ':' (colon)
        'env' => 'ARRAY_OPT',	# environment variable name
        'var' => 'array_args	# values into var @array_args
    },

    export ARRAY_OPT=abc:123:XYZ

    @array_args = ( 'abc', '123', 'XYZ' ) ;

=head1 AUTHOR

=item

Uri Guttman <uri@sysarch.com>

=cut