Getopt::ExPar - Extended Parameters command line parser.

  use Getopt::ExPar;

  my($opt) = new Getopt::ExPar();

  Method-based command line argument parser.

  my($opt) = Getopt::ExPar::_new({ 'ooRoutines' => 1,
				   'development_check' => 1,});

  $opt->_parameter( <name>, <type>, <alias> );
  $opt->_parameter( <name>, <type> );
  $opt->_parameter( <name>, );

  $opt->_parameter( 'affiliation', 'string', 'aff' );

  $opt->_multi_parameter( <name>, { <arg1_name> => <type>, }, { <arg2_name> => <type>, }, { <arg3_name> => <type>, }, );

  $opt->_multi_parameter( 'starship',
			  { 'affiliation' => 'string' }, { 'class' => 'string' },
			  { 'name' => 'string' }, { 'designation' => 'string' } );

  $opt->_special_parameter( <name>, <pattern>, <type> );
  $opt->_special_parameter( <name>, <pattern>, );

  $opt->_multi_special_parameter( <name>, <pattern>, { <arg1_name> => <type>, }, { <arg2_name> => <type>, }, { <arg3_name> => <type>, }, );

  $opt->_help( <name>, <help_text> );

  $opt->_alias( <name>, <alias>, <alias2>, <alias3>, ... );

  $opt->_default( <name>, <default> );

  $opt->_default( 'affiliation', 'Federation', 'Klingon', );

  $opt->_default( 'starship', [ 'Federation', 'Constitution', 'USS Enterprise', 'NCC-1701', ], );

  $opt->_required( <name>, <help_text> );

  $opt->_keys( <name>,  );

  $opt->_mutually_exclusiev( <opt1>, <opt2>, <opt3>, );

  $opt->_required_group( <opt1>, <opt2>, <opt3>, );

  $opt->_unique( 'starship' );

package Getopt::ExPar;

$VERSION = "1.01";

# See the bottom of this file for the POD documentation.  Search for the string '=head'.

use English;
use strict;
use warnings;
use Carp;

use vars qw(@ISA $VERSION);

@ISA = qw();
use AutoLoader ();
*AUTOLOAD = \&AutoLoader::AUTOLOAD;

# ExPar.pm - Extended Parameters
#
# Harlin L. Hamilton Jr. <mailto:harlinh@cadence.com>
#
# This package is free, and can be modified or redistributed under # the same terms as Perl itself.

#### Method: new
#######################################################################
# Contructor routine.
#######################################################################
sub _new {
  my($class, $prefs) = @_;

  #Initilize $self
  my($self) = {};
  $self->{'prefs'} = {
    'ooRoutines' => 1,
    'development_check' => 0,
    'abbreviations' => 0,
    'filelistpref' => -1,
    'ignorecase' => 0,
    'switchglomming' => 0,
    'intermingledFiles' => 0,
  };
  $self->{'parameter'} = {};
  $self->{'aliasnamehash'} = {};

  #Overwrite elements in $self as specified by $prefs hash
  &__parse_prefs($self, $prefs) if ((defined $prefs) and (ref($prefs) eq 'HASH'));

  #Grab predefined types: integer, real, key, etc.
  &__assert_predefined_types($self);

  #Bless object into class and return
  bless $self, $class;
}

#Preference methods
sub _ooRoutines {
  my($self) = shift;
  my($value) = shift;
  if (defined $value) {
    $self->{'prefs'}->{'ooRoutines'} = $value;
  } else {
    return $self->{'prefs'}->{'ooRoutines'};
  }
}
sub _development_check {
  my($self) = shift;
  my($value) = shift;
  if (defined $value) {
    $self->{'prefs'}->{'development_check'} = $value;
  } else {
    return $self->{'prefs'}->{'development_check'};
  }
}
sub _abbreviations {
  my($self) = shift;
  my($value) = shift;
  if (defined $value) {
    $self->{'prefs'}->{'abbreviations'} = $value;
  } else {
    return $self->{'prefs'}->{'abbreviations'};
  }
}
sub _filelistpref {
  my($self) = shift;
  my($value) = shift;
  if (defined $value) {
    $self->{'prefs'}->{'filelistpref'} = $value;
  } else {
    return $self->{'prefs'}->{'filelistpref'};
  }
}
sub _ignorecase {
  my($self) = shift;
  my($value) = shift;
  if (defined $value) {
    $self->{'prefs'}->{'ignorecase'} = $value;
  } else {
    return $self->{'prefs'}->{'ignorecase'};
  }
}
sub _switchglomming {
  my($self) = shift;
  my($value) = shift;
  if (defined $value) {
    $self->{'prefs'}->{'switchglomming'} = $value;
  } else {
    return $self->{'prefs'}->{'switchglomming'};
  }
}
sub _intermingledFiles {
  my($self) = shift;
  my($value) = shift;
  if (defined $value) {
    $self->{'prefs'}->{'intermingledFiles'} = $value;
  } else {
    return $self->{'prefs'}->{'intermingledFiles'};
  }
}

#### Method: argl
############################################################################
#Routine to return the value (or the next value) of the specified parameter
############################################################################
sub _argl {
  my($self) = shift;
  my($parameter) = shift;
  return undef unless (exists $self->{'OPT'}->{$parameter});
  my($pKind) = (exists $self->{'special'}->{$parameter})? 'special' : 'parameter';
  if (ref($self->{'OPT'}->{$parameter}) eq 'SCALAR') {
    return $self->{'OPT'}->{$parameter};
  } elsif (ref($self->{'OPT'}->{$parameter}) eq 'ARRAY') {
    $self->{$pKind}->{$parameter}->{'cnt'} = 0
      unless (exists $self->{$pKind}->{$parameter}->{'cnt'});
    if ($self->{$pKind}->{$parameter}->{'cnt'} > $#{$self->{'OPT'}->{$parameter}}) {
      return undef;
    } elsif (@{$self->{'OPT'}->{$parameter}->[$self->{$pKind}->{$parameter}->{'cnt'}]} > 1) {
      return $self->{'OPT'}->{$parameter}->[$self->{$pKind}->{$parameter}->{'cnt'}++];
    } else {
      return $self->{'OPT'}->{$parameter}->[$self->{$pKind}->{$parameter}->{'cnt'}++]->[0];
    }
  }
}

#### Method: arglprepare
############################################################################
#Routine to prepare for calling _argl
############################################################################
sub _arglprepare {
  my($self) = shift;
  my($parameter) = shift;
  my($pKind) = (exists $self->{'special'}->{$parameter})? 'special' : 'parameter';
  delete $self->{$pKind}->{$parameter}->{'cnt'};
}

#### Method: arg
############################################################################
#Routine to return the *first* value for specified parameter unless the
# parameter is a 'switch' then return the scalar value.
############################################################################
sub _arg {
  my($self) = shift;
  my($parameter) = shift;
  return undef unless (exists $self->{'OPT'}->{$parameter});
  if (ref($self->{'OPT'}->{$parameter}) ne 'ARRAY') {
    return $self->{'OPT'}->{$parameter};
  } else {
    my($pKind) = (exists $self->{'special'}->{$parameter})? 'special' : 'parameter';
    my($r) = [];
    if ($pKind eq 'parameter') {
      if (@{$self->{'OPT'}->{$parameter}->[0]} == 1) {
	return $self->{'OPT'}->{$parameter}->[0]->[0];
      } else {
	return $self->{'OPT'}->{$parameter}->[0];
      }
    } else {
      return $self->{'OPT'}->{$parameter}->[0];
    }
    return undef;
  }
}

#### Method: argv/args
############################################################################
#Routine to return all values as an ARRAY ref for specified parameter.
# Or array of array refs if multiple arguments for specified parameter.
############################################################################
sub _argv { return &_args(@_); }
sub _args {
  my($self) = shift;
  my($parameter) = shift;
  return [] unless (exists $self->{'OPT'}->{$parameter});
  if (ref($self->{'OPT'}->{$parameter}) ne 'ARRAY') {
    return [ $self->{'OPT'}->{$parameter} ];
  } else {
    my($r) = [];
    my($pKind) = (exists $self->{'special'}->{$parameter})? 'special' : 'parameter';
    if ($pKind eq 'parameter') {
      foreach my $a ( @{$self->{'OPT'}->{$parameter}} ) {
        if ($#{$a} > 0) {
          my(@a) = @{$a};
          push(@{$r}, \@a); #array of arrays
        } else {
          push(@{$r}, $a->[0]); #array of scalars
        }
      }
    } else {
      foreach my $s ( @{$self->{'OPT'}->{$parameter}} ) {
	if ($#{$s} > 1) {
	  push(@{$r}, @{$s}[1..$#{$s}]); #array of arrays
	} else {
	  push(@{$r}, $s->[1]); #array of scalars
	}
      }
    }
    return $r;
  }
}

#### Method: argh
############################################################################
#Routine to return all values as a HASH ref for specified parameter.
# Hash keys are numeric preserving order of parameters.
#If multi_parameter, returns all args as hash of hashes where subhashes are
# name/value pairs.
############################################################################
sub _argh {
  my($self) = shift;
  my($parameter) = shift;
  return {} unless (exists $self->{'OPT'}->{$parameter});
  if (ref($self->{'OPT'}->{$parameter}) eq 'SCALAR') {
    return { $self->{'OPT'}->{$parameter} => 1 };
  } elsif (ref($self->{'OPT'}->{$parameter}) eq 'ARRAY') {
    my($pKind) = (exists $self->{'special'}->{$parameter})? 'special' : 'parameter';
    #If multi_parameter
    if (exists $self->{'parameter'}->{$parameter}) {
      if (exists $self->{'parameter'}->{$parameter}->{'name'}) {
	my($r) = {};
	foreach my $i ( 0 .. $#{$self->{'OPT'}->{$parameter}} ) {
	  $r->{$i} = { map { $self->{'parameter'}->{$parameter}->{'name'}->[$_],
			     $self->{'OPT'}->{$parameter}->[$i]->[$_] }
		       0 .. $#{$self->{'parameter'}->{$parameter}->{'name'}} };
	}
	return $r;
      } else {
	my($i) = 0;
	return { map { $i++, $_->[0] } @{$self->{'OPT'}->{$parameter}} };
      }
    } else { # special parameter
      if (@{$self->{'OPT'}->{$parameter}->[0]} == 1) {
	return { 0 => { $parameter => $self->{'OPT'}->{$parameter}->[0]->[0], }, };
      } elsif (@{$self->{'OPT'}->{$parameter}->[0]} == 2) {
	return { 0 => { $parameter => $self->{'OPT'}->{$parameter}->[0]->[0], 'opt' => $self->{'OPT'}->{$parameter}->[0]->[1], }, };
      } else {
	my($r) = {};
	foreach my $i ( 0 .. $#{$self->{'OPT'}->{$parameter}} ) {
	  $r->{$i} = { map { ($_ == 0)? $parameter : $self->{'special'}->{$parameter}->{'name'}->[$_-1],
			     $self->{'OPT'}->{$parameter}->[$i]->[$_] }
		       0 .. $#{$self->{'OPT'}->{$parameter}->[0]} };
	}
	return $r;
      }
    }
  } else {
    return undef;
  }
}

#### Method: argc
############################################################################
#Routine to return number of arguments for specified parameter
############################################################################
sub _argc {
  my($self) = shift;
  my($parameter) = shift;
  if (exists $self->{'OPT'}->{$parameter}) {
    if (ref($self->{'OPT'}->{$parameter}) eq 'ARRAY') {
      return $#{$self->{'OPT'}->{$parameter}}+1;
    } else {
      return $self->{'OPT'}->{$parameter};
    }
  } else {
    return 0;
  }
}

#### Method: arge/argt
############################################################################
#Routine to return 0/1 depending on existance of specified parameter.
# Or for special parameters, can check existance of a specific arg.
############################################################################
sub _arge { return &_argt(@_); }
sub _argt {
  my($self) = shift;
  my($parameter) = shift;
  return 0 unless (exists $self->{'OPT'}->{$parameter});
  my($pKind) = (exists $self->{'special'}->{$parameter})? 'special' : 'parameter';
  if ($pKind eq 'parameter') {
    return (exists $self->{'stats'}->{$parameter})? 1 : 0;
  } else {
    my($arg) = shift;
    return (exists $self->{'OPT'}->{$parameter}) unless (defined $arg);
    foreach my $a ( @{$self->{'OPT'}->{$parameter}} ) {
      return 1 if ($a->[0] =~ /$arg/);
    }
  }
  return 0;
}

#### Method: filelist/files
############################################################################
#Routine to return filelist if one exists
############################################################################
sub _files { return &_filelist(@_); }
sub _filelist {
  my($self) = shift;
  return undef unless (exists $self->{'OPT'}->{'filelist'});
  return ($self->{'OPT'}->{'filelist'});
}

#### Method: parse
#######################################################################
#Routine to parse the command line options
#######################################################################
sub _parse {
  my($self) = shift;
  my($argv) = shift;

  #Init some hashes
  $self->{'OPT'} = {};
  $self->{'stats'} = {};
  $self->{'actions'}->{'help'} = 0;

  #Parse @ARGV unless an array reference is passed in as second argument
  $argv = \@ARGV unless ((defined $argv) and (ref($argv) eq 'ARRAY'));

  #Do some development checking here
  if ($self->{'prefs'}->{'development_check'}) {
    #Check to make sure that a help_option value exists for all special parameters
    my($str) = [];
    foreach my $par ( keys %{$self->{'parameter'}} ) {
      push(@{$str}, $par) unless (exists $self->{'parameter'}->{$par}->{'help'});
    }
    foreach my $spec ( keys %{$self->{'special'}} ) {
      push(@{$str}, $spec) unless (exists $self->{'special'}->{$spec}->{'help'});
    }
    carp "Missing help text for these options: ", join(', ', sort @{$str}) if (@{$str} > 0);
    $str = [];
    foreach my $spec ( keys %{$self->{'special'}} ) {
      push(@{$str}, $spec) unless (exists $self->{'special'}->{$spec}->{'help_option'});
    }
    carp "Missing help_option string for these special parameters: ", join(', ', sort @{$str}) if (@{$str} > 0);
  }

  #Very first thing is to check for '-help' options.
  if (@{$argv} and ($argv->[0] eq '--help')) {
    $self->{'actions'}->{'help'} = 1;
    shift(@{$argv});
  } elsif (@{$argv} and ($argv->[0] eq '--full_help')) {
    $self->{'actions'}->{'help'} = 2;
    shift(@{$argv});

  #Check for first element of $argv for 'switchglomming'.  To meet this criteria,
  # the option must not match a defined parameter or alias, and it must not
  # match an abbreviated option if 'abbreviations' is enabled.
  #This 'if' statement also checks to make sure that the next command line argument
  # starts with a '-', OR that trailing file names are permitted.
  } elsif (($self->{'prefs'}->{'switchglomming'}) and
	   @{$argv} and ($argv->[0] =~ /^-([a-zA-Z0-9]+)$/) and
	   (($self->{'prefs'}->{'ignorecase'} and (not exists $self->{'parameter'}->{lc($1)})) or
	    (not exists $self->{'parameter'}->{$1})) and
	   (($self->{'prefs'}->{'ignorecase'} and (not exists $self->{'aliasnamehash'}->{lc($1)})) or
	    (not exists $self->{'aliasnamehash'}->{$1}))) {
    #Now that we've checked to see if it's a defined parameter or an alias, we need to
    # check to see if it's a match on a parameter abbreviation.
    my(@abb);
    if ($self->{'prefs'}->{'ignorecase'}) {
      @abb = grep { /(?i)^$argv->[0]/ } keys %{$self->{'parameter'}};
    } else {
      @abb = grep { /^$argv->[0]/ } keys %{$self->{'parameter'}};
    }
    #Ok, now check to see if it's a valid 'switchglomming' parameter.
    unless (($self->{'prefs'}->{'abbreviations'}) and @abb) {
      $argv->[0] =~ /^-([a-zA-Z0-9]+)$/;
      my($arg) = ($self->{'prefs'}->{'ignorecase'})? lc($1) : $1;
      #This bit of code makes sure that each letter of the potential switchglom is
      # a defined switch or alias for a swich.  Actually, any user-defined type that has
      # 0 arguments can be enabled through this switchglom mechanism.
      my($sg) = {};
      foreach ( split(//, $arg) ) {
        if (exists $self->{'aliasnamehash'}->{$_}) {
	  $sg->{$_} = 1
            if ($self->{'types'}->
                {$self->{'parameter'}->{$self->{'aliasnamehash'}->{$_}}->{'type'}->[0]}->
                {'number_of_arguments'} == 0);
        } elsif (exists $self->{'parameter'}->{$_}) {
	  $sg->{$_} = 1
            if ($self->{'types'}->
                {$self->{'parameter'}->{$_}->{'type'}->[0]}->
                {'number_of_arguments'} == 0);
        }
      }
      if ((scalar keys %{$sg}) == length($arg)) {
        foreach ( keys %{$sg} ) {
	  if ((exists $self->{'aliasnamehash'}->{$_}) or (exists $self->{'parameter'}->{$_})) {
	    delete $sg->{$_};
	  }
        }
        #If no keys left in %sg, then switchglomming found a successful match
        if ((scalar keys %{$sg}) == 0) {
          foreach my $switch ( split(//, $arg) ) {
            if (exists $self->{'parameter'}->{$switch}) {
              $self->{'OPT'}->{$switch} =
                $self->{'types'}->{$self->{'parameter'}->{$switch}->{'type'}->[0]}->{'specifiedvalue'};
              ++$self->{'stats'}->{$switch};
            } else {
              $self->{'OPT'}->{$self->{'aliasnamehash'}->{$switch}} =
                $self->{'types'}->{$self->{'parameter'}->{$self->{'aliasnamehash'}->{$switch}}->{'type'}->[0]}->{'specifiedvalue'};
              ++$self->{'stats'}->{$self->{'aliasnamehash'}->{$switch}};
            }
          }
          shift(@{$argv}); #remove switchglom from command line argument list
        }
      }
    }
  }

  #Loop through options and parse according to $self
  my($i) = 0;
  while ($i < @{$argv}) {

    #Check for 'ignorecase'
    my($cur_argv) = ($self->{'prefs'}->{'ignorecase'})? lc($argv->[$i]) : $argv->[$i];

    #Parse option
    my($origParameter) = $argv->[$i];
    my($parameter) = $origParameter;
    $parameter =~ s/^-//;
 
    #At this point, determine the correctly capitalized parameter if ignorecase
    if ($self->{'prefs'}->{'ignorecase'}) {
      my($a) = [ grep { lc($parameter) eq lc($_) } keys %{$self->{'parameter'}} ];
      if (@{$a} > 0) {
	$parameter = $a->[0];
      }
    }

    #Call help routine if $parameter is now '-help'
    if ($parameter =~ /(?i)^\-?h(e(l(p)?)?)?$/) {
      $self->{'actions'}->{'help'} = 1;
      $i++;
      next;
    #Call full_help routine if $parameter is now '-help'
    } elsif ($parameter =~ /(?i)^\-?full_h(e(l(p)?)?)?$/) {
      $self->{'actions'}->{'help'} = 2;
      $i++;
      next;
    }

    #Store croak message
    my($croak) = '';

    #Make sure this option exists.  First see if it's a defined parameter,
    # then see if it's an alias, then see if it's an abbreviation.
    if (not exists $self->{'parameter'}->{$parameter}) {
      if (exists $self->{'aliasnamehash'}->{$parameter}) {
        $parameter = $self->{'aliasnamehash'}->{$parameter};
      } elsif ($self->{'prefs'}->{'abbreviations'}) {
        my(@args) = grep { ($parameter =~ /^\W/)? /^\\$parameter/ : /^$parameter/ } keys %{$self->{'parameter'}};
        if (@args == 1) {
          if (exists $self->{'parameter'}->{$args[0]}) {
            $parameter = $args[0];
          } else {
            $croak = "Unknown option (-$parameter)";
          }
        } elsif (@args == 0) {
          $croak = "Unknown option (-$parameter)";
        } elsif (@args > 1) {
          $croak = "Ambiguous option (-$parameter) matches @args";
        }
      } else {
        $croak = "Unknown option (-$parameter)";
      }
    }

    if ( length($croak) ) {
      undef $parameter;
      #If $croak is not empty, then no match was found on parameters,
      # so check special parameters.
      if (exists $self->{'special'}) {
        foreach my $sp ( keys %{$self->{'special'}} ) {
          if (($cur_argv =~ /$self->{'special'}->{$sp}->{'special_pattern'}/) or
	      (($cur_argv =~ /(?i)$self->{'special'}->{$sp}->{'special_pattern'}/) and ($self->{'prefs'}->{'ignorecase'}))) {
            $parameter = $sp;
	    last;
          }
        }
      }

      #When at this point, assume argument is a file
      if (not defined $parameter) {
        if ($argv->[$i] !~ /^-/) {
          croak "File list not permitted (starting at '$argv->[$i]')"
            unless (($self->{'prefs'}->{'filelist'} > -1) or ($self->{'prefs'}->{'intermingledFiles'} == 1));
	  if ($self->{'prefs'}->{'intermingledFiles'} == 1) {
	    push(@{$self->{'OPT'}->{'filelist'}}, $argv->[$i]);
	    ++$i;
	    next;
	  } else {
	    push(@{$self->{'OPT'}->{'filelist'}}, @{$argv}[$i..$#{$argv}]);
	    last;
	  }
        }
        #Croak if $croak
        croak $croak if length($croak);
      }
    }

    #Determine parameter or special parameter
    my($pKind) = (grep { exists $self->{$_}->{$parameter} } ('parameter', 'special',))[0];

    #Handle argumentFile types here
    if ($self->{$pKind}->{$parameter}->{'type'}->[0] eq 'argumentFile') {
      my($file) = $argv->[$i+1];
      my($pat) = (exists $self->{$pKind}->{$parameter}->{'argumentFileComment'})?
	'(' . join('|', @{$self->{$pKind}->{$parameter}->{'argumentFileComment'}}) . ')' : '';
      open(AF, "< $file") or croak "Unable to open file $file for reading.\n\n";
      my($argStrArr) = [ 0 ];
      while (<AF>) {
	chomp;
	s/$pat.*$// if length($pat);
	next if /^\s*$/;
	push(@{$argStrArr}, $_);
      }
      close AF;
      my(@args) = `perl -e 'print join(\"\\n\", \@ARGV), \"\\n\";' @{$argStrArr}`;
      chomp(@args);
      splice(@{$argv}, $i, 2, @args);
      splice(@{$argv}, $i, 1);
      $i -= 2;
    }

    #Count parameter instances
    ++$self->{'stats'}->{$parameter};

    #Assign value into $self->{'OPT'}:
    #Handle special case of type that has no arguments (like type 'switch')
    if ($self->{'types'}->{$self->{$pKind}->{$parameter}->{'type'}->[0]}->{'number_of_arguments'} == 0) {
      if ($pKind eq 'parameter') {
        $self->{'OPT'}->{$parameter} =
          $self->{'types'}->{$self->{$pKind}->{$parameter}->{'type'}->[0]}->{'specifiedvalue'};
      } else {
	#since this is a 'special', check pattern and store $1 if it exists
	$argv->[$i] =~ /$self->{'special'}->{$parameter}->{'special_pattern'}/;
	if (defined $1) {
	  push(@{$self->{'OPT'}->{$parameter}}, [ $1 ]);
	} else {
	  push(@{$self->{'OPT'}->{$parameter}}, [ $argv->[$i] ]);
	}
      }
    } else {
      my($args) = [];
      foreach my $typeIndex ( 0 .. $#{$self->{$pKind}->{$parameter}->{'type'}} ) {
	my($type) = $self->{$pKind}->{$parameter}->{'type'}->[$typeIndex];
        croak "Not enough arguments for '$parameter'" unless ($i < $#{$argv});
        my($arg) = $argv->[++$i];
        #Check type specifications first
        if (exists $self->{'types'}->{$type}->{'arguments'}->[0]->{'pattern'}) {
          foreach my $p ( @{$self->{'types'}->{$type}->{'arguments'}->[0]->{'pattern'}} ) {
            croak join('', "Bad $type value ($arg) for parameter '$parameter'",
		       (($pKind eq 'special')? '('.$argv->[$i-@{$args}-1].')' : ''))
              if ($arg !~ /$p/);
          }
        }
        #Now check parameter specifications
        if ((exists $self->{$pKind}->{$parameter}) and
            (exists $self->{$pKind}->{$parameter}->{'pattern'})) {
          foreach my $pat ( @{$self->{$pKind}->{$parameter}->{'pattern'}->[$#{$args}+1]} ) {
            croak join('', "Bad $type value ($arg) for parameter '$parameter'",
		       (($pKind eq 'special')? '('.$argv->[$i-@{$args}-1].')' : ''))
              if ($arg !~ /$pat/);
          }
        }
        #Now check for key match if keys defined
        if ((exists $self->{$pKind}->{$parameter}) and
            (exists $self->{$pKind}->{$parameter}->{'keys'}) and
	    (defined $self->{$pKind}->{$parameter}->{'keys'}->[$typeIndex])) {
	  croak join('', "Bad value ($arg) for parameter '$parameter'",
		     (exists $self->{$pKind}->{$parameter}->{'name'})?
		     ", subParameter '$self->{$pKind}->{$parameter}->{'name'}->[$typeIndex]'" : '',
		     ". Valid values are (", 
                     join(', ', @{$self->{$pKind}->{$parameter}->{'keys'}->[$typeIndex]}), ")")
            unless (exists { map { $_, 1 } @{$self->{$pKind}->{$parameter}->{'keys'}->[$typeIndex]} }->{$arg});
        }

        push(@{$args}, $arg);
	$self->{$pKind}->{$parameter}->{'values'}->{$arg} = 1;
      }

      my($vals) = {};
      if ((exists $self->{'OPT'}->{$parameter}) and (ref($self->{'OPT'}->{$parameter}) eq 'ARRAY')) {
	foreach ( @{$self->{'OPT'}->{$parameter}} ) {
	  $vals->{"@{$_}"} = 1;
	}
      }

      if ($pKind eq 'parameter') {
        push(@{$self->{'OPT'}->{$parameter}}, $args);
      } else {
        push(@{$self->{'OPT'}->{$parameter}}, [ $argv->[$i-@{$args}], @{$args} ]);
      }

      #Do unique check here
      croak "Duplicate arguments '@{$self->{'OPT'}->{$parameter}->[$#{$self->{'OPT'}->{$parameter}}]}' found for option '$parameter' which requries unique arguments"
	if (($self->{$pKind}->{$parameter}->{'unique'}) and (exists $vals->{"@{$self->{'OPT'}->{$parameter}->[$#{$self->{'OPT'}->{$parameter}}]}"}));

    }
    ++$i;
  }

  #Do all argument checking here (prior to default bindings) unless help is requested
  if ($self->{'actions'}->{'help'} == 0) {
    #Check for mutual exclusion
    if (exists $self->{'checks'}->{'mutex'}) {
      foreach my $mutex ( @{$self->{'checks'}->{'mutex'}} ) {
	my($set) = [ grep { exists $self->{'stats'}->{$_} } @{$mutex} ];
	croak "Invalid argument set.  The following options are mutually exclusive: " .
	  join(', ', @{$set}) if (@{$set} > 1);
      }
    }
    #Check for required arguments
    foreach my $p ( keys %{$self->{'parameter'}} ) {
      croak "Required parameter '$p' not specified"
	if ($self->{'parameter'}->{$p}->{'required'} and (not exists $self->{'OPT'}->{$p}));
    }
    #Check for req_grps
    if (exists $self->{'checks'}->{'req_grp'}) {
      foreach my $req_grp ( @{$self->{'checks'}->{'req_grp'}} ) {
	my($set) = [ grep { exists $self->{'stats'}->{$_} } @{$req_grp} ];
	croak "Invalid argument set.  The following options must be used together: " .
	  join(', ', @{$req_grp}) if ((@{$set} != 0) and (@{$set} != @{$req_grp}));
      }
    }
  }

  #Loop through all parameters to see if they've been defined, and if not,
  # assign default values if they exist.
  foreach my $p ( keys %{$self->{'parameter'}} ) {
    next if (exists $self->{'OPT'}->{$p});
    #Assign 'unspecified' values to any parameters w/ zero arguments that weren't specified
    if ($self->{'types'}->{$self->{'parameter'}->{$p}->{'type'}->[0]}->{'number_of_arguments'} == 0) {
      $self->{'OPT'}->{$p} = $self->{'types'}->{$self->{'parameter'}->{$p}->{'type'}->[0]}->{'unspecifiedvalue'};
    } elsif ($self->{'types'}->{$self->{'parameter'}->{$p}->{'type'}->[0]}->{'number_of_arguments'} == 1) {
      @{$self->{'OPT'}->{$p}} = @{$self->{'parameter'}->{$p}->{'default'}}
        if (exists $self->{'parameter'}->{$p}->{'default'});
    }
  }

  #If -help was specified, print help and quit
  &__print_help($self, $argv, $self->{'actions'}->{'help'})
    if ((exists $self->{'actions'}->{'help'}) and ($self->{'actions'}->{'help'} > 0));

}

#### Method: parameter
#######################################################################
# Routine to define a parameter
#######################################################################
sub _parameter {
  my($self) = shift;
  if (@_ == 1) {
    if (ref($_[0]) eq 'HASH') {
      foreach my $p ( keys %{$_[0]} ) {
        &__assign_parameter($self, $p, $_[0]->{$p});
      }
    } else {
      &__assign_parameter($self, $_[0], 'switch');
    }
  } elsif ($_[1] eq 'switches') {
    foreach my $p ( split(//, $_[0]) ) {
      &__assign_parameter($self, $p, 'switch');
    }
  #parameter properties passed in as a hash: { 'type' => 'integer', }
  } elsif (ref($_[1]) eq 'HASH') {
    #make sure type is specified in HASH
    if ($self->{'prefs'}->{'development_check'}) {
      croak "'type' must be specified in HASH passed to _parameter method"
	unless ($_[1]->{'type'});
    }
    #do 'type' first, then do other properties ('default', 'alias', etc.)
    &_type($self, $_[0], $_[1]->{'type'});
    foreach my $prop ( grep { !/^type$/ } keys %{$_[1]} ) {
      no strict 'refs';
      &{"_$prop"}($self, $_[0], $_[1]->{$prop});
    }
  } else {
    my($p) = shift;
    my($t) = shift;
    &__assign_parameter($self, $p, $t);
    &_alias($self, $p, @_) if @_;
  }
}
sub _p { &_parameter(@_); }

#### Method: required_parameter
#######################################################################
# Routine to define a required parameter
#######################################################################
sub _requiredParameter { &_required_parameter(@_); }
sub _required_parameter {
  &_parameter(@_);
  &_required(@_);
}
sub _reqp { &_required_parameter(@_); }
sub _rp { &_required_parameter(@_); }

#######################################################################
# Routine to define a type for a specified parameter
#######################################################################
sub _type { &__assign_parameter(@_); }
sub _t { &_type(@_); }

#######################################################################
# Routine to create hash for specified parameter
#######################################################################
sub __assign_parameter {
  my($self, $parameter, $type) = @_;
  if ($self->{'prefs'}->{'development_check'}) {
    #Check to make sure that parameter is a scalar
    croak "Inappropriate parameter identifier '$parameter'" if ref($parameter);
    #Check to make sure that parameter of that same name doesn't already exit
    croak "Multiply defined parameter '$parameter'"
      if (exists $self->{'parameter'}->{$parameter});
    #Check to make sure that the specified type exists
    croak "Unknown type '$type' cannot be used by option '$parameter'"
      unless (exists $self->{'types'}->{$type});
    #Make sure parameter is not defined as an alias for an existing parameter
    foreach my $a ( %{$self->{'aliasnamehash'}} ) {
      croak "Invalid parameter '$parameter': already defined as an alias for '$self->{'aliasnamehash'}->{$parameter}'"
        if (exists $self->{'aliasnamehash'}->{$parameter});
    }
  }
  $self->{'parameter'}->{$parameter} = { 'type' => [$type], 'unique' => [0], };
  $self->{'parameter'}->{$parameter}->{'required'} = 0;
  $self->{'parameter'}->{$parameter}->{'unique'} = 0;
  $self->{'parameter'}->{$parameter}->{'_ptype'} = 'single';

  &__ooRoutines($self, $parameter);
}

#### Method: multi_parameter
#######################################################################
# Routine to define a parameter w/ multiple arguments
#######################################################################
sub _mp { &_multi_parameter(@_); }
sub _multiParameter { &_multi_parameter(@_); }
sub _multi_parameter {
  my($self) = shift;
  my($parameter) = shift;
  if ($self->{'prefs'}->{'development_check'}) {
    carp "Calling multi_parameter w/ only one named subparameter" if (@_ == 1);
  }
  $self->{'parameter'}->{$parameter}->{'required'} = 0;
  $self->{'parameter'}->{$parameter}->{'unique'} = 0;
  $self->{'parameter'}->{$parameter}->{'_ptype'} = 'multi';
  foreach my $mp ( @_ ) {
    croak "Call to multi_parameter must have HASH references as arguments"
      unless (ref($mp) eq 'HASH');
    croak "Call to multi_parameter must have HASH references w/ only one key"
      unless ((scalar keys %{$mp}) == 1);
    my($name) = (keys %{$mp})[0];
    my($type) = $mp->{$name};
    if ($self->{'prefs'}->{'development_check'}) {
      croak "Multiply defined subparameter '$name' in declaration of '$parameter'"
        if (exists $self->{'parameter'}->{$parameter}->{'nameOrder'}->{$name});
      croak "Unknown type '$type' cannot be used by option '$parameter:$name'"
        unless (exists $self->{'types'}->{$type});
    }
    push(@{$self->{'parameter'}->{$parameter}->{'type'}}, $type);
    push(@{$self->{'parameter'}->{$parameter}->{'name'}}, $name);
    $self->{'parameter'}->{$parameter}->{'nameOrder'}->{$name} =
      $#{$self->{'parameter'}->{$parameter}->{'name'}};
  }
  &__ooRoutines($self, $parameter);
}

#### Method: required_multi_parameter
#######################################################################
# Routine to define a required multi parameter
#######################################################################
sub _requiredMultiParameter { &_required_multi_parameter(@_); }
sub _required_multi_parameter {
  &_multi_parameter(@_);
  &_required(@_);
}
sub _rmp { &_required_multi_parameter(@_); }

#### Method: multi_special
#######################################################################
# Routine to define a special w/ multiple arguments
#######################################################################
sub _multiSpecial { &_multi_special(@_); }
sub _multiSpecialParameter { &_multi_special_parameter(@_); }
sub _multi_special { &_multi_special_parameter(@_); }
sub _multi_special_parameter {
  my($self) = shift;
  my($special) = shift;
  my($special_pattern) = shift;
  if ($self->{'prefs'}->{'development_check'}) {
    carp "Calling multi_special w/ only one named subparameter" if (@_ == 1);
  }
  $self->{'special'}->{$special}->{'required'} = 0;
  foreach my $mp ( @_ ) {
    croak "Call to multi_special must have HASH references as arguments"
      unless (ref($mp) eq 'HASH');
    croak "Call to multi_special must have HASH references w/ only one key"
      unless ((scalar keys %{$mp}) == 1);
    my($name) = (keys %{$mp})[0];
    my($type) = $mp->{$name};
    if ($self->{'prefs'}->{'development_check'}) {
      croak "Multiply defined subparameter '$name' in declaration of '$special'"
        if (exists $self->{'special'}->{$special}->{'nameOrder'}->{$name});
      croak "Unknown type '$type' cannot be used by option '$special:$name'"
        unless (exists $self->{'types'}->{$type});
    }
    push(@{$self->{'special'}->{$special}->{'type'}}, $type);
    push(@{$self->{'special'}->{$special}->{'name'}}, $name);
    $self->{'special'}->{$special}->{'nameOrder'}->{$name} =
      $#{$self->{'special'}->{$special}->{'name'}};
  }
  $self->{'special'}->{$special}->{'special_pattern'} = $special_pattern;
  &__ooRoutines($self, $special);
}
sub _ms { &_multi_special(@_); }
sub _msp { &_multi_special(@_); }

#### Method: special_parameter
#######################################################################
# Routine to define a special parameter
#  sp(<name>, <pattern>)
#  sp(<name>, <pattern>, <type>)
#######################################################################
sub _specialParameter { &_special_parameter(@_); }
sub _s { &_special_parameter(@_); }
sub _special { &_special_parameter(@_); }
sub _special_parameter {
  my($self) = shift;
  croak "Wrong number of arguments in method call" if ((@_ < 2) or (@_ > 3));
  if (@_ == 2) {
    &__assign_special_parameter($self, @_, 'switch');
  } else {
    &__assign_special_parameter($self, @_);
  }
}

#######################################################################
# Routine to create hash for specified special parameter
#######################################################################
sub __assign_special_parameter {
  my($self, $special, $pattern, $type) = @_;
  if ($self->{'prefs'}->{'development_check'}) {
    #Check to make sure that parameter of that same name doesn't already exit
    croak "Multiply defined parameter '$special'"
      if ((exists $self->{'special'}->{$special}) or
          (exists $self->{'parameter'}->{$special}));
    #Check to make sure that the specified type exists
    croak "Unknown type '$type' cannot be used by option '$special'"
      unless (exists $self->{'types'}->{$type});
  }
  $self->{'special'}->{$special}->{'required'} = 0;
  $self->{'special'}->{$special}->{'unique'} = 0;
  $self->{'special'}->{$special} = { 'special_pattern' => $pattern, 'type' => [ $type, ], };
  &__ooRoutines($self, $special);
}

#### Method: alias
#######################################################################
#Routine to associate an alias of set of aliases w/ a parameter
#######################################################################
sub __ooRoutines {
  my($self, $parameter) = @_;
  if ($self->{'prefs'}->{'ooRoutines'}) {
    my($code) = '';
    $code = join('',
		 'sub ', (($parameter =~ /^\d/)? '_' : ''), $parameter,
		 ' { my($self)=shift; return($self->_arg( \'', $parameter, '\', @_)); }', "\n",
		 map { join('',
			    'sub ', (($parameter =~ /^\d/)? '_' : ''), "${parameter}_$_",
			    ' { my($self)=shift; return($self->_', $_, '( \'', $parameter, '\', @_)); }', "\n",) }
		 qw/arge argt args argv argl argc arglprepare argh/);
#    print "$code\n\n";
    eval "$code";
  }
}

#### Method: alias
#######################################################################
#Routine to associate an alias of set of aliases w/ a parameter
#######################################################################
sub _a { &_alias(@_); }
sub _alias {
  my($self) = shift;
  my($parameter) = shift;
  my(%a) = map { $_, 1 } @_;
  if ($self->{'prefs'}->{'development_check'}) {
    foreach my $a ( @_ ) {
      croak "Alias '$a' specified for '$parameter' is already defined for '$self->{'aliasnamehash'}->{$a}'.\n"
        if (exists $self->{'aliasnamehash'}->{$a});
    }
  }
  foreach my $a ( @_ ) {
    $self->{'parameter'}->{$parameter}->{'alias'}->{$a} = 1;
    $self->{'aliasnamehash'}->{$a} = $parameter;
  }
}

#### Method: keys
#######################################################################
#Routine to associate user-specified values w/ specified parameters
# keys( param, 0, 1, 2, 3 )
# keys( param, [ 0, 1, 2, 3 ] )
# keys( multiparam, [ 0, 1, 2 ], [ 4, 5, 6 ], [ 7, 8, 9 ] )
# keys( multiparam, { 'sub1' => [ 0, 1, 2 ], 'sub2' => [ 4, 5, 6 ], 'sub3' => [ 7, 8, 9 ] } )
#######################################################################
sub _key { &_keys(@_); }
sub _k { &_keys(@_); }
sub _keys {
  my($self) = shift;
  my($parameter) = shift;
  my($pKind) = (exists $self->{'special'}->{$parameter})? 'special' : 'parameter';
  if (@{$self->{$pKind}->{$parameter}->{'type'}} > 1) {
    if (@_ > 1) {
      $self->{$pKind}->{$parameter}->{'keys'} = \@_;
    } elsif (ref($_[0]) eq 'HASH') {
      if ($self->{'prefs'}->{'development_check'}) {
	foreach ( keys %{$_[0]} ) {
	  croak "Subparameter $_ does not exist for $parameter"
	    unless (exists $self->{$pKind}->{$parameter}->{'nameOrder'}->{$_});
	}
      }
      foreach ( keys %{$_[0]} ) {
	$self->{$pKind}->{$parameter}->{'keys'}->[$self->{$pKind}->{$parameter}->{'nameOrder'}->{$_}] = $_[0]->{$_};
      }
    } else {
      croak "Format of argument for _keys call is not valid.";
    }
  } else {
    if (ref($_[0]) eq 'ARRAY') {
      $self->{$pKind}->{$parameter}->{'keys'} = [ $_[0] ];
    } else {
      $self->{$pKind}->{$parameter}->{'keys'} = [ \@_ ];
    }
  }
}

#### Method: unique
#######################################################################
#Routine to mark parameters as unique
#######################################################################
sub _u { &_unique(@_); }
sub _unique {
  my($self) = shift;
  foreach my $p ( @_ ) {
    my($pKind) = (exists $self->{'special'}->{$p})? 'special' : 'parameter';
    $self->{$pKind}->{$p}->{'unique'} = 1;
  }
}

#### Method: default
#######################################################################
#Routine to associate default values w/ specified parameters
# For  p: $opt->d('p', 0, 1, 2, 3);
# For mp: $opt->d('p', [0, 1], [2, 3]); 
#######################################################################
sub _d { &_default(@_); }
sub _default {
  my($self) = shift;
  my($parameter) = shift;
  my($pKind) = (exists $self->{'special'}->{$parameter})? 'special' : 'parameter';
  #Quick check for switch or switch-like type
  croak "Default assignment of type '$self->{$pKind}->{$parameter}->{'type'}->[0]' makes no sense"
    if ($self->{'types'}->{$self->{$pKind}->{$parameter}->{'type'}->[0]}->{'number_of_arguments'} == 0);
  #Store default values
  @{$self->{$pKind}->{$parameter}->{'default'}} = map { [ $_ ] } @_;
  #Bulletproofing....do later (check default values for type matching, etc.
  if ($self->{'prefs'}->{'development_check'}) {
  }
}

#### Method: description
#######################################################################
#Routine to store a description of the script
#######################################################################
sub _description {
  use strict 'refs';
  my($self) = shift;
  $self->{'description'} = shift;
}

#### Method: pattern
#######################################################################
#Routine to specify pattern(s) for a particular argument
#######################################################################
sub _pattern {
  my($self) = shift;
  my($parameter) = shift;
  my($pKind) = (exists $self->{'special'}->{$parameter})? 'special' : 'parameter';
  my($i) = 0;
  if (exists $self->{$pKind}->{$parameter}->{'nameOrder'}) {
    my($name) = shift;
    croak "Subparameter ($name) not found for '$parameter'"
      unless (exists $self->{$pKind}->{$parameter}->{'nameOrder'}->{$name});
    $i = $self->{$pKind}->{$parameter}->{'nameOrder'}->{$name};
  }
  push(@{$self->{$pKind}->{$parameter}->{'pattern'}->[$i]}, @_); }

#### Method: help
#######################################################################
#Routine to specify the help string of a parameter
#######################################################################
sub _h { &_help(@_); }
sub _help {
  use strict 'refs';
  my($self) = shift;
  #If only one argument, take as description string for entire script, not for a specific parameter
  if (@_ == 1) {
    $self->{'description'} = $_[0];
    chomp($self->{'description'});
  } elsif (@_ == 2) {
    my($pKind) = (exists $self->{'special'}->{$_[0]})? 'special' : 'parameter';
    $self->{$pKind}->{$_[0]}->{'help'} = $_[1];
    chomp($self->{$pKind}->{$_[0]}->{'help'});
  } else {
    croak "Incorrect number of arguments to 'help' method.";
  }
}

#### Method: help_option
#######################################################################
#Routine to specify the help option for special parameters
#######################################################################
sub _h_opt { &_help_option(@_); }
sub _help_option {
  my($self) = shift;
  if (@_ == 2) {
    $self->{'special'}->{$_[0]}->{'help_option'} = $_[1];
  } else {
    croak "Incorrect number of arguments to 'help_option' method.";
  }
}

#### Method: required
#######################################################################
#Routine to specify that certain parameters are required
#######################################################################
sub _r { &_required(@_); }
sub _required {
  my($self) = shift;
  foreach my $p ( @_ ) {
    my($pKind) = (exists $self->{'special'}->{$p})? 'special' : 'parameter';
    $self->{$pKind}->{$p}->{'required'} = 1;
  }
}

#### Method: mutex
#######################################################################
#Routine to define sets of mutually exclusive parameters.
# This checking takes place after argument parsing and prior to default
# bindings.
#######################################################################
sub _mutually_exclusive { &_mutex(@_); }
sub _mutex {
  my($self) = shift;
  push(@{$self->{'checks'}->{'mutex'}}, \@_);
}

#### Method: req_grp
#######################################################################
#Routine to define sets of options such that if any option in a group
# is used, all others in that group must also be used.
#######################################################################
sub _rg { &_req_grp(@_); }
sub _group { &_req_grp(@_); }
sub _required_group { &_req_grp(@_); }
sub _req_grp {
  my($self) = shift;
  push(@{$self->{'checks'}->{'req_grp'}}, \@_);
}

#### Method: argumentFileComment
#######################################################################
#Routine to add a string for designating comment lines in an
# arguementFile.
#######################################################################
sub _argumentFileComment { &_argument_file_comment(@_); }
sub _argument_file_comment {
  my($self) = shift;
  my($p) = shift;
  my($pKind) = (exists $self->{'special'}->{$p})? 'special' : 'parameter';
  foreach my $c ( @_ ) {
    push(@{$self->{$pKind}->{$p}->{'argumentFileComment'}}, $c);
  }
}

#### Method: _assert_predefined_types
#######################################################################
#Routine to assert predefined types:
# Define the number of arguments.
# Each argument gets an entry in the 'arguments' array defining all 
#  the argument attributes: range, pattern, translation, etc.
##NOTE: I added '. "\$"' on the end of some of these strings to make 
# my emacs highlighting mode happy since it always thinks that $' is a
# perl variable (even at the end of a single-quoted string, and I'm not
# much of a lisp hacker).
#######################################################################
sub __assert_predefined_types {
  my($self) = @_;

  #Switch
  $self->{'types'}->{'switch'} =
    { 'number_of_arguments' => 0,
      #Special keys for types w/ zero arguments
      'specifiedvalue' => 1,
      'unspecifiedvalue' => 0,
    };

  #Integer
  $self->{'types'}->{'integer'} =
    { 'number_of_arguments' => 1,
      'arguments' => [
                      { 'range' => [],
                        'pattern' => [ '^[+-]?\d+' . "\$", ],
                        'translation' => {},
                        'range_translation' => {},
                        'pattern_translation' => {},
                      },
                      ],
      };

  #Natural
  $self->{'types'}->{'natural'} =
    { 'number_of_arguments' => 1,
      'arguments' => [
                      { 'range' => [],
                        'pattern' => [ '^\+?\d+' . "\$", ],
                        'translation' => {},
                        'range_translation' => {},
                        'pattern_translation' => {},
                      },
                      ],
      };

  #Real
  $self->{'types'}->{'real'} =
    { 'number_of_arguments' => 1,
      'arguments' => [
                      { 'range' => [],
                        'pattern' => [ '^[+-]?(?:\d+(?:\.\d*)?|\.\d+)(?:[eE][+-]?\d+)?' . "\$", ],
                        'translation' => {},
                        'range_translation' => {},
                        'pattern_translation' => {},
                      },
                      ],
      };

  #File
  $self->{'types'}->{'file'} =
    { 'number_of_arguments' => 1,
      'arguments' => [
                      { 'range' => [],
                        'pattern' => [],
                        'translation' => {},
                        'range_translation' => {},
                        'pattern_translation' => {},
                      },
                      ],
      };

  #String
  $self->{'types'}->{'string'} =
    { 'number_of_arguments' => 1,
      'arguments' => [
                      { 'range' => [],
                        'pattern' => [],
                        'translation' => {},
                        'range_translation' => {},
                        'pattern_translation' => {},
                      },
                      ],
      };

  #######################################################################
  #ArgumentFile: a file containing more command line arguments to parse
  #######################################################################
  $self->{'types'}->{'argumentFile'} =
    { 'number_of_arguments' => 1,
      'arguments' => [
                      { 'range' => [],
                        'pattern' => [],
                        'translation' => {},
                        'range_translation' => {},
                        'pattern_translation' => {},
                      },
                      ],
      };

}

#### Method: _parse_prefs
#######################################################################
#Routine to parse prefs hash
#######################################################################
sub __parse_prefs {
  my($self, $prefs) = @_;
  #Overwrite elements in $self as specified by $prefs hash
  foreach my $prefKey (keys %{$prefs}) {
    croak "Unknown preference '$prefKey' specified" unless (exists $self->{'prefs'}->{$prefKey});
    if (ref($self->{'prefs'}->{$prefKey}) eq 'HASH') {
      foreach my $key ( @{$prefs->{$prefKey}} ) {
        $self->{'prefs'}->{$prefKey}->{$key} = 1;
      }
    } else {
      $self->{'prefs'}->{$prefKey} = $prefs->{$prefKey};
    }
  }
}

#########################################################################
#Auxiliary routine to return number of arguments for specified parameter
# according to type definition.
#########################################################################
sub __number_of_arguments {
  my($self) = @_;
}

#######################################################################
#Auxiliary routine to print out help text
#######################################################################
sub __print_help {
  my($self, $argv, $lvl) = @_;
  $lvl = 0 unless (defined $lvl);
  #Build up a help string:
  print "\nDESCRIPTION:\n", $self->{'description'}, "\n" if (exists $self->{'description'});
  #$0 <required options> [optional options]
  my($help) = [ "\nUSAGE:\n$0", ];
  foreach my $opt ( grep { (exists $self->{'parameter'}->{$_}->{'required'}) and ($self->{'parameter'}->{$_}->{'required'} == 1) }
		    sort keys %{$self->{'parameter'}} ) {
    push(@{$help}, "-$opt");
    push(@{$help}, join(' ', map { "<$_>" } @{$self->{'parameter'}->{$opt}->{'type'}}))
      unless ($self->{'types'}->{$self->{'parameter'}->{$opt}->{'type'}->[0]}->{'number_of_arguments'} == 0);
  }
  foreach my $opt ( grep { (exists $self->{'special'}->{$_}->{'required'}) and ($self->{'special'}->{$_}->{'required'} == 1) }
		    sort keys %{$self->{'special'}} ) {
    push(@{$help}, (exists $self->{'special'}->{$_}->{'help_option'})? $self->{'special'}->{$_}->{'help_option'} : $self->{'special'}->{$_}->{'pattern'});
  }
  foreach my $opt ( grep { (not exists $self->{'parameter'}->{$_}->{'required'}) or ($self->{'parameter'}->{$_}->{'required'} == 0) }
		    sort keys %{$self->{'parameter'}} ) {
    push(@{$help}, "[-$opt");
    push(@{$help}, join(' ', map { "<$_>" } @{$self->{'parameter'}->{$opt}->{'type'}}))
      unless ($self->{'types'}->{$self->{'parameter'}->{$opt}->{'type'}->[0]}->{'number_of_arguments'} == 0);
    $help->[$#{$help}] .= "]";
  }
  foreach my $opt ( grep { (not exists $self->{'special'}->{$_}->{'required'}) or ($self->{'special'}->{$_}->{'required'} == 0) }
		    sort keys %{$self->{'special'}} ) {
    push(@{$help}, '[' . ((exists $self->{'special'}->{$opt}->{'help_option'})? $self->{'special'}->{$opt}->{'help_option'} : $self->{'special'}->{$opt}->{'special_pattern'}));
    push(@{$help}, join(' ', map { "<$_>" } @{$self->{'special'}->{$opt}->{'type'}}))
      unless ($self->{'types'}->{$self->{'special'}->{$opt}->{'type'}->[0]}->{'number_of_arguments'} == 0);
    $help->[$#{$help}] .= ']';
  }
  print join(' ', @{$help}), "\n\n";
  #Print extended help messages if full_help
  if ($lvl > 1) {
    $help = {};
    foreach my $opt ( sort keys %{$self->{'parameter'}} ) {
      my($key) = "-$opt";
      $key .= join(' ', '', map { "<$_>" } @{$self->{'parameter'}->{$opt}->{'type'}})
	unless ($self->{'types'}->{$self->{'parameter'}->{$opt}->{'type'}->[0]}->{'number_of_arguments'} == 0);
      $help->{$key} = (exists $self->{'parameter'}->{$opt}->{'help'})? $self->{'parameter'}->{$opt}->{'help'} : '__no help text__';
    }
    foreach my $opt ( sort keys %{$self->{'special'}} ) {
      my($key) = (exists $self->{'special'}->{$opt}->{'help_option'})? $self->{'special'}->{$opt}->{'help_option'} : $self->{'special'}->{$opt}->{'special_pattern'};
      $key .= join(' ', '', map { "<$_>" } @{$self->{'special'}->{$opt}->{'type'}})
	unless ($self->{'types'}->{$self->{'special'}->{$opt}->{'type'}->[0]}->{'number_of_arguments'} == 0);
      $help->{$key} = (exists $self->{'special'}->{$opt}->{'help'})? $self->{'special'}->{$opt}->{'help'} : '__no help text__';
    }
    #Get longest key length of $help
    my($len) = (reverse sort {$a<=>$b;} map { length($_) } keys %{$help})[0];
    print "FULL HELP LISTING:\n";
    foreach ( sort keys %{$help} ) {
      print "  ", $_, (' ' x ($len-length($_)+2)), $help->{$_}, "\n";
    }
    print "\n";

    if (exists $self->{'checks'}->{'req_grp'}) {
      foreach my $req_grp ( @{$self->{'checks'}->{'req_grp'}} ) {
	print "These options must be specified together: ", join(', ', @{$req_grp}), ".\n";
      }
      print "\n";
    }
    if (exists $self->{'checks'}->{'mutex'}) {
      foreach my $mutex ( @{$self->{'checks'}->{'mutex'}} ) {
	print "These options are mutually exclusive: ", join(', ', @{$mutex}), ".\n";
      }
      print "\n";
    }
  }

  exit;
}

1;

__END__