envassert.self-contained

#!/usr/bin/env perl

# This chunk of stuff was generated by App::FatPacker. To find the original
# file's code, look for the end of this BEGIN block or the string 'FATPACK'
BEGIN {
my %fatpacked;

$fatpacked{"Env/Assert.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'ENV_ASSERT';
  ## no critic (ControlStructures::ProhibitPostfixControls)
  ## no critic (ValuesAndExpressions::ProhibitConstantPragma)
  package Env::Assert;
  use strict;
  use warnings;
  use 5.010;
  
  # ABSTRACT: Ensure that the environment variables match what you need, or abort.
  
  our $VERSION = '0.016';
  
  # We define our own import routine because
  # this is the point (when `use Env::Assert` is called)
  # when we do our magic.
  
  use Carp;
  
  use English qw( -no_match_vars ); # Avoids regex performance penalty in perl 5.18 and earlier
  use open ':std', IO => ':encoding(UTF-8)';
  
  use Env::Assert::Functions qw( :all );
  
  use constant {
      ENV_DESC_FILENAME => '.envdesc',
  };
  
  # Handle exports
  {
      no warnings 'redefine';    ## no critic [TestingAndDebugging::ProhibitNoWarnings]
  
      sub import {
          my ($class, $cmd, $args) = @_;
  
          # We also allow only: 'use Env::Assert;'
          croak "Unknown argument '$cmd'" if( $cmd && $cmd ne 'assert' );
  
          if( ! assert_env( %{ $args } ) ) {
              croak 'Errors in environment detected.';
          }
          return;
      }
  }
  
  =pod
  
  =for :stopwords env filepath filepaths
  
  =head1 SYNOPSIS
  
  =for test_synopsis BEGIN { die 'SKIP: no .envdesc file here' }
  
      use Env::Assert 'assert';
      # or:
      use Env::Assert assert => {
          envdesc_file => 'another-envdesc',
          break_at_first_error => 1,
      };
  
      # .envdesc file:
      # MY_VAR=.+
  
      # use any verified environment variable
      say $ENV{MY_VAR};
  
      # You can inline the envdesc file:
      use Env::Assert assert => {
          exact => 1,
          envdesc => <<'EOF'
      NUMERIC_VAR=^[[:digit:]]+$
      TIME_VAR=^\d{2}:\d{2}:\d{2}$
      EOF
      };
  
  =head1 STATUS
  
  Package Env::Assert is currently being developed so changes in the API are possible,
  though not likely.
  
  =head1 NOTES
  
  Functionality of L<Env::Assert> has been moved to module L<Env::Assert::Functions> since version 0.013.
  L<Env::Assert> has a different API now.
  
  =head1 METHODS
  
  =head2 assert_env
  
  Read environment description, F<.envdesc> by default,
  and compare current environment.
  
  =cut
  
  sub assert_env {
      my (%args) = @_;
      local $OUTPUT_AUTOFLUSH = 1;
  
      my $break_at_first_error = $args{'break_at_first_error'}//0;
      my $exact = $args{'exact'}//0;
  
      my @env_desc_rows;
      if( $args{'envdesc'} ) {
          my $content = $args{'envdesc'};
          open my $fh, q{<}, \$content
              or croak 'Cannot open scalar envdesc content';
          @env_desc_rows = <$fh>;
          close $fh or croak 'Cannot close scalar envdesc content';
      } else {
          my $env_desc_filename = $args{'envdesc_file'}//ENV_DESC_FILENAME;
          open my $fh, q{<}, $env_desc_filename or croak "Cannot open file '$env_desc_filename'";
          @env_desc_rows = <$fh>;
          close $fh or croak "Cannot close file '$env_desc_filename'";
      }
  
      my $desc = file_to_desc( @env_desc_rows );
      my %parameters;
      $parameters{'break_at_first_error'} = $break_at_first_error
          if defined $break_at_first_error;
      $desc->{'options'}->{'exact'} = $exact
          if defined $exact;
      my $r = assert( \%ENV, $desc, \%parameters );
      if( ! $r->{'success'} ) {
          print {*STDERR} report_errors( $r->{'errors'} )
              or croak 'Cannot print errors to STDERR';
          return 0;
      }
      return 1;
  }
  
  =head1 DEPENDENCIES
  
  No external dependencies outside Perl's standard distribution.
  
  =head1 SEE ALSO
  
  L<Env::Dot> is a "sister" to Env::Assert.
  Read environment variables from a F<.env> file directly into you program.
  There is also script F<envdot> which can turn F<.env> file's content
  into environment variables for different shells.
  
  =cut
  
  1;
  
  __END__
ENV_ASSERT

$fatpacked{"Env/Assert/Functions.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'ENV_ASSERT_FUNCTIONS';
  ## no critic (ControlStructures::ProhibitPostfixControls)
  ## no critic (ControlStructures::ProhibitCascadingIfElse)
  ## no critic (ValuesAndExpressions::ProhibitConstantPragma)
  package Env::Assert::Functions;
  use strict;
  use warnings;
  use 5.010;
  
  # ABSTRACT: The functionality of Env::Assert and bin/envassert.
  
  our $VERSION = '0.016';
  
  =for :stopwords env filepath filepaths params
  
  =cut
  
  use Exporter 'import';
  our @EXPORT_OK = qw(
      assert
      report_errors
      file_to_desc
      ENV_ASSERT_MISSING_FROM_ENVIRONMENT
      ENV_ASSERT_INVALID_CONTENT_IN_VARIABLE
      ENV_ASSERT_MISSING_FROM_DEFINITION
  );
  our %EXPORT_TAGS = (
      'all' => [
          qw(
              assert
              report_errors
              file_to_desc
              ENV_ASSERT_MISSING_FROM_ENVIRONMENT
              ENV_ASSERT_INVALID_CONTENT_IN_VARIABLE
              ENV_ASSERT_MISSING_FROM_DEFINITION
          )
      ],
      'constants' => [
          qw(
              ENV_ASSERT_MISSING_FROM_ENVIRONMENT
              ENV_ASSERT_INVALID_CONTENT_IN_VARIABLE
              ENV_ASSERT_MISSING_FROM_DEFINITION
          )
      ],
  );
  
  use Cwd qw( abs_path );
  use English qw( -no_match_vars );
  use File::Spec;
  use IO::File;
  use English qw( -no_match_vars );    # Avoids regex performance penalty in perl 5.18 and earlier
  use Carp;
  
  use constant  {
      ENV_ASSERT_MISSING_FROM_ENVIRONMENT => 1,
      ENV_ASSERT_INVALID_CONTENT_IN_VARIABLE => 2,
      ENV_ASSERT_MISSING_FROM_DEFINITION => 3,
  };
  
  use constant  {
      DEFAULT_PARAMETER_BREAK_AT_FIRST_ERROR => 0,
      INDENT => q{    },
  };
  
  =head1 STATUS
  
  Package Env::Assert is currently being developed so changes in the API are possible,
  though not likely.
  
  
  =head1 SYNOPSIS
  
      use Env::Assert::Functions qw( assert report_errors );
  
      my %want = (
          options => {
              exact => 1,
          },
          variables => {
              USER => { regexp => '^[[:word:]]{1}$', required => 1 },
          },
      );
      my %parameters;
      $parameters{'break_at_first_error'} = 1;
      my $r = assert( \%ENV, \%want, \%parameters );
      if( ! $r->{'success'} ) {
          print report_errors( $r->{'errors'} );
      }
  
  
  =head1 NOTES
  
  Functionality of L<Env::Assert> has been moved to this package since
  version 0.013.
  L<Env::Assert> has a different API now.
  It can be used by itself at the start of the program, similar to
  L<Env::Dot>.
  
  =head1 FUNCTIONS
  
  No functions are automatically exported to the calling namespace.
  
  =head2 assert( \%env, \%want, \%params )
  
  Ensure your environment, parameter I<env> (hashref), matches with
  the environment description, parameter I<want> (hashref).
  Use parameter I<params> (hashref) to specify processing options.
  
  Supported params:
  
  =over 8
  
  =item break_at_first_error
  
  Verify environment only up until the first error.
  Then break and return with only that error.
  
  =back
  
  Return: hashref: { success => 1/0, errors => hashref, };
  
  =cut
  
  sub assert {
      my ($env, $want, $params) = @_;
      $params = {} if ! $params;
      croak 'Invalid options. Not a hash' if( ref $env ne 'HASH' || ref $want ne 'HASH' );
  
      # Set default options
      $params->{'break_at_first_error'} //= DEFAULT_PARAMETER_BREAK_AT_FIRST_ERROR;
  
      my $success = 1;
      my %errors;
      my $vars = $want->{'variables'};
      my $opts = $want->{'options'};
      foreach my $var_name (keys %{ $vars }) {
          my $var = $vars->{$var_name};
          my $required = $var->{'required'}//1;
          my $regexp = $var->{'regexp'}//q{.*};
          if( ( $opts->{'exact'} || $required ) && ! defined $env->{$var_name} ) {
              $success = 0;
              $errors{'variables'}->{ $var_name } = {
                  type => ENV_ASSERT_MISSING_FROM_ENVIRONMENT,
                  message => "Variable $var_name is missing from environment",
              };
              goto EXIT if( $params->{'break_at_first_error'} );
          }
          elsif( $env->{$var_name} !~ m/$regexp/msx ) {
              $success = 0;
              $errors{'variables'}->{ $var_name } = {
                  type => ENV_ASSERT_INVALID_CONTENT_IN_VARIABLE,
                  message => "Variable $var_name has invalid content",
              };
              goto EXIT if( $params->{'break_at_first_error'} );
          }
      }
      if( $opts->{'exact'} ) {
          foreach my $var_name (keys %{ $env }) {
              if( ! exists $vars->{ $var_name } ) {
                  $success = 0;
                  $errors{'variables'}->{ $var_name } = {
                      type => ENV_ASSERT_MISSING_FROM_DEFINITION,
                      message => "Variable $var_name is missing from description",
                  };
                  goto EXIT if( $params->{'break_at_first_error'} );
              }
          }
      }
  
      EXIT:
      return { success => $success, errors => \%errors, };
  }
  
  =head2 report_errors( \%errors )
  
  Report errors in a nicely formatted way.
  
  =cut
  
  sub report_errors {
      my ($errors) = @_;
      my $out = q{};
      $out .= sprintf "Environment Assert: ERRORS:\n";
      foreach my $error_area_name (sort keys %{ $errors }) {
          $out .= sprintf "%s%s:\n", INDENT, $error_area_name;
          foreach my $error_key (sort keys %{ $errors->{$error_area_name} }) {
              $out .= sprintf "%s%s: %s\n", INDENT . INDENT, $error_key,
                  $errors->{$error_area_name}->{$error_key}->{'message'};
          }
      }
      return $out;
  }
  
  =head2 file_to_desc( @rows )
  
  Extract an environment description from a F<.envdesc> file.
  
  =cut
  
  sub file_to_desc {
      my @rows = @_;
      my %desc = ( 'options' => {}, 'variables' => {}, );
      foreach (@rows) {
          # This is envassert meta command
          ## no critic (RegularExpressions::ProhibitComplexRegexes)
          if(
              m{
              ^ [[:space:]]{0,} [#]{2}
              [[:space:]]{1,} envassert [[:space:]]{1,}
              [(] opts: [[:space:]]{0,} (?<opts> .*) [)]
              [[:space:]]{0,} $
              }msx
          ) {
              my $opts = _interpret_opts( $LAST_PAREN_MATCH{opts} );
              foreach ( keys %{ $opts } ) {
                  $desc{'options'}->{$_} = $opts->{$_};
              }
          } elsif(
              # This is comment row
              m{
                  ^ [[:space:]]{0,} [#]{1} .* $
              }msx
          ) {
              1;
          } elsif(
              # This is empty row
              m{
                  ^ [[:space:]]{0,} $
              }msx
          ) {
              1;
          } elsif(
              # This is env var description
              m{
                  ^ (?<name> [^=]{1,}) = (?<value> .*) $
              }msx
          ) {
              $desc{'variables'}->{ $LAST_PAREN_MATCH{name} } = {
                  regexp => $LAST_PAREN_MATCH{value}
              };
          }
      }
      return \%desc;
  }
  
  # Private subroutines
  
  sub _interpret_opts {
      my ($opts_str) = @_;
      my @opts = split qr{
          [[:space:]]{0,} [,] [[:space:]]{0,}
          }msx,
      $opts_str;
      my %opts;
      foreach (@opts) {
          my ($key, $val) = split qr/=/msx;
          $opts{$key} = $val;
      }
      return \%opts;
  }
  
  =head1 DEPENDENCIES
  
  No external dependencies outside Perl's standard distribution.
  
  =head1 SEE ALSO
  
  L<Env::Dot> is a "sister" to Env::Assert.
  Read environment variables from a F<.env> file directly into you program.
  There is also script F<envdot> which can turn F<.env> file's content
  into environment variables for different shells.
  
  =cut
  
  1;
  __END__
ENV_ASSERT_FUNCTIONS

$fatpacked{"Exporter.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXPORTER';
  package Exporter;
  
  use strict;
  no strict 'refs';
  
  our $Debug = 0;
  our $ExportLevel = 0;
  our $Verbose ||= 0;
  our $VERSION = '5.77';
  our %Cache;
  
  sub as_heavy {
    require Exporter::Heavy;
    # Unfortunately, this does not work if the caller is aliased as *name = \&foo
    # Thus the need to create a lot of identical subroutines
    my $c = (caller(1))[3];
    $c =~ s/.*:://;
    \&{"Exporter::Heavy::heavy_$c"};
  }
  
  sub export {
    goto &{as_heavy()};
  }
  
  sub import {
    my $pkg = shift;
    my $callpkg = caller($ExportLevel);
  
    if ($pkg eq "Exporter" and @_ and $_[0] eq "import") {
      *{$callpkg."::import"} = \&import;
      return;
    }
  
    # We *need* to treat @{"$pkg\::EXPORT_FAIL"} since Carp uses it :-(
    my $exports = \@{"$pkg\::EXPORT"};
    # But, avoid creating things if they don't exist, which saves a couple of
    # hundred bytes per package processed.
    my $fail = ${$pkg . '::'}{EXPORT_FAIL} && \@{"$pkg\::EXPORT_FAIL"};
    return export $pkg, $callpkg, @_
      if $Verbose or $Debug or $fail && @$fail > 1;
    my $export_cache = ($Cache{$pkg} ||= {});
    my $args = @_ or @_ = @$exports;
  
    if ($args and not %$export_cache) {
      s/^&//, $export_cache->{$_} = 1
        foreach (@$exports, @{"$pkg\::EXPORT_OK"});
    }
    my $heavy;
    # Try very hard not to use {} and hence have to  enter scope on the foreach
    # We bomb out of the loop with last as soon as heavy is set.
    if ($args or $fail) {
      ($heavy = (/\W/ or $args and not exists $export_cache->{$_}
                 or $fail and @$fail and $_ eq $fail->[0])) and last
                   foreach (@_);
    } else {
      ($heavy = /\W/) and last
        foreach (@_);
    }
    return export $pkg, $callpkg, ($args ? @_ : ()) if $heavy;
    local $SIG{__WARN__} = 
  	sub {require Carp; &Carp::carp} if not $SIG{__WARN__};
    # shortcut for the common case of no type character
    *{"$callpkg\::$_"} = \&{"$pkg\::$_"} foreach @_;
  }
  
  # Default methods
  
  sub export_fail {
      my $self = shift;
      @_;
  }
  
  # Unfortunately, caller(1)[3] "does not work" if the caller is aliased as
  # *name = \&foo.  Thus the need to create a lot of identical subroutines
  # Otherwise we could have aliased them to export().
  
  sub export_to_level {
    goto &{as_heavy()};
  }
  
  sub export_tags {
    goto &{as_heavy()};
  }
  
  sub export_ok_tags {
    goto &{as_heavy()};
  }
  
  sub require_version {
    goto &{as_heavy()};
  }
  
  1;
  __END__
  
  =head1 NAME
  
  Exporter - Implements default import method for modules
  
  =head1 SYNOPSIS
  
  In module F<YourModule.pm>:
  
    package YourModule;
    use Exporter 'import';
    our @EXPORT_OK = qw(munge frobnicate);  # symbols to export on request
  
  or
  
    package YourModule;
    require Exporter;
    our @ISA = qw(Exporter);  # inherit all of Exporter's methods
    our @EXPORT_OK = qw(munge frobnicate);  # symbols to export on request
  
  or
  
    package YourModule;
    use parent 'Exporter';  # inherit all of Exporter's methods
    our @EXPORT_OK = qw(munge frobnicate);  # symbols to export on request
  
  In other files which wish to use C<YourModule>:
  
    use YourModule qw(frobnicate);      # import listed symbols
    frobnicate ($left, $right)          # calls YourModule::frobnicate
  
  Take a look at L</Good Practices> for some variants
  you will like to use in modern Perl code.
  
  =head1 DESCRIPTION
  
  The Exporter module implements an C<import> method which allows a module
  to export functions and variables to its users' namespaces.  Many modules
  use Exporter rather than implementing their own C<import> method because
  Exporter provides a highly flexible interface, with an implementation optimised
  for the common case.
  
  Perl automatically calls the C<import> method when processing a
  C<use> statement for a module.  Modules and C<use> are documented
  in L<perlfunc> and L<perlmod>.  Understanding the concept of
  modules and how the C<use> statement operates is important to
  understanding the Exporter.
  
  =head2 How to Export
  
  The arrays C<@EXPORT> and C<@EXPORT_OK> in a module hold lists of
  symbols that are going to be exported into the users name space by
  default, or which they can request to be exported, respectively.  The
  symbols can represent functions, scalars, arrays, hashes, or typeglobs.
  The symbols must be given by full name with the exception that the
  ampersand in front of a function is optional, e.g.
  
    our @EXPORT    = qw(afunc $scalar @array);   # afunc is a function
    our @EXPORT_OK = qw(&bfunc %hash *typeglob); # explicit prefix on &bfunc
  
  If you are only exporting function names it is recommended to omit the
  ampersand, as the implementation is faster this way.
  
  =head2 Selecting What to Export
  
  Do B<not> export method names!
  
  Do B<not> export anything else by default without a good reason!
  
  Exports pollute the namespace of the module user.  If you must export
  try to use C<@EXPORT_OK> in preference to C<@EXPORT> and avoid short or
  common symbol names to reduce the risk of name clashes.
  
  Generally anything not exported is still accessible from outside the
  module using the C<YourModule::item_name> (or C<< $blessed_ref->method >>)
  syntax.  By convention you can use a leading underscore on names to
  informally indicate that they are 'internal' and not for public use.
  
  (It is actually possible to get private functions by saying:
  
    my $subref = sub { ... };
    $subref->(@args);            # Call it as a function
    $obj->$subref(@args);        # Use it as a method
  
  However if you use them for methods it is up to you to figure out
  how to make inheritance work.)
  
  As a general rule, if the module is trying to be object oriented
  then export nothing.  If it's just a collection of functions then
  C<@EXPORT_OK> anything but use C<@EXPORT> with caution.  For function and
  method names use barewords in preference to names prefixed with
  ampersands for the export lists.
  
  Other module design guidelines can be found in L<perlmod>.
  
  =head2 How to Import
  
  In other files which wish to use your module there are three basic ways for
  them to load your module and import its symbols:
  
  =over 4
  
  =item C<use YourModule;>
  
  This imports all the symbols from YourModule's C<@EXPORT> into the namespace
  of the C<use> statement.
  
  =item C<use YourModule ();>
  
  This causes perl to load your module but does not import any symbols.
  
  =item C<use YourModule qw(...);>
  
  This imports only the symbols listed by the caller into their namespace.
  All listed symbols must be in your C<@EXPORT> or C<@EXPORT_OK>, else an error
  occurs.  The advanced export features of Exporter are accessed like this,
  but with list entries that are syntactically distinct from symbol names.
  
  =back
  
  Unless you want to use its advanced features, this is probably all you
  need to know to use Exporter.
  
  =head1 Advanced Features
  
  =head2 Specialised Import Lists
  
  If any of the entries in an import list begins with !, : or / then
  the list is treated as a series of specifications which either add to
  or delete from the list of names to import.  They are processed left to
  right. Specifications are in the form:
  
      [!]name         This name only
      [!]:DEFAULT     All names in @EXPORT
      [!]:tag         All names in $EXPORT_TAGS{tag} anonymous array
      [!]/pattern/    All names in @EXPORT and @EXPORT_OK which match
  
  A leading ! indicates that matching names should be deleted from the
  list of names to import.  If the first specification is a deletion it
  is treated as though preceded by :DEFAULT.  If you just want to import
  extra names in addition to the default set you will still need to
  include :DEFAULT explicitly.
  
  e.g., F<Module.pm> defines:
  
      our @EXPORT      = qw(A1 A2 A3 A4 A5);
      our @EXPORT_OK   = qw(B1 B2 B3 B4 B5);
      our %EXPORT_TAGS = (T1 => [qw(A1 A2 B1 B2)], T2 => [qw(A1 A2 B3 B4)]);
  
  Note that you cannot use tags in @EXPORT or @EXPORT_OK.
  
  Names in EXPORT_TAGS must also appear in @EXPORT or @EXPORT_OK.
  
  An application using Module can say something like:
  
      use Module qw(:DEFAULT :T2 !B3 A3);
  
  Other examples include:
  
      use Socket qw(!/^[AP]F_/ !SOMAXCONN !SOL_SOCKET);
      use POSIX  qw(:errno_h :termios_h !TCSADRAIN !/^EXIT/);
  
  Remember that most patterns (using //) will need to be anchored
  with a leading ^, e.g., C</^EXIT/> rather than C</EXIT/>.
  
  You can say C<BEGIN { $Exporter::Verbose=1 }> to see how the
  specifications are being processed and what is actually being imported
  into modules.
  
  =head2 Exporting Without Using Exporter's import Method
  
  Exporter has a special method, 'export_to_level' which is used in situations
  where you can't directly call Exporter's
  import method.  The export_to_level
  method looks like:
  
      MyPackage->export_to_level(
  	$where_to_export, $package, @what_to_export
      );
  
  where C<$where_to_export> is an integer telling how far up the calling stack
  to export your symbols, and C<@what_to_export> is an array telling what
  symbols *to* export (usually this is C<@_>).  The C<$package> argument is
  currently unused.
  
  For example, suppose that you have a module, A, which already has an
  import function:
  
      package A;
  
      our @ISA = qw(Exporter);
      our @EXPORT_OK = qw($b);
  
      sub import
      {
  	$A::b = 1;     # not a very useful import method
      }
  
  and you want to Export symbol C<$A::b> back to the module that called 
  package A.  Since Exporter relies on the import method to work, via 
  inheritance, as it stands Exporter::import() will never get called. 
  Instead, say the following:
  
      package A;
      our @ISA = qw(Exporter);
      our @EXPORT_OK = qw($b);
  
      sub import
      {
  	$A::b = 1;
  	A->export_to_level(1, @_);
      }
  
  This will export the symbols one level 'above' the current package - ie: to 
  the program or module that used package A. 
  
  Note: Be careful not to modify C<@_> at all before you call export_to_level
  - or people using your package will get very unexplained results!
  
  =head2 Exporting Without Inheriting from Exporter
  
  By including Exporter in your C<@ISA> you inherit an Exporter's import() method
  but you also inherit several other helper methods which you probably don't
  want and complicate the inheritance tree.  To avoid this you can do:
  
    package YourModule;
    use Exporter qw(import);
  
  which will export Exporter's own import() method into YourModule.
  Everything will work as before but you won't need to include Exporter in
  C<@YourModule::ISA>.
  
  Note: This feature was introduced in version 5.57
  of Exporter, released with perl 5.8.3.
  
  =head2 Module Version Checking
  
  The Exporter module will convert an attempt to import a number from a
  module into a call to C<< $module_name->VERSION($value) >>.  This can
  be used to validate that the version of the module being used is
  greater than or equal to the required version.
  
  For historical reasons, Exporter supplies a C<require_version> method that
  simply delegates to C<VERSION>.  Originally, before C<UNIVERSAL::VERSION>
  existed, Exporter would call C<require_version>.
  
  Since the C<UNIVERSAL::VERSION> method treats the C<$VERSION> number as
  a simple numeric value it will regard version 1.10 as lower than
  1.9.  For this reason it is strongly recommended that you use numbers
  with at least two decimal places, e.g., 1.09.
  
  =head2 Managing Unknown Symbols
  
  In some situations you may want to prevent certain symbols from being
  exported.  Typically this applies to extensions which have functions
  or constants that may not exist on some systems.
  
  The names of any symbols that cannot be exported should be listed
  in the C<@EXPORT_FAIL> array.
  
  If a module attempts to import any of these symbols the Exporter
  will give the module an opportunity to handle the situation before
  generating an error.  The Exporter will call an export_fail method
  with a list of the failed symbols:
  
    @failed_symbols = $module_name->export_fail(@failed_symbols);
  
  If the C<export_fail> method returns an empty list then no error is
  recorded and all the requested symbols are exported.  If the returned
  list is not empty then an error is generated for each symbol and the
  export fails.  The Exporter provides a default C<export_fail> method which
  simply returns the list unchanged.
  
  Uses for the C<export_fail> method include giving better error messages
  for some symbols and performing lazy architectural checks (put more
  symbols into C<@EXPORT_FAIL> by default and then take them out if someone
  actually tries to use them and an expensive check shows that they are
  usable on that platform).
  
  =head2 Tag Handling Utility Functions
  
  Since the symbols listed within C<%EXPORT_TAGS> must also appear in either
  C<@EXPORT> or C<@EXPORT_OK>, two utility functions are provided which allow
  you to easily add tagged sets of symbols to C<@EXPORT> or C<@EXPORT_OK>:
  
    our %EXPORT_TAGS = (foo => [qw(aa bb cc)], bar => [qw(aa cc dd)]);
  
    Exporter::export_tags('foo');     # add aa, bb and cc to @EXPORT
    Exporter::export_ok_tags('bar');  # add aa, cc and dd to @EXPORT_OK
  
  Any names which are not tags are added to C<@EXPORT> or C<@EXPORT_OK>
  unchanged but will trigger a warning (with C<-w>) to avoid misspelt tags
  names being silently added to C<@EXPORT> or C<@EXPORT_OK>.  Future versions
  may make this a fatal error.
  
  =head2 Generating Combined Tags
  
  If several symbol categories exist in C<%EXPORT_TAGS>, it's usually
  useful to create the utility ":all" to simplify "use" statements.
  
  The simplest way to do this is:
  
   our  %EXPORT_TAGS = (foo => [qw(aa bb cc)], bar => [qw(aa cc dd)]);
  
    # add all the other ":class" tags to the ":all" class,
    # deleting duplicates
    {
      my %seen;
  
      push @{$EXPORT_TAGS{all}},
        grep {!$seen{$_}++} @{$EXPORT_TAGS{$_}} foreach keys %EXPORT_TAGS;
    }
  
  F<CGI.pm> creates an ":all" tag which contains some (but not really
  all) of its categories.  That could be done with one small
  change:
  
    # add some of the other ":class" tags to the ":all" class,
    # deleting duplicates
    {
      my %seen;
  
      push @{$EXPORT_TAGS{all}},
        grep {!$seen{$_}++} @{$EXPORT_TAGS{$_}}
          foreach qw/html2 html3 netscape form cgi internal/;
    }
  
  Note that the tag names in C<%EXPORT_TAGS> don't have the leading ':'.
  
  =head2 C<AUTOLOAD>ed Constants
  
  Many modules make use of C<AUTOLOAD>ing for constant subroutines to
  avoid having to compile and waste memory on rarely used values (see
  L<perlsub> for details on constant subroutines).  Calls to such
  constant subroutines are not optimized away at compile time because
  they can't be checked at compile time for constancy.
  
  Even if a prototype is available at compile time, the body of the
  subroutine is not (it hasn't been C<AUTOLOAD>ed yet).  perl needs to
  examine both the C<()> prototype and the body of a subroutine at
  compile time to detect that it can safely replace calls to that
  subroutine with the constant value.
  
  A workaround for this is to call the constants once in a C<BEGIN> block:
  
     package My ;
  
     use Socket ;
  
     foo( SO_LINGER );  ## SO_LINGER NOT optimized away; called at runtime
     BEGIN { SO_LINGER }
     foo( SO_LINGER );  ## SO_LINGER optimized away at compile time.
  
  This forces the C<AUTOLOAD> for C<SO_LINGER> to take place before
  SO_LINGER is encountered later in C<My> package.
  
  If you are writing a package that C<AUTOLOAD>s, consider forcing
  an C<AUTOLOAD> for any constants explicitly imported by other packages
  or which are usually used when your package is C<use>d.
  
  =head1 Good Practices
  
  =head2 Declaring C<@EXPORT_OK> and Friends
  
  When using C<Exporter> with the standard C<strict> and C<warnings>
  pragmas, the C<our> keyword is needed to declare the package
  variables C<@EXPORT_OK>, C<@EXPORT>, C<@ISA>, etc.
  
    our @ISA = qw(Exporter);
    our @EXPORT_OK = qw(munge frobnicate);
  
  If backward compatibility for Perls B<under> 5.6 is important,
  one must write instead a C<use vars> statement.
  
    use vars qw(@ISA @EXPORT_OK);
    @ISA = qw(Exporter);
    @EXPORT_OK = qw(munge frobnicate);
  
  =head2 Playing Safe
  
  There are some caveats with the use of runtime statements
  like C<require Exporter> and the assignment to package
  variables, which can be very subtle for the unaware programmer.
  This may happen for instance with mutually recursive
  modules, which are affected by the time the relevant
  constructions are executed.
  
  The ideal way to never have to think about that is to use
  C<BEGIN> blocks and the simple import method.  So the first part
  of the L</SYNOPSIS> code could be rewritten as:
  
    package YourModule;
  
    use strict;
    use warnings;
  
    use Exporter 'import';
    BEGIN {
      our @EXPORT_OK = qw(munge frobnicate);  # symbols to export on request
    }
  
  Or if you need to inherit from Exporter:
  
    package YourModule;
  
    use strict;
    use warnings;
  
    BEGIN {
      require Exporter;
      our @ISA = qw(Exporter);  # inherit all of Exporter's methods
      our @EXPORT_OK = qw(munge frobnicate);  # symbols to export on request
    }
  
  The C<BEGIN> will assure that the loading of F<Exporter.pm>
  and the assignments to C<@ISA> and C<@EXPORT_OK> happen
  immediately like C<use>, leaving no room for something to get awry
  or just plain wrong.
  
  With respect to loading C<Exporter> and inheriting, there
  are alternatives with the use of modules like C<base> and C<parent>.
  
    use base qw(Exporter);
    # or
    use parent qw(Exporter);
  
  Any of these statements are nice replacements for
  C<BEGIN { require Exporter; our @ISA = qw(Exporter); }>
  with the same compile-time effect.  The basic difference
  is that C<base> code interacts with declared C<fields>
  while C<parent> is a streamlined version of the older
  C<base> code to just establish the IS-A relationship.
  
  For more details, see the documentation and code of
  L<base> and L<parent>.
  
  Another thorough remedy to that runtime
  vs. compile-time trap is to use L<Exporter::Easy>,
  which is a wrapper of Exporter that allows all
  boilerplate code at a single gulp in the
  use statement.
  
     use Exporter::Easy (
         OK => [ qw(munge frobnicate) ],
     );
     # @ISA setup is automatic
     # all assignments happen at compile time
  
  =head2 What Not to Export
  
  You have been warned already in L</Selecting What to Export>
  to not export:
  
  =over 4
  
  =item *
  
  method names (because you don't need to
  and that's likely to not do what you want),
  
  =item *
  
  anything by default (because you don't want to surprise your users...
  badly)
  
  =item *
  
  anything you don't need to (because less is more)
  
  =back
  
  There's one more item to add to this list.  Do B<not>
  export variable names.  Just because C<Exporter> lets you
  do that, it does not mean you should.
  
    @EXPORT_OK = qw($svar @avar %hvar); # DON'T!
  
  Exporting variables is not a good idea.  They can
  change under the hood, provoking horrible
  effects at-a-distance that are too hard to track
  and to fix.  Trust me: they are not worth it.
  
  To provide the capability to set/get class-wide
  settings, it is best instead to provide accessors
  as subroutines or class methods instead.
  
  =head1 SEE ALSO
  
  C<Exporter> is definitely not the only module with
  symbol exporter capabilities.  At CPAN, you may find
  a bunch of them.  Some are lighter.  Some
  provide improved APIs and features.  Pick the one
  that fits your needs.  The following is
  a sample list of such modules.
  
      Exporter::Easy
      Exporter::Lite
      Exporter::Renaming
      Exporter::Tidy
      Sub::Exporter / Sub::Installer
      Perl6::Export / Perl6::Export::Attrs
  
  =head1 LICENSE
  
  This library is free software.  You can redistribute it
  and/or modify it under the same terms as Perl itself.
  
  =cut
  
  
  
EXPORTER

$fatpacked{"Exporter/Heavy.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXPORTER_HEAVY';
  package Exporter::Heavy;
  
  use strict;
  no strict 'refs';
  
  # On one line so MakeMaker will see it.
  our $VERSION = '5.77';
  
  =head1 NAME
  
  Exporter::Heavy - Exporter guts
  
  =head1 SYNOPSIS
  
  (internal use only)
  
  =head1 DESCRIPTION
  
  No user-serviceable parts inside.
  
  =cut
  
  #
  # We go to a lot of trouble not to 'require Carp' at file scope,
  #  because Carp requires Exporter, and something has to give.
  #
  
  sub _rebuild_cache {
      my ($pkg, $exports, $cache) = @_;
      s/^&// foreach @$exports;
      @{$cache}{@$exports} = (1) x @$exports;
      my $ok = \@{"${pkg}::EXPORT_OK"};
      if (@$ok) {
  	s/^&// foreach @$ok;
  	@{$cache}{@$ok} = (1) x @$ok;
      }
  }
  
  sub heavy_export {
  
      # Save the old __WARN__ handler in case it was defined
      my $oldwarn = $SIG{__WARN__};
  
      # First make import warnings look like they're coming from the "use".
      local $SIG{__WARN__} = sub {
  	# restore it back so proper stacking occurs
  	local $SIG{__WARN__} = $oldwarn;
  	my $text = shift;
  	if ($text =~ s/ at \S*Exporter\S*.pm line \d+.*\n//) {
  	    require Carp;
  	    local $Carp::CarpLevel = 1;	# ignore package calling us too.
  	    Carp::carp($text);
  	}
  	else {
  	    warn $text;
  	}
      };
      local $SIG{__DIE__} = sub {
  	require Carp;
  	local $Carp::CarpLevel = 1;	# ignore package calling us too.
  	Carp::croak("$_[0]Illegal null symbol in \@${1}::EXPORT")
  	    if $_[0] =~ /^Unable to create sub named "(.*?)::"/;
      };
  
      my($pkg, $callpkg, @imports) = @_;
      my($type, $sym, $cache_is_current, $oops);
      my($exports, $export_cache) = (\@{"${pkg}::EXPORT"},
                                     $Exporter::Cache{$pkg} ||= {});
  
      if (@imports) {
  	if (!%$export_cache) {
  	    _rebuild_cache ($pkg, $exports, $export_cache);
  	    $cache_is_current = 1;
  	}
  
  	if (grep m{^[/!:]}, @imports) {
  	    my $tagsref = \%{"${pkg}::EXPORT_TAGS"};
  	    my $tagdata;
  	    my %imports;
  	    my($remove, $spec, @names, @allexports);
  	    # negated first item implies starting with default set:
  	    unshift @imports, ':DEFAULT' if $imports[0] =~ m/^!/;
  	    foreach $spec (@imports){
  		$remove = $spec =~ s/^!//;
  
  		if ($spec =~ s/^://){
  		    if ($spec eq 'DEFAULT'){
  			@names = @$exports;
  		    }
  		    elsif ($tagdata = $tagsref->{$spec}) {
  			@names = @$tagdata;
  		    }
  		    else {
  			warn qq["$spec" is not defined in %${pkg}::EXPORT_TAGS];
  			++$oops;
  			next;
  		    }
  		}
  		elsif ($spec =~ m:^/(.*)/$:){
  		    my $patn = $1;
  		    @allexports = keys %$export_cache unless @allexports; # only do keys once
  		    @names = grep(/$patn/, @allexports); # not anchored by default
  		}
  		else {
  		    @names = ($spec); # is a normal symbol name
  		}
  
  		warn "Import ".($remove ? "del":"add").": @names "
  		    if $Exporter::Verbose;
  
  		if ($remove) {
  		   foreach $sym (@names) { delete $imports{$sym} } 
  		}
  		else {
  		    @imports{@names} = (1) x @names;
  		}
  	    }
  	    @imports = keys %imports;
  	}
  
          my @carp;
  	foreach $sym (@imports) {
  	    if (!$export_cache->{$sym}) {
  		if ($sym =~ m/^\d/) {
  		    $pkg->VERSION($sym); # inherit from UNIVERSAL
  		    # If the version number was the only thing specified
  		    # then we should act as if nothing was specified:
  		    if (@imports == 1) {
  			@imports = @$exports;
  			last;
  		    }
  		    # We need a way to emulate 'use Foo ()' but still
  		    # allow an easy version check: "use Foo 1.23, ''";
  		    if (@imports == 2 and !$imports[1]) {
  			@imports = ();
  			last;
  		    }
  		} elsif ($sym !~ s/^&// || !$export_cache->{$sym}) {
  		    # Last chance - see if they've updated EXPORT_OK since we
  		    # cached it.
  
  		    unless ($cache_is_current) {
  			%$export_cache = ();
  			_rebuild_cache ($pkg, $exports, $export_cache);
  			$cache_is_current = 1;
  		    }
  
  		    if (!$export_cache->{$sym}) {
  			# accumulate the non-exports
  			push @carp,
  			  qq["$sym" is not exported by the $pkg module];
  			$oops++;
  		    }
  		}
  	    }
  	}
  	if ($oops) {
  	    require Carp;
  	    Carp::croak(join("\n", @carp, "Can't continue after import errors"));
  	}
      }
      else {
  	@imports = @$exports;
      }
  
      my($fail, $fail_cache) = (\@{"${pkg}::EXPORT_FAIL"},
                                $Exporter::FailCache{$pkg} ||= {});
  
      if (@$fail) {
  	if (!%$fail_cache) {
  	    # Build cache of symbols. Optimise the lookup by adding
  	    # barewords twice... both with and without a leading &.
  	    # (Technique could be applied to $export_cache at cost of memory)
  	    my @expanded = map { /^\w/ ? ($_, '&'.$_) : $_ } @$fail;
  	    warn "${pkg}::EXPORT_FAIL cached: @expanded" if $Exporter::Verbose;
  	    @{$fail_cache}{@expanded} = (1) x @expanded;
  	}
  	my @failed;
  	foreach $sym (@imports) { push(@failed, $sym) if $fail_cache->{$sym} }
  	if (@failed) {
  	    @failed = $pkg->export_fail(@failed);
  	    foreach $sym (@failed) {
                  require Carp;
  		Carp::carp(qq["$sym" is not implemented by the $pkg module ],
  			"on this architecture");
  	    }
  	    if (@failed) {
  		require Carp;
  		Carp::croak("Can't continue after import errors");
  	    }
  	}
      }
  
      warn "Importing into $callpkg from $pkg: ",
  		join(", ",sort @imports) if $Exporter::Verbose;
  
      foreach $sym (@imports) {
  	# shortcut for the common case of no type character
  	(*{"${callpkg}::$sym"} = \&{"${pkg}::$sym"}, next)
  	    unless $sym =~ s/^(\W)//;
  	$type = $1;
  	no warnings 'once';
  	*{"${callpkg}::$sym"} =
  	    $type eq '&' ? \&{"${pkg}::$sym"} :
  	    $type eq '$' ? \${"${pkg}::$sym"} :
  	    $type eq '@' ? \@{"${pkg}::$sym"} :
  	    $type eq '%' ? \%{"${pkg}::$sym"} :
  	    $type eq '*' ?  *{"${pkg}::$sym"} :
  	    do { require Carp; Carp::croak("Can't export symbol: $type$sym") };
      }
  }
  
  sub heavy_export_to_level
  {
        my $pkg = shift;
        my $level = shift;
        (undef) = shift;			# XXX redundant arg
        my $callpkg = caller($level);
        $pkg->export($callpkg, @_);
  }
  
  # Utility functions
  
  sub _push_tags {
      my($pkg, $var, $syms) = @_;
      my @nontag = ();
      my $export_tags = \%{"${pkg}::EXPORT_TAGS"};
      push(@{"${pkg}::$var"},
  	map { $export_tags->{$_} ? @{$export_tags->{$_}} 
                                   : scalar(push(@nontag,$_),$_) }
  		(@$syms) ? @$syms : keys %$export_tags);
      if (@nontag and $^W) {
  	# This may change to a die one day
  	require Carp;
  	Carp::carp(join(", ", @nontag)." are not tags of $pkg");
      }
  }
  
  sub heavy_require_version {
      my($self, $wanted) = @_;
      my $pkg = ref $self || $self;
      return ${pkg}->VERSION($wanted);
  }
  
  sub heavy_export_tags {
    _push_tags((caller)[0], "EXPORT",    \@_);
  }
  
  sub heavy_export_ok_tags {
    _push_tags((caller)[0], "EXPORT_OK", \@_);
  }
  
  1;
EXPORTER_HEAVY

$fatpacked{"Getopt/Long.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GETOPT_LONG';
  #! perl
  
  # Getopt::Long.pm -- Universal options parsing
  # Author          : Johan Vromans
  # Created On      : Tue Sep 11 15:00:12 1990
  # Last Modified On: Tue Jun 11 13:18:11 2024
  # Update Count    : 1811
  # Status          : Released
  
  ################ Module Preamble ################
  
  # Getopt::Long is reported to run under 5.6.1. Thanks Tux!
  use 5.006001;
  
  use strict;
  use warnings;
  
  package Getopt::Long;
  
  # Must match Getopt::Long::Parser::VERSION!
  our $VERSION = 2.58;
  
  use Exporter;
  use base qw(Exporter);
  
  # Exported subroutines.
  sub GetOptions(@);		# always
  sub GetOptionsFromArray(@);	# on demand
  sub GetOptionsFromString(@);	# on demand
  sub Configure(@);		# on demand
  sub HelpMessage(@);		# on demand
  sub VersionMessage(@);		# in demand
  
  our @EXPORT;
  our @EXPORT_OK;
  # Values for $order. See GNU getopt.c for details.
  our ($REQUIRE_ORDER, $PERMUTE, $RETURN_IN_ORDER);
  BEGIN {
      ($REQUIRE_ORDER, $PERMUTE, $RETURN_IN_ORDER) = (0..2);
      @EXPORT    = qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER);
      @EXPORT_OK = qw(&HelpMessage &VersionMessage &Configure
  		    &GetOptionsFromArray &GetOptionsFromString);
  }
  
  # User visible variables.
  our ($error, $debug, $major_version, $minor_version);
  # Deprecated visible variables.
  our ($autoabbrev, $getopt_compat, $ignorecase, $bundling, $order,
       $passthrough);
  # Official invisible variables.
  our ($genprefix, $caller, $gnu_compat, $auto_help, $auto_version, $longprefix);
  
  # Really invisible variables.
  my $bundling_values;
  
  # Public subroutines.
  sub config(@);			# deprecated name
  
  # Private subroutines.
  sub ConfigDefaults();
  sub ParseOptionSpec($$);
  sub OptCtl($);
  sub FindOption($$$$$);
  sub ValidValue ($$$$$);
  
  ################ Local Variables ################
  
  # $requested_version holds the version that was mentioned in the 'use'
  # or 'require', if any. It can be used to enable or disable specific
  # features.
  my $requested_version = 0;
  
  ################ Resident subroutines ################
  
  sub ConfigDefaults() {
      # Handle POSIX compliancy.
      if ( defined $ENV{"POSIXLY_CORRECT"} ) {
  	$genprefix = "(--|-)";
  	$autoabbrev = 0;		# no automatic abbrev of options
  	$bundling = 0;			# no bundling of single letter switches
  	$getopt_compat = 0;		# disallow '+' to start options
  	$order = $REQUIRE_ORDER;
      }
      else {
  	$genprefix = "(--|-|\\+)";
  	$autoabbrev = 1;		# automatic abbrev of options
  	$bundling = 0;			# bundling off by default
  	$getopt_compat = 1;		# allow '+' to start options
  	$order = $PERMUTE;
      }
      # Other configurable settings.
      $debug = 0;			# for debugging
      $error = 0;			# error tally
      $ignorecase = 1;		# ignore case when matching options
      $passthrough = 0;		# leave unrecognized options alone
      $gnu_compat = 0;		# require --opt=val if value is optional
      $longprefix = "(--)";       # what does a long prefix look like
      $bundling_values = 0;	# no bundling of values
  }
  
  # Override import.
  sub import {
      my $pkg = shift;		# package
      my @syms = ();		# symbols to import
      my @config = ();		# configuration
      my $dest = \@syms;		# symbols first
      for ( @_ ) {
  	if ( $_ eq ':config' ) {
  	    $dest = \@config;	# config next
  	    next;
  	}
  	push(@$dest, $_);	# push
      }
      # Hide one level and call super.
      local $Exporter::ExportLevel = 1;
      push(@syms, qw(&GetOptions)) if @syms; # always export GetOptions
      $requested_version = 0;
      $pkg->SUPER::import(@syms);
      # And configure.
      Configure(@config) if @config;
  }
  
  ################ Initialization ################
  
  # Version major/minor numbers.
  ($major_version, $minor_version) = $VERSION =~ /^(\d+)\.(\d+)/;
  
  ConfigDefaults();
  
  # Store a copy of the default configuration. Since ConfigDefaults has
  # just been called, what we get from Configure is the default.
  my $default_config = do {
      Getopt::Long::Configure ()
  };
  
  # For the parser only.
  sub _default_config { $default_config }
  
  ################ Back to Normal ################
  
  # The ooparser was traditionally part of the main package.
  no warnings 'redefine';
  sub Getopt::Long::Parser::new {
      require Getopt::Long::Parser;
      goto &Getopt::Long::Parser::new;
  }
  use warnings 'redefine';
  
  # Indices in option control info.
  # Note that ParseOptions uses the fields directly. Search for 'hard-wired'.
  use constant CTL_TYPE    => 0;
  #use constant   CTL_TYPE_FLAG   => '';
  #use constant   CTL_TYPE_NEG    => '!';
  #use constant   CTL_TYPE_INCR   => '+';
  #use constant   CTL_TYPE_INT    => 'i';
  #use constant   CTL_TYPE_INTINC => 'I';
  #use constant   CTL_TYPE_XINT   => 'o';
  #use constant   CTL_TYPE_FLOAT  => 'f';
  #use constant   CTL_TYPE_STRING => 's';
  
  use constant CTL_CNAME   => 1;
  
  use constant CTL_DEFAULT => 2;
  
  use constant CTL_DEST    => 3;
   use constant   CTL_DEST_SCALAR => 0;
   use constant   CTL_DEST_ARRAY  => 1;
   use constant   CTL_DEST_HASH   => 2;
   use constant   CTL_DEST_CODE   => 3;
  
  use constant CTL_AMIN    => 4;
  use constant CTL_AMAX    => 5;
  
  # FFU.
  #use constant CTL_RANGE   => ;
  #use constant CTL_REPEAT  => ;
  
  # Rather liberal patterns to match numbers.
  use constant PAT_INT   => "[-+]?_*[0-9][0-9_]*";
  use constant PAT_XINT  =>
    "(?:".
  	  "[-+]?_*[1-9][0-9_]*".
    "|".
  	  "0x_*[0-9a-f][0-9a-f_]*".
    "|".
  	  "0b_*[01][01_]*".
    "|".
  	  "0[0-7_]*".
    ")";
  use constant PAT_FLOAT =>
    "[-+]?".			# optional sign
    "(?=\\.?[0-9])".		# must start with digit or dec.point
    "[0-9_]*".			# digits before the dec.point
    "(\\.[0-9_]*)?".		# optional fraction
    "([eE][-+]?[0-9_]+)?";	# optional exponent
  
  sub GetOptions(@) {
      # Shift in default array.
      unshift(@_, \@ARGV);
      # Try to keep caller() and Carp consistent.
      goto &GetOptionsFromArray;
  }
  
  sub GetOptionsFromString(@) {
      my ($string) = shift;
      require Text::ParseWords;
      my $args = [ Text::ParseWords::shellwords($string) ];
      $caller ||= (caller)[0];	# current context
      my $ret = GetOptionsFromArray($args, @_);
      return ( $ret, $args ) if wantarray;
      if ( @$args ) {
  	$ret = 0;
  	warn("GetOptionsFromString: Excess data \"@$args\" in string \"$string\"\n");
      }
      $ret;
  }
  
  sub GetOptionsFromArray(@) {
  
      my ($argv, @optionlist) = @_;	# local copy of the option descriptions
      my $argend = '--';		# option list terminator
      my %opctl = ();		# table of option specs
      my $pkg = $caller || (caller)[0];	# current context
  				# Needed if linkage is omitted.
      my @ret = ();		# accum for non-options
      my %linkage;		# linkage
      my $userlinkage;		# user supplied HASH
      my $opt;			# current option
      my $prefix = $genprefix;	# current prefix
  
      $error = '';
  
      if ( $debug ) {
  	# Avoid some warnings if debugging.
  	local ($^W) = 0;
  	print STDERR
  	  ("Getopt::Long $VERSION ",
  	   "called from package \"$pkg\".",
  	   "\n  ",
  	   "argv: ",
  	   defined($argv)
  	   ? UNIVERSAL::isa( $argv, 'ARRAY' ) ? "(@$argv)" : $argv
  	   : "<undef>",
  	   "\n  ",
  	   "autoabbrev=$autoabbrev,".
  	   "bundling=$bundling,",
  	   "bundling_values=$bundling_values,",
  	   "getopt_compat=$getopt_compat,",
  	   "gnu_compat=$gnu_compat,",
  	   "order=$order,",
  	   "\n  ",
  	   "ignorecase=$ignorecase,",
  	   "requested_version=$requested_version,",
  	   "passthrough=$passthrough,",
  	   "genprefix=\"$genprefix\",",
  	   "longprefix=\"$longprefix\".",
  	   "\n");
      }
  
      # Check for ref HASH as first argument.
      # First argument may be an object. It's OK to use this as long
      # as it is really a hash underneath.
      $userlinkage = undef;
      if ( @optionlist && ref($optionlist[0]) and
  	 UNIVERSAL::isa($optionlist[0],'HASH') ) {
  	$userlinkage = shift (@optionlist);
  	print STDERR ("=> user linkage: $userlinkage\n") if $debug;
      }
  
      # See if the first element of the optionlist contains option
      # starter characters.
      # Be careful not to interpret '<>' as option starters.
      if ( @optionlist && $optionlist[0] =~ /^\W+$/
  	 && !($optionlist[0] eq '<>'
  	      && @optionlist > 0
  	      && ref($optionlist[1])) ) {
  	$prefix = shift (@optionlist);
  	# Turn into regexp. Needs to be parenthesized!
  	$prefix =~ s/(\W)/\\$1/g;
  	$prefix = "([" . $prefix . "])";
  	print STDERR ("=> prefix=\"$prefix\"\n") if $debug;
      }
  
      # Verify correctness of optionlist.
      %opctl = ();
      while ( @optionlist ) {
  	my $opt = shift (@optionlist);
  
  	unless ( defined($opt) ) {
  	    $error .= "Undefined argument in option spec\n";
  	    next;
  	}
  
  	# Strip leading prefix so people can specify "--foo=i" if they like.
  	$opt = $+ if $opt =~ /^$prefix+(.*)$/s;
  
  	if ( $opt eq '<>' ) {
  	    if ( (defined $userlinkage)
  		&& !(@optionlist > 0 && ref($optionlist[0]))
  		&& (exists $userlinkage->{$opt})
  		&& ref($userlinkage->{$opt}) ) {
  		unshift (@optionlist, $userlinkage->{$opt});
  	    }
  	    unless ( @optionlist > 0
  		    && ref($optionlist[0]) && ref($optionlist[0]) eq 'CODE' ) {
  		$error .= "Option spec <> requires a reference to a subroutine\n";
  		# Kill the linkage (to avoid another error).
  		shift (@optionlist)
  		  if @optionlist && ref($optionlist[0]);
  		next;
  	    }
  	    $linkage{'<>'} = shift (@optionlist);
  	    next;
  	}
  
  	# Parse option spec.
  	my ($name, $orig) = ParseOptionSpec ($opt, \%opctl);
  	unless ( defined $name ) {
  	    # Failed. $orig contains the error message. Sorry for the abuse.
  	    $error .= $orig;
  	    # Kill the linkage (to avoid another error).
  	    shift (@optionlist)
  	      if @optionlist && ref($optionlist[0]);
  	    next;
  	}
  
  	# If no linkage is supplied in the @optionlist, copy it from
  	# the userlinkage if available.
  	if ( defined $userlinkage ) {
  	    unless ( @optionlist > 0 && ref($optionlist[0]) ) {
  		if ( exists $userlinkage->{$orig} &&
  		     ref($userlinkage->{$orig}) ) {
  		    print STDERR ("=> found userlinkage for \"$orig\": ",
  				  "$userlinkage->{$orig}\n")
  			if $debug;
  		    unshift (@optionlist, $userlinkage->{$orig});
  		}
  		else {
  		    # Do nothing. Being undefined will be handled later.
  		    next;
  		}
  	    }
  	}
  
  	# Copy the linkage. If omitted, link to global variable.
  	if ( @optionlist > 0 && ref($optionlist[0]) ) {
  	    print STDERR ("=> link \"$orig\" to $optionlist[0]\n")
  		if $debug;
  	    my $rl = ref($linkage{$orig} = shift (@optionlist));
  
  	    if ( $rl eq "ARRAY" ) {
  		$opctl{$name}[CTL_DEST] = CTL_DEST_ARRAY;
  	    }
  	    elsif ( $rl eq "HASH" ) {
  		$opctl{$name}[CTL_DEST] = CTL_DEST_HASH;
  	    }
  	    elsif ( $rl eq "SCALAR" || $rl eq "REF" ) {
  #		if ( $opctl{$name}[CTL_DEST] == CTL_DEST_ARRAY ) {
  #		    my $t = $linkage{$orig};
  #		    $$t = $linkage{$orig} = [];
  #		}
  #		elsif ( $opctl{$name}[CTL_DEST] == CTL_DEST_HASH ) {
  #		}
  #		else {
  		    # Ok.
  #		}
  	    }
  	    elsif ( $rl eq "CODE" ) {
  		# Ok.
  	    }
  	    else {
  		$error .= "Invalid option linkage for \"$opt\"\n";
  	    }
  	}
  	else {
  	    # Link to global $opt_XXX variable.
  	    # Make sure a valid perl identifier results.
  	    my $ov = $orig;
  	    $ov =~ s/\W/_/g;
  	    if ( $opctl{$name}[CTL_DEST] == CTL_DEST_ARRAY ) {
  		print STDERR ("=> link \"$orig\" to \@$pkg","::opt_$ov\n")
  		    if $debug;
  		eval ("\$linkage{\$orig} = \\\@".$pkg."::opt_$ov;");
  	    }
  	    elsif ( $opctl{$name}[CTL_DEST] == CTL_DEST_HASH ) {
  		print STDERR ("=> link \"$orig\" to \%$pkg","::opt_$ov\n")
  		    if $debug;
  		eval ("\$linkage{\$orig} = \\\%".$pkg."::opt_$ov;");
  	    }
  	    else {
  		print STDERR ("=> link \"$orig\" to \$$pkg","::opt_$ov\n")
  		    if $debug;
  		eval ("\$linkage{\$orig} = \\\$".$pkg."::opt_$ov;");
  	    }
  	}
  
  	if ( $opctl{$name}[CTL_TYPE] eq 'I'
  	     && ( $opctl{$name}[CTL_DEST] == CTL_DEST_ARRAY
  		  || $opctl{$name}[CTL_DEST] == CTL_DEST_HASH )
  	   ) {
  	    $error .= "Invalid option linkage for \"$opt\"\n";
  	}
  
      }
  
      $error .= "GetOptionsFromArray: 1st parameter is not an array reference\n"
        unless $argv && UNIVERSAL::isa( $argv, 'ARRAY' );
  
      # Bail out if errors found.
      die ($error) if $error;
      $error = 0;
  
      # Supply --version and --help support, if needed and allowed.
      if ( defined($auto_version) ? $auto_version : ($requested_version >= 2.3203) ) {
  	if ( !defined($opctl{version}) ) {
  	    $opctl{version} = ['','version',0,CTL_DEST_CODE,undef];
  	    $linkage{version} = \&VersionMessage;
  	}
  	$auto_version = 1;
      }
      if ( defined($auto_help) ? $auto_help : ($requested_version >= 2.3203) ) {
  	if ( !defined($opctl{help}) && !defined($opctl{'?'}) ) {
  	    $opctl{help} = $opctl{'?'} = ['','help',0,CTL_DEST_CODE,undef];
  	    $linkage{help} = \&HelpMessage;
  	}
  	$auto_help = 1;
      }
  
      # Show the options tables if debugging.
      if ( $debug ) {
  	my ($arrow, $k, $v);
  	$arrow = "=> ";
  	while ( ($k,$v) = each(%opctl) ) {
  	    print STDERR ($arrow, "\$opctl{$k} = $v ", OptCtl($v), "\n");
  	    $arrow = "   ";
  	}
      }
  
      # Process argument list
      my $goon = 1;
      while ( $goon && @$argv > 0 ) {
  
  	# Get next argument.
  	$opt = shift (@$argv);
  	print STDERR ("=> arg \"", $opt, "\"\n") if $debug;
  
  	# Double dash is option list terminator.
  	if ( defined($opt) && $opt eq $argend ) {
  	  push (@ret, $argend) if $passthrough;
  	  last;
  	}
  
  	# Look it up.
  	my $tryopt = $opt;
  	my $found;		# success status
  	my $key;		# key (if hash type)
  	my $arg;		# option argument
  	my $ctl;		# the opctl entry
  	my $starter;		# the actual starter character(s)
  
  	($found, $opt, $ctl, $starter, $arg, $key) =
  	  FindOption ($argv, $prefix, $argend, $opt, \%opctl);
  
  	if ( $found ) {
  
  	    # FindOption undefines $opt in case of errors.
  	    next unless defined $opt;
  
  	    my $argcnt = 0;
  	    while ( defined $arg ) {
  
  		# Get the canonical name.
  		my $given = $opt;
  		print STDERR ("=> cname for \"$opt\" is ") if $debug;
  		$opt = $ctl->[CTL_CNAME];
  		print STDERR ("\"$ctl->[CTL_CNAME]\"\n") if $debug;
  
  		if ( defined $linkage{$opt} ) {
  		    print STDERR ("=> ref(\$L{$opt}) -> ",
  				  ref($linkage{$opt}), "\n") if $debug;
  
  		    if ( ref($linkage{$opt}) eq 'SCALAR'
  			 || ref($linkage{$opt}) eq 'REF' ) {
  			if ( $ctl->[CTL_TYPE] eq '+' ) {
  			    print STDERR ("=> \$\$L{$opt} += \"$arg\"\n")
  			      if $debug;
  			    if ( defined ${$linkage{$opt}} ) {
  			        ${$linkage{$opt}} += $arg;
  			    }
  		            else {
  			        ${$linkage{$opt}} = $arg;
  			    }
  			}
  			elsif ( $ctl->[CTL_DEST] == CTL_DEST_ARRAY ) {
  			    print STDERR ("=> ref(\$L{$opt}) auto-vivified",
  					  " to ARRAY\n")
  			      if $debug;
  			    my $t = $linkage{$opt};
  			    $$t = $linkage{$opt} = [];
  			    print STDERR ("=> push(\@{\$L{$opt}, \"$arg\")\n")
  			      if $debug;
  			    push (@{$linkage{$opt}}, $arg);
  			}
  			elsif ( $ctl->[CTL_DEST] == CTL_DEST_HASH ) {
  			    print STDERR ("=> ref(\$L{$opt}) auto-vivified",
  					  " to HASH\n")
  			      if $debug;
  			    my $t = $linkage{$opt};
  			    $$t = $linkage{$opt} = {};
  			    print STDERR ("=> \$\$L{$opt}->{$key} = \"$arg\"\n")
  			      if $debug;
  			    $linkage{$opt}->{$key} = $arg;
  			}
  			else {
  			    print STDERR ("=> \$\$L{$opt} = \"$arg\"\n")
  			      if $debug;
  			    ${$linkage{$opt}} = $arg;
  		        }
  		    }
  		    elsif ( ref($linkage{$opt}) eq 'ARRAY' ) {
  			print STDERR ("=> push(\@{\$L{$opt}, \"$arg\")\n")
  			    if $debug;
  			push (@{$linkage{$opt}}, $arg);
  		    }
  		    elsif ( ref($linkage{$opt}) eq 'HASH' ) {
  			print STDERR ("=> \$\$L{$opt}->{$key} = \"$arg\"\n")
  			    if $debug;
  			$linkage{$opt}->{$key} = $arg;
  		    }
  		    elsif ( ref($linkage{$opt}) eq 'CODE' ) {
  			print STDERR ("=> &L{$opt}(\"$opt\"",
  				      $ctl->[CTL_DEST] == CTL_DEST_HASH ? ", \"$key\"" : "",
  				      ", \"$arg\")\n")
  			    if $debug;
  			my $eval_error = do {
  			    local $@;
  			    local $SIG{__DIE__}  = 'DEFAULT';
  			    eval {
  				&{$linkage{$opt}}
  				  (Getopt::Long::CallBack->new
  				   (name     => $opt,
  				    given    => $given,
  				    ctl      => $ctl,
  				    opctl    => \%opctl,
  				    linkage  => \%linkage,
  				    prefix   => $prefix,
  				    starter  => $starter,
  				   ),
  				   $ctl->[CTL_DEST] == CTL_DEST_HASH ? ($key) : (),
  				   $arg);
  			    };
  			    $@;
  			};
  			print STDERR ("=> die($eval_error)\n")
  			  if $debug && $eval_error ne '';
  			if ( $eval_error =~ /^!/ ) {
  			    if ( $eval_error =~ /^!FINISH\b/ ) {
  				$goon = 0;
  			    }
  			}
  			elsif ( $eval_error ne '' ) {
  			    warn ($eval_error);
  			    $error++;
  			}
  		    }
  		    else {
  			print STDERR ("Invalid REF type \"", ref($linkage{$opt}),
  				      "\" in linkage\n");
  			die("Getopt::Long -- internal error!\n");
  		    }
  		}
  		# No entry in linkage means entry in userlinkage.
  		elsif ( $ctl->[CTL_DEST] == CTL_DEST_ARRAY ) {
  		    if ( defined $userlinkage->{$opt} ) {
  			print STDERR ("=> push(\@{\$L{$opt}}, \"$arg\")\n")
  			    if $debug;
  			push (@{$userlinkage->{$opt}}, $arg);
  		    }
  		    else {
  			print STDERR ("=>\$L{$opt} = [\"$arg\"]\n")
  			    if $debug;
  			$userlinkage->{$opt} = [$arg];
  		    }
  		}
  		elsif ( $ctl->[CTL_DEST] == CTL_DEST_HASH ) {
  		    if ( defined $userlinkage->{$opt} ) {
  			print STDERR ("=> \$L{$opt}->{$key} = \"$arg\"\n")
  			    if $debug;
  			$userlinkage->{$opt}->{$key} = $arg;
  		    }
  		    else {
  			print STDERR ("=>\$L{$opt} = {$key => \"$arg\"}\n")
  			    if $debug;
  			$userlinkage->{$opt} = {$key => $arg};
  		    }
  		}
  		else {
  		    if ( $ctl->[CTL_TYPE] eq '+' ) {
  			print STDERR ("=> \$L{$opt} += \"$arg\"\n")
  			  if $debug;
  			if ( defined $userlinkage->{$opt} ) {
  			    $userlinkage->{$opt} += $arg;
  			}
  			else {
  			    $userlinkage->{$opt} = $arg;
  			}
  		    }
  		    else {
  			print STDERR ("=>\$L{$opt} = \"$arg\"\n") if $debug;
  			$userlinkage->{$opt} = $arg;
  		    }
  		}
  
  		$argcnt++;
  		last if $argcnt >= $ctl->[CTL_AMAX] && $ctl->[CTL_AMAX] != -1;
  		undef($arg);
  
  		# Need more args?
  		if ( $argcnt < $ctl->[CTL_AMIN] ) {
  		    if ( @$argv ) {
  			if ( ValidValue($ctl, $argv->[0], 1, $argend, $prefix) ) {
  			    $arg = shift(@$argv);
  			    if ( $ctl->[CTL_TYPE] =~ /^[iIo]$/ ) {
  				$arg =~ tr/_//d;
  				$arg = $ctl->[CTL_TYPE] eq 'o' && $arg =~ /^0/
  				  ? oct($arg)
  				  : 0+$arg
  			    }
  			    ($key,$arg) = $arg =~ /^([^=]+)=(.*)/
  			      if $ctl->[CTL_DEST] == CTL_DEST_HASH;
  			    next;
  			}
  			warn("Value \"$$argv[0]\" invalid for option $opt\n");
  			$error++;
  		    }
  		    else {
  			warn("Insufficient arguments for option $opt\n");
  			$error++;
  		    }
  		}
  
  		# Any more args?
  		if ( @$argv && ValidValue($ctl, $argv->[0], 0, $argend, $prefix) ) {
  		    $arg = shift(@$argv);
  		    if ( $ctl->[CTL_TYPE] =~ /^[iIo]$/ ) {
  			$arg =~ tr/_//d;
  			$arg = $ctl->[CTL_TYPE] eq 'o' && $arg =~ /^0/
  			  ? oct($arg)
  			  : 0+$arg
  		    }
  		    ($key,$arg) = $arg =~ /^([^=]+)=(.*)/
  		      if $ctl->[CTL_DEST] == CTL_DEST_HASH;
  		    next;
  		}
  	    }
  	}
  
  	# Not an option. Save it if we $PERMUTE and don't have a <>.
  	elsif ( $order == $PERMUTE ) {
  	    # Try non-options call-back.
  	    my $cb;
  	    if ( defined ($cb = $linkage{'<>'}) ) {
  		print STDERR ("=> &L{$tryopt}(\"$tryopt\")\n")
  		  if $debug;
  		my $eval_error = do {
  		    local $@;
  		    local $SIG{__DIE__}  = 'DEFAULT';
  		    eval {
  			# The arg to <> cannot be the CallBack object
  			# since it may be passed to other modules that
  			# get confused (e.g., Archive::Tar). Well,
  			# it's not relevant for this callback anyway.
  			&$cb($tryopt);
  		    };
  		    $@;
  		};
  		print STDERR ("=> die($eval_error)\n")
  		  if $debug && $eval_error ne '';
  		if ( $eval_error =~ /^!/ ) {
  		    if ( $eval_error =~ /^!FINISH\b/ ) {
  			$goon = 0;
  		    }
  		}
  		elsif ( $eval_error ne '' ) {
  		    warn ($eval_error);
  		    $error++;
  		}
  	    }
  	    else {
  		print STDERR ("=> saving \"$tryopt\" ",
  			      "(not an option, may permute)\n") if $debug;
  		push (@ret, $tryopt);
  	    }
  	    next;
  	}
  
  	# ...otherwise, terminate.
  	else {
  	    # Push this one back and exit.
  	    unshift (@$argv, $tryopt);
  	    return ($error == 0);
  	}
  
      }
  
      # Finish.
      if ( @ret && ( $order == $PERMUTE || $passthrough ) ) {
  	#  Push back accumulated arguments
  	print STDERR ("=> restoring \"", join('" "', @ret), "\"\n")
  	    if $debug;
  	unshift (@$argv, @ret);
      }
  
      return ($error == 0);
  }
  
  # A readable representation of what's in an optbl.
  sub OptCtl ($) {
      my ($v) = @_;
      my @v = map { defined($_) ? ($_) : ("<undef>") } @$v;
      "[".
        join(",",
  	   "\"$v[CTL_TYPE]\"",
  	   "\"$v[CTL_CNAME]\"",
  	   "\"$v[CTL_DEFAULT]\"",
  	   ("\$","\@","\%","\&")[$v[CTL_DEST] || 0],
  	   $v[CTL_AMIN] || '',
  	   $v[CTL_AMAX] || '',
  #	   $v[CTL_RANGE] || '',
  #	   $v[CTL_REPEAT] || '',
  	  ). "]";
  }
  
  # Parse an option specification and fill the tables.
  sub ParseOptionSpec ($$) {
      my ($opt, $opctl) = @_;
  
      # Allow period in option name unless passing through,
      my $op = $passthrough
        ? qr/(?: \w+[-\w]* )/x : qr/(?: \w+[-.\w]* )/x;
  
      # Match option spec.
      if ( $opt !~ m;^
  		   (
  		     # Option name
  		     $op
  		     # Aliases
  		     (?: \| (?: . [^|!+=:]* )? )*
  		   )?
  		   (
  		     # Either modifiers ...
  		     [!+]
  		     |
  		     # ... or a value/dest/repeat specification
  		     [=:] [ionfs] [@%]? (?: \{\d*,?\d*\} )?
  		     |
  		     # ... or an optional-with-default spec
  		     : (?: 0[0-7]+ | 0[xX][0-9a-fA-F]+ | 0[bB][01]+ | -?\d+ | \+ ) [@%]?
  		   )?
  		   $;x ) {
  	return (undef, "Error in option spec: \"$opt\"\n");
      }
  
      my ($names, $spec) = ($1, $2);
      $spec = '' unless defined $spec;
  
      # $orig keeps track of the primary name the user specified.
      # This name will be used for the internal or external linkage.
      # In other words, if the user specifies "FoO|BaR", it will
      # match any case combinations of 'foo' and 'bar', but if a global
      # variable needs to be set, it will be $opt_FoO in the exact case
      # as specified.
      my $orig;
  
      my @names;
      if ( defined $names ) {
  	@names =  split (/\|/, $names);
  	$orig = $names[0];
      }
      else {
  	@names = ('');
  	$orig = '';
      }
  
      # Construct the opctl entries.
      my $entry;
      if ( $spec eq '' || $spec eq '+' || $spec eq '!' ) {
  	# Fields are hard-wired here.
  	$entry = [$spec,$orig,undef,CTL_DEST_SCALAR,0,0];
      }
      elsif ( $spec =~ /^:(0[0-7]+|0x[0-9a-f]+|0b[01]+|-?\d+|\+)([@%])?$/i ) {
  	my $def = $1;
  	my $dest = $2;
  	my $type = 'i';		# assume integer
  	if ( $def eq '+' ) {
  	    # Increment.
  	    $type = 'I';
  	}
  	elsif ( $def =~ /^(0[0-7]+|0[xX][0-9a-fA-F]+|0[bB][01]+)$/ ) {
  	    # Octal, binary or hex.
  	    $type = 'o';
  	    $def = oct($def);
  	}
  	elsif ( $def =~ /^-?\d+$/ ) {
  	    # Integer.
  	    $def = 0 + $def;
  	}
  	$dest ||= '$';
  	$dest = $dest eq '@' ? CTL_DEST_ARRAY
  	  : $dest eq '%' ? CTL_DEST_HASH : CTL_DEST_SCALAR;
  	# Fields are hard-wired here.
  	$entry = [$type,$orig,$def eq '+' ? undef : $def,
  		  $dest,0,1];
      }
      else {
  	my ($mand, $type, $dest) =
  	  $spec =~ /^([=:])([ionfs])([@%])?(\{(\d+)?(,)?(\d+)?\})?$/;
  	return (undef, "Cannot repeat while bundling: \"$opt\"\n")
  	  if $bundling && defined($4);
  	my ($mi, $cm, $ma) = ($5, $6, $7);
  	return (undef, "{0} is useless in option spec: \"$opt\"\n")
  	  if defined($mi) && !$mi && !defined($ma) && !defined($cm);
  
  	$type = 'i' if $type eq 'n';
  	$dest ||= '$';
  	$dest = $dest eq '@' ? CTL_DEST_ARRAY
  	  : $dest eq '%' ? CTL_DEST_HASH : CTL_DEST_SCALAR;
  	# Default minargs to 1/0 depending on mand status.
  	$mi = $mand eq '=' ? 1 : 0 unless defined $mi;
  	# Adjust mand status according to minargs.
  	$mand = $mi ? '=' : ':';
  	# Adjust maxargs.
  	$ma = $mi ? $mi : 1 unless defined $ma || defined $cm;
  	return (undef, "Max must be greater than zero in option spec: \"$opt\"\n")
  	  if defined($ma) && !$ma;
  	return (undef, "Max less than min in option spec: \"$opt\"\n")
  	  if defined($ma) && $ma < $mi;
  
  	# Fields are hard-wired here.
  	$entry = [$type,$orig,undef,$dest,$mi,$ma||-1];
      }
  
      # Process all names. First is canonical, the rest are aliases.
      my $dups = '';
      foreach ( @names ) {
  
  	$_ = lc ($_)
  	  if $ignorecase > (($bundling && length($_) == 1) ? 1 : 0);
  
  	if ( exists $opctl->{$_} ) {
  	    $dups .= "Duplicate specification \"$opt\" for option \"$_\"\n";
  	}
  
  	if ( $spec eq '!' ) {
  	    $opctl->{"no$_"} = $entry;
  	    $opctl->{"no-$_"} = $entry;
  	    $opctl->{$_} = [@$entry];
  	    $opctl->{$_}->[CTL_TYPE] = '';
  	}
  	else {
  	    $opctl->{$_} = $entry;
  	}
      }
  
      if ( $dups ) {
  	# Warn now. Will become fatal in a future release.
  	foreach ( split(/\n+/, $dups) ) {
  	    warn($_."\n");
  	}
      }
      ($names[0], $orig);
  }
  
  # Option lookup.
  sub FindOption ($$$$$) {
  
      # returns (1, $opt, $ctl, $starter, $arg, $key) if okay,
      # returns (1, undef) if option in error,
      # returns (0) otherwise.
  
      my ($argv, $prefix, $argend, $opt, $opctl) = @_;
  
      print STDERR ("=> find \"$opt\"\n") if $debug;
  
      return (0) unless defined($opt);
      return (0) unless $opt =~ /^($prefix)(.*)$/s;
      return (0) if $opt eq "-" && !defined $opctl->{''};
  
      $opt = substr( $opt, length($1) ); # retain taintedness
      my $starter = $1;
  
      print STDERR ("=> split \"$starter\"+\"$opt\"\n") if $debug;
  
      my $optarg;			# value supplied with --opt=value
      my $rest;			# remainder from unbundling
  
      # If it is a long option, it may include the value.
      # With getopt_compat, only if not bundling.
      if ( ($starter=~/^$longprefix$/
  	  || ($getopt_compat && ($bundling == 0 || $bundling == 2)))
  	 && (my $oppos = index($opt, '=', 1)) > 0) {
  	my $optorg = $opt;
  	$opt = substr($optorg, 0, $oppos);
  	$optarg = substr($optorg, $oppos + 1); # retain tainedness
  	print STDERR ("=> option \"", $opt,
  		      "\", optarg = \"$optarg\"\n") if $debug;
      }
  
      #### Look it up ###
  
      my $tryopt = $opt;		# option to try
  
      if ( ( $bundling || $bundling_values ) && $starter eq '-' ) {
  
  	# To try overrides, obey case ignore.
  	$tryopt = $ignorecase ? lc($opt) : $opt;
  
  	# If bundling == 2, long options can override bundles.
  	if ( $bundling == 2 && length($tryopt) > 1
  	     && defined ($opctl->{$tryopt}) ) {
  	    print STDERR ("=> $starter$tryopt overrides unbundling\n")
  	      if $debug;
  	}
  
  	# If bundling_values, option may be followed by the value.
  	elsif ( $bundling_values ) {
  	    $tryopt = $opt;
  	    # Unbundle single letter option.
  	    $rest = length ($tryopt) > 0 ? substr ($tryopt, 1) : '';
  	    $tryopt = substr ($tryopt, 0, 1);
  	    $tryopt = lc ($tryopt) if $ignorecase > 1;
  	    print STDERR ("=> $starter$tryopt unbundled from ",
  			  "$starter$tryopt$rest\n") if $debug;
  	    # Whatever remains may not be considered an option.
  	    $optarg = $rest eq '' ? undef : $rest;
  	    $rest = undef;
  	}
  
  	# Split off a single letter and leave the rest for
  	# further processing.
  	else {
  	    $tryopt = $opt;
  	    # Unbundle single letter option.
  	    $rest = length ($tryopt) > 0 ? substr ($tryopt, 1) : '';
  	    $tryopt = substr ($tryopt, 0, 1);
  	    $tryopt = lc ($tryopt) if $ignorecase > 1;
  	    print STDERR ("=> $starter$tryopt unbundled from ",
  			  "$starter$tryopt$rest\n") if $debug;
  	    $rest = undef unless $rest ne '';
  	}
      }
  
      # Try auto-abbreviation.
      elsif ( $autoabbrev && $opt ne "" ) {
  	# Sort the possible long option names.
  	my @names = sort(keys (%$opctl));
  	# Downcase if allowed.
  	$opt = lc ($opt) if $ignorecase;
  	$tryopt = $opt;
  	# Turn option name into pattern.
  	my $pat = quotemeta ($opt);
  	# Look up in option names.
  	my @hits = grep (/^$pat/, @names);
  	print STDERR ("=> ", scalar(@hits), " hits (@hits) with \"$pat\" ",
  		      "out of ", scalar(@names), "\n") if $debug;
  
  	# Check for ambiguous results.
  	unless ( (@hits <= 1) || (grep ($_ eq $opt, @hits) == 1) ) {
  	    # See if all matches are for the same option.
  	    my %hit;
  	    foreach ( @hits ) {
  		my $hit = $opctl->{$_}->[CTL_CNAME]
  		  if defined $opctl->{$_}->[CTL_CNAME];
  		$hit = "no" . $hit if $opctl->{$_}->[CTL_TYPE] eq '!';
  		$hit{$hit} = 1;
  	    }
  	    # Remove auto-supplied options (version, help).
  	    if ( keys(%hit) == 2 ) {
  		if ( $auto_version && exists($hit{version}) ) {
  		    delete $hit{version};
  		}
  		elsif ( $auto_help && exists($hit{help}) ) {
  		    delete $hit{help};
  		}
  	    }
  	    # Now see if it really is ambiguous.
  	    unless ( keys(%hit) == 1 ) {
  		return (0) if $passthrough;
  		warn ("Option ", $opt, " is ambiguous (",
  		      join(", ", @hits), ")\n");
  		$error++;
  		return (1, undef);
  	    }
  	    @hits = keys(%hit);
  	}
  
  	# Complete the option name, if appropriate.
  	if ( @hits == 1 && $hits[0] ne $opt ) {
  	    $tryopt = $hits[0];
  	    $tryopt = lc ($tryopt)
  	      if $ignorecase > (($bundling && length($tryopt) == 1) ? 1 : 0);
  	    print STDERR ("=> option \"$opt\" -> \"$tryopt\"\n")
  		if $debug;
  	}
      }
  
      # Map to all lowercase if ignoring case.
      elsif ( $ignorecase ) {
  	$tryopt = lc ($opt);
      }
  
      # Check validity by fetching the info.
      my $ctl = $opctl->{$tryopt};
      unless  ( defined $ctl ) {
  	return (0) if $passthrough;
  	# Pretend one char when bundling.
  	if ( $bundling == 1 && length($starter) == 1 ) {
  	    $opt = substr($opt,0,1);
              unshift (@$argv, $starter.$rest) if defined $rest;
  	}
  	if ( $opt eq "" ) {
  	    warn ("Missing option after ", $starter, "\n");
  	}
  	else {
  	    warn ("Unknown option: ", $opt, "\n");
  	}
  	$error++;
  	return (1, undef);
      }
      # Apparently valid.
      $opt = $tryopt;
      print STDERR ("=> found ", OptCtl($ctl),
  		  " for \"", $opt, "\"\n") if $debug;
  
      #### Determine argument status ####
  
      # If it is an option w/o argument, we're almost finished with it.
      my $type = $ctl->[CTL_TYPE];
      my $arg;
  
      if ( $type eq '' || $type eq '!' || $type eq '+' ) {
  	if ( defined $optarg ) {
  	    return (0) if $passthrough;
  	    warn ("Option ", $opt, " does not take an argument\n");
  	    $error++;
  	    undef $opt;
  	    undef $optarg if $bundling_values;
  	}
  	elsif ( $type eq '' || $type eq '+' ) {
  	    # Supply explicit value.
  	    $arg = 1;
  	}
  	else {
  	    $opt =~ s/^no-?//i;	# strip NO prefix
  	    $arg = 0;		# supply explicit value
  	}
  	unshift (@$argv, $starter.$rest) if defined $rest;
  	return (1, $opt, $ctl, $starter, $arg);
      }
  
      # Get mandatory status and type info.
      my $mand = $ctl->[CTL_AMIN];
  
      # Check if there is an option argument available.
      if ( $gnu_compat ) {
  	my $optargtype = 0; # none, 1 = empty, 2 = nonempty, 3 = aux
  	if ( defined($optarg) ) {
  	    $optargtype = (length($optarg) == 0) ? 1 : 2;
  	}
  	elsif ( defined $rest || @$argv > 0 ) {
  	    # GNU getopt_long() does not accept the (optional)
  	    # argument to be passed to the option without = sign.
  	    # We do, since not doing so breaks existing scripts.
  	    $optargtype = 3;
  	}
  	if(($optargtype == 0) && !$mand) {
  	    if ( $type eq 'I' ) {
  		# Fake incremental type.
  		my @c = @$ctl;
  		$c[CTL_TYPE] = '+';
  		return (1, $opt, \@c, $starter, 1);
  	    }
  	    my $val
  	      = defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT]
  	      : $type eq 's'                 ? ''
  	      :                                0;
  	    return (1, $opt, $ctl, $starter, $val);
  	}
  	return (1, $opt, $ctl, $starter, $type eq 's' ? '' : 0)
  	  if $optargtype == 1;  # --foo=  -> return nothing
      }
  
      # Check if there is an option argument available.
      if ( defined $optarg
  	 ? ($optarg eq '')
  	 : !(defined $rest || @$argv > 0) ) {
  	# Complain if this option needs an argument.
  #	if ( $mand && !($type eq 's' ? defined($optarg) : 0) ) {
  	if ( $mand || $ctl->[CTL_DEST] == CTL_DEST_HASH ) {
  	    return (0) if $passthrough;
  	    warn ("Option ", $opt, " requires an argument\n");
  	    $error++;
  	    return (1, undef);
  	}
  	if ( $type eq 'I' ) {
  	    # Fake incremental type.
  	    my @c = @$ctl;
  	    $c[CTL_TYPE] = '+';
  	    return (1, $opt, \@c, $starter, 1);
  	}
  	return (1, $opt, $ctl, $starter,
  		defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT] :
  		$type eq 's' ? '' : 0);
      }
  
      # Get (possibly optional) argument.
      $arg = (defined $rest ? $rest
  	    : (defined $optarg ? $optarg : shift (@$argv)));
  
      # Get key if this is a "name=value" pair for a hash option.
      my $key;
      if ($ctl->[CTL_DEST] == CTL_DEST_HASH && defined $arg) {
  	($key, $arg) = ($arg =~ /^([^=]*)=(.*)$/s) ? ($1, $2)
  	  : ($arg, defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT] :
  	     ($mand ? undef : ($type eq 's' ? "" : 1)));
  	if (! defined $arg) {
  	    warn ("Option $opt, key \"$key\", requires a value\n");
  	    $error++;
  	    # Push back.
  	    unshift (@$argv, $starter.$rest) if defined $rest;
  	    return (1, undef);
  	}
      }
  
      #### Check if the argument is valid for this option ####
  
      my $key_valid = $ctl->[CTL_DEST] == CTL_DEST_HASH ? "[^=]+=" : "";
  
      if ( $type eq 's' ) {	# string
  	# A mandatory string takes anything.
  	return (1, $opt, $ctl, $starter, $arg, $key) if $mand;
  
  	# Same for optional string as a hash value
  	return (1, $opt, $ctl, $starter, $arg, $key)
  	  if $ctl->[CTL_DEST] == CTL_DEST_HASH;
  
  	# An optional string takes almost anything.
  	return (1, $opt, $ctl, $starter, $arg, $key)
  	  if defined $optarg || defined $rest;
  	return (1, $opt, $ctl, $starter, $arg, $key) if $arg eq "-"; # ??
  
  	# Check for option or option list terminator.
  	if ($arg eq $argend ||
  	    $arg =~ /^$prefix.+/) {
  	    # Push back.
  	    unshift (@$argv, $arg);
  	    # Supply empty value.
  	    $arg = '';
  	}
      }
  
      elsif ( $type eq 'i'	# numeric/integer
              || $type eq 'I'	# numeric/integer w/ incr default
  	    || $type eq 'o' ) { # dec/oct/hex/bin value
  
  	my $o_valid = $type eq 'o' ? PAT_XINT : PAT_INT;
  
  	if ( $bundling && defined $rest
  	     && $rest =~ /^($key_valid)($o_valid)(.*)$/si ) {
  	    ($key, $arg, $rest) = ($1, $2, $+);
  	    chop($key) if $key;
  	    $arg = ($type eq 'o' && $arg =~ /^0/) ? oct($arg) : 0+$arg;
  	    unshift (@$argv, $starter.$rest) if defined $rest && $rest ne '';
  	}
  	elsif ( $arg =~ /^$o_valid$/si ) {
  	    $arg =~ tr/_//d;
  	    $arg = ($type eq 'o' && $arg =~ /^0/) ? oct($arg) : 0+$arg;
  	}
  	else {
  	    if ( defined $optarg || $mand ) {
  		if ( $passthrough ) {
  		    unshift (@$argv, defined $rest ? $starter.$rest : $arg)
  		      unless defined $optarg;
  		    return (0);
  		}
  		warn ("Value \"", $arg, "\" invalid for option ",
  		      $opt, " (",
  		      $type eq 'o' ? "extended " : '',
  		      "integer number expected)\n");
  		$error++;
  		# Push back.
  		unshift (@$argv, $starter.$rest) if defined $rest;
  		return (1, undef);
  	    }
  	    else {
  		# Push back.
  		unshift (@$argv, defined $rest ? $starter.$rest : $arg);
  		if ( $type eq 'I' ) {
  		    # Fake incremental type.
  		    my @c = @$ctl;
  		    $c[CTL_TYPE] = '+';
  		    return (1, $opt, \@c, $starter, 1);
  		}
  		# Supply default value.
  		$arg = defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT] : 0;
  	    }
  	}
      }
  
      elsif ( $type eq 'f' ) { # real number, int is also ok
  	my $o_valid = PAT_FLOAT;
  	if ( $bundling && defined $rest &&
  	     $rest =~ /^($key_valid)($o_valid)(.*)$/s ) {
  	    $arg =~ tr/_//d;
  	    ($key, $arg, $rest) = ($1, $2, $+);
  	    chop($key) if $key;
  	    unshift (@$argv, $starter.$rest) if defined $rest && $rest ne '';
  	}
  	elsif ( $arg =~ /^$o_valid$/ ) {
  	    $arg =~ tr/_//d;
  	}
  	else {
  	    if ( defined $optarg || $mand ) {
  		if ( $passthrough ) {
  		    unshift (@$argv, defined $rest ? $starter.$rest : $arg)
  		      unless defined $optarg;
  		    return (0);
  		}
  		warn ("Value \"", $arg, "\" invalid for option ",
  		      $opt, " (real number expected)\n");
  		$error++;
  		# Push back.
  		unshift (@$argv, $starter.$rest) if defined $rest;
  		return (1, undef);
  	    }
  	    else {
  		# Push back.
  		unshift (@$argv, defined $rest ? $starter.$rest : $arg);
  		# Supply default value.
  		$arg = 0.0;
  	    }
  	}
      }
      else {
  	die("Getopt::Long internal error (Can't happen)\n");
      }
      return (1, $opt, $ctl, $starter, $arg, $key);
  }
  
  sub ValidValue ($$$$$) {
      my ($ctl, $arg, $mand, $argend, $prefix) = @_;
  
      if ( $ctl->[CTL_DEST] == CTL_DEST_HASH ) {
  	return 0 unless $arg =~ /[^=]+=(.*)/;
  	$arg = $1;
      }
  
      my $type = $ctl->[CTL_TYPE];
  
      if ( $type eq 's' ) {	# string
  	# A mandatory string takes anything.
  	return (1) if $mand;
  
  	return (1) if $arg eq "-";
  
  	# Check for option or option list terminator.
  	return 0 if $arg eq $argend || $arg =~ /^$prefix.+/;
  	return 1;
      }
  
      elsif ( $type eq 'i'	# numeric/integer
              || $type eq 'I'	# numeric/integer w/ incr default
  	    || $type eq 'o' ) { # dec/oct/hex/bin value
  
  	my $o_valid = $type eq 'o' ? PAT_XINT : PAT_INT;
  	return $arg =~ /^$o_valid$/si;
      }
  
      elsif ( $type eq 'f' ) { # real number, int is also ok
  	my $o_valid = PAT_FLOAT;
  	return $arg =~ /^$o_valid$/;
      }
      die("ValidValue: Cannot happen\n");
  }
  
  # Getopt::Long Configuration.
  sub Configure (@) {
      my (@options) = @_;
  
      my $prevconfig =
        [ $error, $debug, $major_version, $minor_version, $caller,
  	$autoabbrev, $getopt_compat, $ignorecase, $bundling, $order,
  	$gnu_compat, $passthrough, $genprefix, $auto_version, $auto_help,
  	$longprefix, $bundling_values ];
  
      if ( ref($options[0]) eq 'ARRAY' ) {
  	( $error, $debug, $major_version, $minor_version, $caller,
  	  $autoabbrev, $getopt_compat, $ignorecase, $bundling, $order,
  	  $gnu_compat, $passthrough, $genprefix, $auto_version, $auto_help,
  	  $longprefix, $bundling_values ) = @{shift(@options)};
      }
  
      my $opt;
      foreach $opt ( @options ) {
  	my $try = lc ($opt);
  	my $action = 1;
  	if ( $try =~ /^no_?(.*)$/s ) {
  	    $action = 0;
  	    $try = $+;
  	}
  	if ( ($try eq 'default' or $try eq 'defaults') && $action ) {
  	    ConfigDefaults ();
  	}
  	elsif ( ($try eq 'posix_default' or $try eq 'posix_defaults') ) {
  	    local $ENV{POSIXLY_CORRECT};
  	    $ENV{POSIXLY_CORRECT} = 1 if $action;
  	    ConfigDefaults ();
  	}
  	elsif ( $try eq 'auto_abbrev' or $try eq 'autoabbrev' ) {
  	    $autoabbrev = $action;
  	}
  	elsif ( $try eq 'getopt_compat' ) {
  	    $getopt_compat = $action;
              $genprefix = $action ? "(--|-|\\+)" : "(--|-)";
  	}
  	elsif ( $try eq 'gnu_getopt' ) {
  	    if ( $action ) {
  		$gnu_compat = 1;
  		$bundling = 1;
  		$getopt_compat = 0;
                  $genprefix = "(--|-)";
  		$order = $PERMUTE;
  		$bundling_values = 0;
  	    }
  	}
  	elsif ( $try eq 'gnu_compat' ) {
  	    $gnu_compat = $action;
  	    $bundling = 0;
  	    $bundling_values = 1;
  	}
  	elsif ( $try =~ /^(auto_?)?version$/ ) {
  	    $auto_version = $action;
  	}
  	elsif ( $try =~ /^(auto_?)?help$/ ) {
  	    $auto_help = $action;
  	}
  	elsif ( $try eq 'ignorecase' or $try eq 'ignore_case' ) {
  	    $ignorecase = $action;
  	}
  	elsif ( $try eq 'ignorecase_always' or $try eq 'ignore_case_always' ) {
  	    $ignorecase = $action ? 2 : 0;
  	}
  	elsif ( $try eq 'bundling' ) {
  	    $bundling = $action;
  	    $bundling_values = 0 if $action;
  	}
  	elsif ( $try eq 'bundling_override' ) {
  	    $bundling = $action ? 2 : 0;
  	    $bundling_values = 0 if $action;
  	}
  	elsif ( $try eq 'bundling_values' ) {
  	    $bundling_values = $action;
  	    $bundling = 0 if $action;
  	}
  	elsif ( $try eq 'require_order' ) {
  	    $order = $action ? $REQUIRE_ORDER : $PERMUTE;
  	}
  	elsif ( $try eq 'permute' ) {
  	    $order = $action ? $PERMUTE : $REQUIRE_ORDER;
  	}
  	elsif ( $try eq 'pass_through' or $try eq 'passthrough' ) {
  	    $passthrough = $action;
  	}
  	elsif ( $try =~ /^prefix=(.+)$/ && $action ) {
  	    $genprefix = $1;
  	    # Turn into regexp. Needs to be parenthesized!
  	    $genprefix = "(" . quotemeta($genprefix) . ")";
  	    eval { '' =~ /$genprefix/; };
  	    die("Getopt::Long: invalid pattern \"$genprefix\"\n") if $@;
  	}
  	elsif ( $try =~ /^prefix_pattern=(.+)$/ && $action ) {
  	    $genprefix = $1;
  	    # Parenthesize if needed.
  	    $genprefix = "(" . $genprefix . ")"
  	      unless $genprefix =~ /^\(.*\)$/;
  	    eval { '' =~ m"$genprefix"; };
  	    die("Getopt::Long: invalid pattern \"$genprefix\"\n") if $@;
  	}
  	elsif ( $try =~ /^long_prefix_pattern=(.+)$/ && $action ) {
  	    $longprefix = $1;
  	    # Parenthesize if needed.
  	    $longprefix = "(" . $longprefix . ")"
  	      unless $longprefix =~ /^\(.*\)$/;
  	    eval { '' =~ m"$longprefix"; };
  	    die("Getopt::Long: invalid long prefix pattern \"$longprefix\"\n") if $@;
  	}
  	elsif ( $try eq 'debug' ) {
  	    $debug = $action;
  	}
  	else {
  	    die("Getopt::Long: unknown or erroneous config parameter \"$opt\"\n")
  	}
      }
      $prevconfig;
  }
  
  # Deprecated name.
  sub config (@) {
      Configure (@_);
  }
  
  # Issue a standard message for --version.
  #
  # The arguments are mostly the same as for Pod::Usage::pod2usage:
  #
  #  - a number (exit value)
  #  - a string (lead in message)
  #  - a hash with options. See Pod::Usage for details.
  #
  sub VersionMessage(@) {
      # Massage args.
      my $pa = setup_pa_args("version", @_);
  
      my $v = $main::VERSION;
      my $fh = $pa->{-output} ||
        ( ($pa->{-exitval} eq "NOEXIT" || $pa->{-exitval} < 2) ? \*STDOUT : \*STDERR );
  
      print $fh (defined($pa->{-message}) ? $pa->{-message} : (),
  	       $0, defined $v ? " version $v" : (),
  	       "\n",
  	       "(", __PACKAGE__, "::", "GetOptions",
  	       " version $VERSION,",
  	       " Perl version ",
  	       $] >= 5.006 ? sprintf("%vd", $^V) : $],
  	       ")\n");
      exit($pa->{-exitval}) unless $pa->{-exitval} eq "NOEXIT";
  }
  
  # Issue a standard message for --help.
  #
  # The arguments are the same as for Pod::Usage::pod2usage:
  #
  #  - a number (exit value)
  #  - a string (lead in message)
  #  - a hash with options. See Pod::Usage for details.
  #
  sub HelpMessage(@) {
      eval {
  	require Pod::Usage;
  	Pod::Usage->import;
  	1;
      } || die("Cannot provide help: cannot load Pod::Usage\n");
  
      # Note that pod2usage will issue a warning if -exitval => NOEXIT.
      pod2usage(setup_pa_args("help", @_));
  
  }
  
  # Helper routine to set up a normalized hash ref to be used as
  # argument to pod2usage.
  sub setup_pa_args($@) {
      my $tag = shift;		# who's calling
  
      # If called by direct binding to an option, it will get the option
      # name and value as arguments. Remove these, if so.
      @_ = () if @_ == 2 && $_[0] eq $tag;
  
      my $pa;
      if ( @_ > 1 ) {
  	$pa = { @_ };
      }
      else {
  	$pa = shift || {};
      }
  
      # At this point, $pa can be a number (exit value), string
      # (message) or hash with options.
  
      if ( UNIVERSAL::isa($pa, 'HASH') ) {
  	# Get rid of -msg vs. -message ambiguity.
  	if (!defined $pa->{-message}) {
  	    $pa->{-message} = delete($pa->{-msg});
  	}
      }
      elsif ( $pa =~ /^-?\d+$/ ) {
  	$pa = { -exitval => $pa };
      }
      else {
  	$pa = { -message => $pa };
      }
  
      # These are _our_ defaults.
      $pa->{-verbose} = 0 unless exists($pa->{-verbose});
      $pa->{-exitval} = 0 unless exists($pa->{-exitval});
      $pa;
  }
  
  # Sneak way to know what version the user requested.
  sub VERSION {
      $requested_version = $_[1] if @_ > 1;
      shift->SUPER::VERSION(@_);
  }
  
  package Getopt::Long::CallBack;
  
  sub new {
      my ($pkg, %atts) = @_;
      bless { %atts }, $pkg;
  }
  
  sub name {
      my $self = shift;
      ''.$self->{name};
  }
  
  sub given {
      my $self = shift;
      $self->{given};
  }
  
  use overload
    # Treat this object as an ordinary string for legacy API.
    '""'	   => \&name,
    fallback => 1;
  
  1;
  
  ################ Documentation ################
  
  =head1 NAME
  
  Getopt::Long - Extended processing of command line options
  
  =head1 SYNOPSIS
  
    use Getopt::Long;
    my $data   = "file.dat";
    my $length = 24;
    my $verbose;
    GetOptions ("length=i" => \$length,    # numeric
                "file=s"   => \$data,      # string
                "verbose"  => \$verbose)   # flag
    or die("Error in command line arguments\n");
  
  =head1 DESCRIPTION
  
  The Getopt::Long module implements an extended getopt function called
  GetOptions(). It parses the command line from C<@ARGV>, recognizing
  and removing specified options and their possible values.
  
  This function adheres to the POSIX syntax for command
  line options, with GNU extensions. In general, this means that options
  have long names instead of single letters, and are introduced with a
  double dash "--". Support for bundling of command line options, as was
  the case with the more traditional single-letter approach, is provided
  but not enabled by default.
  
  =head1 Command Line Options, an Introduction
  
  Command line operated programs traditionally take their arguments from
  the command line, for example filenames or other information that the
  program needs to know. Besides arguments, these programs often take
  command line I<options> as well. Options are not necessary for the
  program to work, hence the name 'option', but are used to modify its
  default behaviour. For example, a program could do its job quietly,
  but with a suitable option it could provide verbose information about
  what it did.
  
  Command line options come in several flavours. Historically, they are
  preceded by a single dash C<->, and consist of a single letter.
  
      -l -a -c
  
  Usually, these single-character options can be bundled:
  
      -lac
  
  Options can have values, the value is placed after the option
  character. Sometimes with whitespace in between, sometimes not:
  
      -s 24 -s24
  
  Due to the very cryptic nature of these options, another style was
  developed that used long names. So instead of a cryptic C<-l> one
  could use the more descriptive C<--long>. To distinguish between a
  bundle of single-character options and a long one, two dashes are used
  to precede the option name. Early implementations of long options used
  a plus C<+> instead. Also, option values could be specified either
  like
  
      --size=24
  
  or
  
      --size 24
  
  The C<+> form is now obsolete and strongly deprecated.
  
  =head1 Getting Started with Getopt::Long
  
  Getopt::Long is the Perl5 successor of C<newgetopt.pl>. This was the
  first Perl module that provided support for handling the new style of
  command line options, in particular long option names, hence the Perl5
  name Getopt::Long. This module also supports single-character options
  and bundling.
  
  To use Getopt::Long from a Perl program, you must include the
  following line in your Perl program:
  
      use Getopt::Long;
  
  This will load the core of the Getopt::Long module and prepare your
  program for using it. Most of the actual Getopt::Long code is not
  loaded until you really call one of its functions.
  
  In the default configuration, options names may be abbreviated to
  uniqueness, case does not matter, and a single dash is sufficient,
  even for long option names. Also, options may be placed between
  non-option arguments. See L<Configuring Getopt::Long> for more
  details on how to configure Getopt::Long.
  
  =head2 Simple options
  
  The most simple options are the ones that take no values. Their mere
  presence on the command line enables the option. Popular examples are:
  
      --all --verbose --quiet --debug
  
  Handling simple options is straightforward:
  
      my $verbose = '';	# option variable with default value (false)
      my $all = '';	# option variable with default value (false)
      GetOptions ('verbose' => \$verbose, 'all' => \$all);
  
  The call to GetOptions() parses the command line arguments that are
  present in C<@ARGV> and sets the option variable to the value C<1> if
  the option did occur on the command line. Otherwise, the option
  variable is not touched. Setting the option value to true is often
  called I<enabling> the option.
  
  The option name as specified to the GetOptions() function is called
  the option I<specification>. Later we'll see that this specification
  can contain more than just the option name. The reference to the
  variable is called the option I<destination>.
  
  GetOptions() will return a true value if the command line could be
  processed successfully. Otherwise, it will write error messages using
  die() and warn(), and return a false result.
  
  =head2 A little bit less simple options
  
  Getopt::Long supports two useful variants of simple options:
  I<negatable> options and I<incremental> options.
  
  A negatable option is specified with an exclamation mark C<!> after the
  option name:
  
      my $verbose = '';	# option variable with default value (false)
      GetOptions ('verbose!' => \$verbose);
  
  Now, using C<--verbose> on the command line will enable C<$verbose>,
  as expected. But it is also allowed to use C<--noverbose>, which will
  disable C<$verbose> by setting its value to C<0>. Using a suitable
  default value, the program can find out whether C<$verbose> is false
  by default, or disabled by using C<--noverbose>.
  
  (If both C<--verbose> and C<--noverbose> are given, whichever is given
  last takes precedence.)
  
  An incremental option is specified with a plus C<+> after the
  option name:
  
      my $verbose = '';	# option variable with default value (false)
      GetOptions ('verbose+' => \$verbose);
  
  Using C<--verbose> on the command line will increment the value of
  C<$verbose>. This way the program can keep track of how many times the
  option occurred on the command line. For example, each occurrence of
  C<--verbose> could increase the verbosity level of the program.
  
  =head2 Mixing command line option with other arguments
  
  Usually programs take command line options as well as other arguments,
  for example, file names. It is good practice to always specify the
  options first, and the other arguments last. Getopt::Long will,
  however, allow the options and arguments to be mixed and 'filter out'
  all the options before passing the rest of the arguments to the
  program. To stop Getopt::Long from processing further arguments,
  insert a double dash C<--> on the command line:
  
      --size 24 -- --all
  
  In this example, C<--all> will I<not> be treated as an option, but
  passed to the program unharmed, in C<@ARGV>.
  
  =head2 Options with values
  
  For options that take values it must be specified whether the option
  value is required or not, and what kind of value the option expects.
  
  Three kinds of values are supported: integer numbers, floating point
  numbers, and strings.
  
  If the option value is required, Getopt::Long will take the
  command line argument that follows the option and assign this to the
  option variable. If, however, the option value is specified as
  optional, this will only be done if that value does not look like a
  valid command line option itself.
  
      my $tag = '';	# option variable with default value
      GetOptions ('tag=s' => \$tag);
  
  In the option specification, the option name is followed by an equals
  sign C<=> and the letter C<s>. The equals sign indicates that this
  option requires a value. The letter C<s> indicates that this value is
  an arbitrary string. Other possible value types are C<i> for integer
  values, and C<f> for floating point values. Using a colon C<:> instead
  of the equals sign indicates that the option value is optional. In
  this case, if no suitable value is supplied, string valued options get
  an empty string C<''> assigned, while numeric options are set to C<0>.
  
  (If the same option appears more than once on the command line, the
  last given value is used.  If you want to take all the values, see
  below.)
  
  =head2 Options with multiple values
  
  Options sometimes take several values. For example, a program could
  use multiple directories to search for library files:
  
      --library lib/stdlib --library lib/extlib
  
  To accomplish this behaviour, simply specify an array reference as the
  destination for the option:
  
      GetOptions ("library=s" => \@libfiles);
  
  Alternatively, you can specify that the option can have multiple
  values by adding a "@", and pass a reference to a scalar as the
  destination:
  
      GetOptions ("library=s@" => \$libfiles);
  
  Used with the example above, C<@libfiles> c.q. C<@$libfiles> would
  contain two strings upon completion: C<"lib/stdlib"> and
  C<"lib/extlib">, in that order. It is also possible to specify that
  only integer or floating point numbers are acceptable values.
  
  Often it is useful to allow comma-separated lists of values as well as
  multiple occurrences of the options. This is easy using Perl's split()
  and join() operators:
  
      GetOptions ("library=s" => \@libfiles);
      @libfiles = split(/,/,join(',',@libfiles));
  
  Of course, it is important to choose the right separator string for
  each purpose.
  
  Warning: What follows is an experimental feature.
  
  Options can take multiple values at once, for example
  
      --coordinates 52.2 16.4 --rgbcolor 255 255 149
  
  This can be accomplished by adding a repeat specifier to the option
  specification. Repeat specifiers are very similar to the C<{...}>
  repeat specifiers that can be used with regular expression patterns.
  For example, the above command line would be handled as follows:
  
      GetOptions('coordinates=f{2}' => \@coor, 'rgbcolor=i{3}' => \@color);
  
  The destination for the option must be an array or array reference.
  
  It is also possible to specify the minimal and maximal number of
  arguments an option takes. C<foo=s{2,4}> indicates an option that
  takes at least two and at most 4 arguments. C<foo=s{1,}> indicates one
  or more values; C<foo:s{,}> indicates zero or more option values.
  
  =head2 Options with hash values
  
  If the option destination is a reference to a hash, the option will
  take, as value, strings of the form I<key>C<=>I<value>. The value will
  be stored with the specified key in the hash.
  
      GetOptions ("define=s" => \%defines);
  
  Alternatively you can use:
  
      GetOptions ("define=s%" => \$defines);
  
  When used with command line options:
  
      --define os=linux --define vendor=redhat
  
  the hash C<%defines> (or C<%$defines>) will contain two keys, C<"os">
  with value C<"linux"> and C<"vendor"> with value C<"redhat">. It is
  also possible to specify that only integer or floating point numbers
  are acceptable values. The keys are always taken to be strings.
  
  =head2 User-defined subroutines to handle options
  
  Ultimate control over what should be done when (actually: each time)
  an option is encountered on the command line can be achieved by
  designating a reference to a subroutine (or an anonymous subroutine)
  as the option destination. When GetOptions() encounters the option, it
  will call the subroutine with two or three arguments. The first
  argument is the name of the option. (Actually, it is an object that
  stringifies to the name of the option.) For a scalar or array destination,
  the second argument is the value to be stored. For a hash destination,
  the second argument is the key to the hash, and the third argument
  the value to be stored. It is up to the subroutine to store the value,
  or do whatever it thinks is appropriate.
  
  A trivial application of this mechanism is to implement options that
  are related to each other. For example:
  
      my $verbose = '';	# option variable with default value (false)
      GetOptions ('verbose' => \$verbose,
  	        'quiet'   => sub { $verbose = 0 });
  
  Here C<--verbose> and C<--quiet> control the same variable
  C<$verbose>, but with opposite values.
  
  If the subroutine needs to signal an error, it should call die() with
  the desired error message as its argument. GetOptions() will catch the
  die(), issue the error message, and record that an error result must
  be returned upon completion.
  
  If the text of the error message starts with an exclamation mark C<!>
  it is interpreted specially by GetOptions(). There is currently one
  special command implemented: C<die("!FINISH")> will cause GetOptions()
  to stop processing options, as if it encountered a double dash C<-->.
  
  Here is an example of how to access the option name and value from within
  a subroutine:
  
      GetOptions ('opt=i' => \&handler);
      sub handler {
          my ($opt_name, $opt_value) = @_;
          print("Option name is $opt_name and value is $opt_value\n");
      }
  
  =head2 Options with multiple names
  
  Often it is user friendly to supply alternate mnemonic names for
  options. For example C<--height> could be an alternate name for
  C<--length>. Alternate names can be included in the option
  specification, separated by vertical bar C<|> characters. To implement
  the above example:
  
      GetOptions ('length|height=f' => \$length);
  
  The first name is called the I<primary> name, the other names are
  called I<aliases>. When using a hash to store options, the key will
  always be the primary name.
  
  Multiple alternate names are possible.
  
  =head2 Case and abbreviations
  
  Without additional configuration, GetOptions() will ignore the case of
  option names, and allow the options to be abbreviated to uniqueness.
  
      GetOptions ('length|height=f' => \$length, "head" => \$head);
  
  This call will allow C<--l> and C<--L> for the length option, but
  requires a least C<--hea> and C<--hei> for the head and height options.
  
  =head2 Summary of Option Specifications
  
  Each option specifier consists of two parts: the name specification
  and the argument specification.
  
  The name specification contains the name of the option, optionally
  followed by a list of alternative names separated by vertical bar
  characters. The name is made up of alphanumeric characters, hyphens,
  underscores. If C<pass_through> is disabled, a period is also allowed in
  option names.
  
      length	      option name is "length"
      length|size|l     name is "length", aliases are "size" and "l"
  
  The argument specification is optional. If omitted, the option is
  considered boolean, a value of 1 will be assigned when the option is
  used on the command line.
  
  The argument specification can be
  
  =over 4
  
  =item !
  
  The option does not take an argument and may be negated by prefixing
  it with "no" or "no-". E.g. C<"foo!"> will allow C<--foo> (a value of
  1 will be assigned) as well as C<--nofoo> and C<--no-foo> (a value of
  0 will be assigned). If the option has aliases, this applies to the
  aliases as well.
  
  Using negation on a single letter option when bundling is in effect is
  pointless and will result in a warning.
  
  =item +
  
  The option does not take an argument and will be incremented by 1
  every time it appears on the command line. E.g. C<"more+">, when used
  with C<--more --more --more>, will increment the value three times,
  resulting in a value of 3 (provided it was 0 or undefined at first).
  
  The C<+> specifier is ignored if the option destination is not a scalar.
  
  =item = I<type> [ I<desttype> ] [ I<repeat> ]
  
  The option requires an argument of the given type. Supported types
  are:
  
  =over 4
  
  =item s
  
  String. An arbitrary sequence of characters. It is valid for the
  argument to start with C<-> or C<-->.
  
  =item i
  
  Integer. An optional leading plus or minus sign, followed by a
  sequence of digits.
  
  =item o
  
  Extended integer, Perl style. This can be either an optional leading
  plus or minus sign, followed by a sequence of digits, or an octal
  string (a zero, optionally followed by '0', '1', .. '7'), or a
  hexadecimal string (C<0x> followed by '0' .. '9', 'a' .. 'f', case
  insensitive), or a binary string (C<0b> followed by a series of '0'
  and '1').
  
  =item f
  
  Real number. For example C<3.14>, C<-6.23E24> and so on.
  
  =back
  
  The I<desttype> can be C<@> or C<%> to specify that the option is
  list or a hash valued. This is only needed when the destination for
  the option value is not otherwise specified. It should be omitted when
  not needed.
  
  The I<repeat> specifies the number of values this option takes per
  occurrence on the command line. It has the format C<{> [ I<min> ] [ C<,> [ I<max> ] ] C<}>.
  
  I<min> denotes the minimal number of arguments. It defaults to 1 for
  options with C<=> and to 0 for options with C<:>, see below. Note that
  I<min> overrules the C<=> / C<:> semantics.
  
  I<max> denotes the maximum number of arguments. It must be at least
  I<min>. If I<max> is omitted, I<but the comma is not>, there is no
  upper bound to the number of argument values taken.
  
  =item : I<type> [ I<desttype> ]
  
  Like C<=>, but designates the argument as optional.
  If omitted, an empty string will be assigned to string values options,
  and the value zero to numeric options.
  
  Note that if a string argument starts with C<-> or C<-->, it will be
  considered an option on itself.
  
  =item : I<number> [ I<desttype> ]
  
  Like C<:i>, but if the value is omitted, the I<number> will be assigned.
  
  If the I<number> is octal, hexadecimal or binary, behaves like C<:o>.
  
  =item : + [ I<desttype> ]
  
  Like C<:i>, but if the value is omitted, the current value for the
  option will be incremented.
  
  =back
  
  =head1 Advanced Possibilities
  
  =head2 Object oriented interface
  
  See L<Getopt::Long::Parser>.
  
  =head2 Callback object
  
  In version 2.37 the first argument to the callback function was
  changed from string to object. This was done to make room for
  extensions and more detailed control. The object stringifies to the
  option name so this change should not introduce compatibility
  problems.
  
  The callback object has the following methods:
  
  =over
  
  =item name
  
  The name of the option, unabbreviated. For an option with multiple
  names it return the first (canonical) name.
  
  =item given
  
  The name of the option as actually used, unabbreveated.
  
  =back
  
  =head2 Thread Safety
  
  Getopt::Long is thread safe when using ithreads as of Perl 5.8.  It is
  I<not> thread safe when using the older (experimental and now
  obsolete) threads implementation that was added to Perl 5.005.
  
  =head2 Documentation and help texts
  
  Getopt::Long encourages the use of Pod::Usage to produce help
  messages. For example:
  
      use Getopt::Long;
      use Pod::Usage;
  
      my $man = 0;
      my $help = 0;
  
      GetOptions('help|?' => \$help, man => \$man) or pod2usage(2);
      pod2usage(1) if $help;
      pod2usage(-exitval => 0, -verbose => 2) if $man;
  
      __END__
  
      =head1 NAME
  
      sample - Using Getopt::Long and Pod::Usage
  
      =head1 SYNOPSIS
  
      sample [options] [file ...]
  
       Options:
         -help            brief help message
         -man             full documentation
  
      =head1 OPTIONS
  
      =over 8
  
      =item B<-help>
  
      Print a brief help message and exits.
  
      =item B<-man>
  
      Prints the manual page and exits.
  
      =back
  
      =head1 DESCRIPTION
  
      B<This program> will read the given input file(s) and do something
      useful with the contents thereof.
  
      =cut
  
  See L<Pod::Usage> for details.
  
  =head2 Parsing options from an arbitrary array
  
  By default, GetOptions parses the options that are present in the
  global array C<@ARGV>. A special entry C<GetOptionsFromArray> can be
  used to parse options from an arbitrary array.
  
      use Getopt::Long qw(GetOptionsFromArray);
      $ret = GetOptionsFromArray(\@myopts, ...);
  
  When used like this, options and their possible values are removed
  from C<@myopts>, the global C<@ARGV> is not touched at all.
  
  The following two calls behave identically:
  
      $ret = GetOptions( ... );
      $ret = GetOptionsFromArray(\@ARGV, ... );
  
  This also means that a first argument hash reference now becomes the
  second argument:
  
      $ret = GetOptions(\%opts, ... );
      $ret = GetOptionsFromArray(\@ARGV, \%opts, ... );
  
  =head2 Parsing options from an arbitrary string
  
  A special entry C<GetOptionsFromString> can be used to parse options
  from an arbitrary string.
  
      use Getopt::Long qw(GetOptionsFromString);
      $ret = GetOptionsFromString($string, ...);
  
  The contents of the string are split into arguments using a call to
  C<Text::ParseWords::shellwords>. As with C<GetOptionsFromArray>, the
  global C<@ARGV> is not touched.
  
  It is possible that, upon completion, not all arguments in the string
  have been processed. C<GetOptionsFromString> will, when called in list
  context, return both the return status and an array reference to any
  remaining arguments:
  
      ($ret, $args) = GetOptionsFromString($string, ... );
  
  If any arguments remain, and C<GetOptionsFromString> was not called in
  list context, a message will be given and C<GetOptionsFromString> will
  return failure.
  
  As with GetOptionsFromArray, a first argument hash reference now
  becomes the second argument. See the next section.
  
  =head2 Storing options values in a hash
  
  Sometimes, for example when there are a lot of options, having a
  separate variable for each of them can be cumbersome. GetOptions()
  supports, as an alternative mechanism, storing options values in a
  hash.
  
  To obtain this, a reference to a hash must be passed I<as the first
  argument> to GetOptions(). For each option that is specified on the
  command line, the option value will be stored in the hash with the
  option name as key. Options that are not actually used on the command
  line will not be put in the hash, on other words,
  C<exists($h{option})> (or defined()) can be used to test if an option
  was used. The drawback is that warnings will be issued if the program
  runs under C<use strict> and uses C<$h{option}> without testing with
  exists() or defined() first.
  
      my %h = ();
      GetOptions (\%h, 'length=i');	# will store in $h{length}
  
  For options that take list or hash values, it is necessary to indicate
  this by appending an C<@> or C<%> sign after the type:
  
      GetOptions (\%h, 'colours=s@');	# will push to @{$h{colours}}
  
  To make things more complicated, the hash may contain references to
  the actual destinations, for example:
  
      my $len = 0;
      my %h = ('length' => \$len);
      GetOptions (\%h, 'length=i');	# will store in $len
  
  This example is fully equivalent with:
  
      my $len = 0;
      GetOptions ('length=i' => \$len);	# will store in $len
  
  Any mixture is possible. For example, the most frequently used options
  could be stored in variables while all other options get stored in the
  hash:
  
      my $verbose = 0;			# frequently referred
      my $debug = 0;			# frequently referred
      my %h = ('verbose' => \$verbose, 'debug' => \$debug);
      GetOptions (\%h, 'verbose', 'debug', 'filter', 'size=i');
      if ( $verbose ) { ... }
      if ( exists $h{filter} ) { ... option 'filter' was specified ... }
  
  =head2 Bundling
  
  With bundling it is possible to set several single-character options
  at once. For example if C<a>, C<v> and C<x> are all valid options,
  
      -vax
  
  will set all three.
  
  Getopt::Long supports three styles of bundling. To enable bundling, a
  call to Getopt::Long::Configure is required.
  
  The simplest style of bundling can be enabled with:
  
      Getopt::Long::Configure ("bundling");
  
  Configured this way, single-character options can be bundled but long
  options (and any of their auto-abbreviated shortened forms) B<must>
  always start with a double dash C<--> to avoid ambiguity. For example,
  when C<vax>, C<a>, C<v> and C<x> are all valid options,
  
      -vax
  
  will set C<a>, C<v> and C<x>, but
  
      --vax
  
  will set C<vax>.
  
  The second style of bundling lifts this restriction. It can be enabled
  with:
  
      Getopt::Long::Configure ("bundling_override");
  
  Now, C<-vax> will set the option C<vax>.
  
  In all of the above cases, option values may be inserted in the
  bundle. For example:
  
      -h24w80
  
  is equivalent to
  
      -h 24 -w 80
  
  A third style of bundling allows only values to be bundled with
  options. It can be enabled with:
  
      Getopt::Long::Configure ("bundling_values");
  
  Now, C<-h24> will set the option C<h> to C<24>, but option bundles
  like C<-vxa> and C<-h24w80> are flagged as errors.
  
  Enabling C<bundling_values> will disable the other two styles of
  bundling.
  
  When configured for bundling, single-character options are matched
  case sensitive while long options are matched case insensitive. To
  have the single-character options matched case insensitive as well,
  use:
  
      Getopt::Long::Configure ("bundling", "ignorecase_always");
  
  It goes without saying that bundling can be quite confusing.
  
  =head2 The lonesome dash
  
  Normally, a lone dash C<-> on the command line will not be considered
  an option. Option processing will terminate (unless "permute" is
  configured) and the dash will be left in C<@ARGV>.
  
  It is possible to get special treatment for a lone dash. This can be
  achieved by adding an option specification with an empty name, for
  example:
  
      GetOptions ('' => \$stdio);
  
  A lone dash on the command line will now be a legal option, and using
  it will set variable C<$stdio>.
  
  =head2 Argument callback
  
  A special option 'name' C<< <> >> can be used to designate a subroutine
  to handle non-option arguments. When GetOptions() encounters an
  argument that does not look like an option, it will immediately call this
  subroutine and passes it one parameter: the argument name.
  
  For example:
  
      my $width = 80;
      sub process { ... }
      GetOptions ('width=i' => \$width, '<>' => \&process);
  
  When applied to the following command line:
  
      arg1 --width=72 arg2 --width=60 arg3
  
  This will call
  C<process("arg1")> while C<$width> is C<80>,
  C<process("arg2")> while C<$width> is C<72>, and
  C<process("arg3")> while C<$width> is C<60>.
  
  This feature requires configuration option B<permute>, see section
  L<Configuring Getopt::Long>.
  
  =head1 Configuring Getopt::Long
  
  Getopt::Long can be configured by calling subroutine
  Getopt::Long::Configure(). This subroutine takes a list of quoted
  strings, each specifying a configuration option to be enabled, e.g.
  C<ignore_case>. To disable, prefix with C<no> or C<no_>, e.g.
  C<no_ignore_case>. Case does not matter. Multiple calls to Configure()
  are possible.
  
  Alternatively, as of version 2.24, the configuration options may be
  passed together with the C<use> statement:
  
      use Getopt::Long qw(:config no_ignore_case bundling);
  
  The following options are available:
  
  =over 12
  
  =item default
  
  This option causes all configuration options to be reset to their
  default values.
  
  =item posix_default
  
  This option causes all configuration options to be reset to their
  default values as if the environment variable POSIXLY_CORRECT had
  been set.
  
  =item auto_abbrev
  
  Allow option names to be abbreviated to uniqueness.
  Default is enabled unless environment variable
  POSIXLY_CORRECT has been set, in which case C<auto_abbrev> is disabled.
  
  =item getopt_compat
  
  Allow C<+> to start options.
  Default is enabled unless environment variable
  POSIXLY_CORRECT has been set, in which case C<getopt_compat> is disabled.
  
  =item gnu_compat
  
  C<gnu_compat> controls whether C<--opt=> is allowed, and what it should
  do. Without C<gnu_compat>, C<--opt=> gives an error. With C<gnu_compat>,
  C<--opt=> will give option C<opt> an empty value.
  This is the way GNU getopt_long() does it.
  
  Note that for options with optional arguments, C<--opt value> is still
  accepted, even though GNU getopt_long() requires writing C<--opt=value>
  in this case.
  
  =item gnu_getopt
  
  This is a short way of setting C<gnu_compat> C<bundling> C<permute>
  C<no_getopt_compat>. With C<gnu_getopt>, command line handling should be
  reasonably compatible with GNU getopt_long().
  
  =item require_order
  
  Whether command line arguments are allowed to be mixed with options.
  Default is disabled unless environment variable
  POSIXLY_CORRECT has been set, in which case C<require_order> is enabled.
  
  See also C<permute>, which is the opposite of C<require_order>.
  
  =item permute
  
  Whether command line arguments are allowed to be mixed with options.
  Default is enabled unless environment variable
  POSIXLY_CORRECT has been set, in which case C<permute> is disabled.
  Note that C<permute> is the opposite of C<require_order>.
  
  If C<permute> is enabled, this means that
  
      --foo arg1 --bar arg2 arg3
  
  is equivalent to
  
      --foo --bar arg1 arg2 arg3
  
  If an argument callback routine is specified, C<@ARGV> will always be
  empty upon successful return of GetOptions() since all options have been
  processed. The only exception is when C<--> is used:
  
      --foo arg1 --bar arg2 -- arg3
  
  This will call the callback routine for arg1 and arg2, and then
  terminate GetOptions() leaving C<"arg3"> in C<@ARGV>.
  
  If C<require_order> is enabled, options processing
  terminates when the first non-option is encountered.
  
      --foo arg1 --bar arg2 arg3
  
  is equivalent to
  
      --foo -- arg1 --bar arg2 arg3
  
  If C<pass_through> is also enabled, options processing will terminate
  at the first unrecognized option, or non-option, whichever comes
  first.
  
  =item bundling (default: disabled)
  
  Enabling this option will allow single-character options to be
  bundled. To distinguish bundles from long option names, long options
  (and any of their auto-abbreviated shortened forms) I<must> be
  introduced with C<--> and bundles with C<->.
  
  Note that, if you have options C<a>, C<l> and C<all>, and
  auto_abbrev enabled, possible arguments and option settings are:
  
      using argument               sets option(s)
      ------------------------------------------
      -a, --a                      a
      -l, --l                      l
      -al, -la, -ala, -all,...     a, l
      --al, --all                  all
  
  The surprising part is that C<--a> sets option C<a> (due to auto
  completion), not C<all>.
  
  Note: disabling C<bundling> also disables C<bundling_override>.
  
  =item bundling_override (default: disabled)
  
  If C<bundling_override> is enabled, bundling is enabled as with
  C<bundling> but now long option names override option bundles.
  
  Note: disabling C<bundling_override> also disables C<bundling>.
  
  B<Note:> Using option bundling can easily lead to unexpected results,
  especially when mixing long options and bundles. Caveat emptor.
  
  =item ignore_case  (default: enabled)
  
  If enabled, case is ignored when matching option names. If, however,
  bundling is enabled as well, single character options will be treated
  case-sensitive.
  
  With C<ignore_case>, option specifications for options that only
  differ in case, e.g., C<"foo"> and C<"Foo">, will be flagged as
  duplicates.
  
  Note: disabling C<ignore_case> also disables C<ignore_case_always>.
  
  =item ignore_case_always (default: disabled)
  
  When bundling is in effect, case is ignored on single-character
  options also.
  
  Note: disabling C<ignore_case_always> also disables C<ignore_case>.
  
  =item auto_version (default:disabled)
  
  Automatically provide support for the B<--version> option if
  the application did not specify a handler for this option itself.
  
  Getopt::Long will provide a standard version message that includes the
  program name, its version (if $main::VERSION is defined), and the
  versions of Getopt::Long and Perl. The message will be written to
  standard output and processing will terminate.
  
  C<auto_version> will be enabled if the calling program explicitly
  specified a version number higher than 2.32 in the C<use> or
  C<require> statement.
  
  =item auto_help (default:disabled)
  
  Automatically provide support for the B<--help> and B<-?> options if
  the application did not specify a handler for this option itself.
  
  Getopt::Long will provide a help message using module L<Pod::Usage>. The
  message, derived from the SYNOPSIS POD section, will be written to
  standard output and processing will terminate.
  
  C<auto_help> will be enabled if the calling program explicitly
  specified a version number higher than 2.32 in the C<use> or
  C<require> statement.
  
  =item pass_through (default: disabled)
  
  With C<pass_through> anything that is unknown, ambiguous or supplied with
  an invalid option will not be flagged as an error. Instead the unknown
  option(s) will be passed to the catchall C<< <> >> if present, otherwise
  through to C<@ARGV>. This makes it possible to write wrapper scripts that
  process only part of the user supplied command line arguments, and pass the
  remaining options to some other program.
  
  If C<require_order> is enabled, options processing will terminate at the
  first unrecognized option, or non-option, whichever comes first and all
  remaining arguments are passed to C<@ARGV> instead of the catchall
  C<< <> >> if present.  However, if C<permute> is enabled instead, results
  can become confusing.
  
  Note that the options terminator (default C<-->), if present, will
  also be passed through in C<@ARGV>.
  
  =item prefix
  
  The string that starts options. If a constant string is not
  sufficient, see C<prefix_pattern>.
  
  =item prefix_pattern
  
  A Perl pattern that identifies the strings that introduce options.
  Default is C<--|-|\+> unless environment variable
  POSIXLY_CORRECT has been set, in which case it is C<--|->.
  
  =item long_prefix_pattern
  
  A Perl pattern that allows the disambiguation of long and short
  prefixes. Default is C<-->.
  
  Typically you only need to set this if you are using nonstandard
  prefixes and want some or all of them to have the same semantics as
  '--' does under normal circumstances.
  
  For example, setting prefix_pattern to C<--|-|\+|\/> and
  long_prefix_pattern to C<--|\/> would add Win32 style argument
  handling.
  
  =item debug (default: disabled)
  
  Enable debugging output.
  
  =back
  
  =head1 Exportable Methods
  
  =over
  
  =item VersionMessage
  
  This subroutine provides a standard version message. Its argument can be:
  
  =over 4
  
  =item *
  
  A string containing the text of a message to print I<before> printing
  the standard message.
  
  =item *
  
  A numeric value corresponding to the desired exit status.
  
  =item *
  
  A reference to a hash.
  
  =back
  
  If more than one argument is given then the entire argument list is
  assumed to be a hash.  If a hash is supplied (either as a reference or
  as a list) it should contain one or more elements with the following
  keys:
  
  =over 4
  
  =item C<-message>
  
  =item C<-msg>
  
  The text of a message to print immediately prior to printing the
  program's usage message.
  
  =item C<-exitval>
  
  The desired exit status to pass to the B<exit()> function.
  This should be an integer, or else the string "NOEXIT" to
  indicate that control should simply be returned without
  terminating the invoking process.
  
  =item C<-output>
  
  A reference to a filehandle, or the pathname of a file to which the
  usage message should be written. The default is C<\*STDERR> unless the
  exit value is less than 2 (in which case the default is C<\*STDOUT>).
  
  =back
  
  You cannot tie this routine directly to an option, e.g.:
  
      GetOptions("version" => \&VersionMessage);
  
  Use this instead:
  
      GetOptions("version" => sub { VersionMessage() });
  
  =item HelpMessage
  
  This subroutine produces a standard help message, derived from the
  program's POD section SYNOPSIS using L<Pod::Usage>. It takes the same
  arguments as VersionMessage(). In particular, you cannot tie it
  directly to an option, e.g.:
  
      GetOptions("help" => \&HelpMessage);
  
  Use this instead:
  
      GetOptions("help" => sub { HelpMessage() });
  
  =back
  
  =head1 Return values and Errors
  
  Configuration errors and errors in the option definitions are
  signalled using die() and will terminate the calling program unless
  the call to Getopt::Long::GetOptions() was embedded in C<eval { ...
  }>, or die() was trapped using C<$SIG{__DIE__}>.
  
  GetOptions returns true to indicate success.
  It returns false when the function detected one or more errors during
  option parsing. These errors are signalled using warn() and can be
  trapped with C<$SIG{__WARN__}>.
  
  =head1 Legacy
  
  The earliest development of C<newgetopt.pl> started in 1990, with Perl
  version 4. As a result, its development, and the development of
  Getopt::Long, has gone through several stages. Since backward
  compatibility has always been extremely important, the current version
  of Getopt::Long still supports a lot of constructs that nowadays are
  no longer necessary or otherwise unwanted. This section describes
  briefly some of these 'features'.
  
  =head2 Default destinations
  
  When no destination is specified for an option, GetOptions will store
  the resultant value in a global variable named C<opt_>I<XXX>, where
  I<XXX> is the primary name of this option. When a program executes
  under C<use strict> (recommended), these variables must be
  pre-declared with our().
  
      our $opt_length = 0;
      GetOptions ('length=i');	# will store in $opt_length
  
  To yield a usable Perl variable, characters that are not part of the
  syntax for variables are translated to underscores. For example,
  C<--fpp-struct-return> will set the variable
  C<$opt_fpp_struct_return>. Note that this variable resides in the
  namespace of the calling program, not necessarily C<main>. For
  example:
  
      GetOptions ("size=i", "sizes=i@");
  
  with command line "-size 10 -sizes 24 -sizes 48" will perform the
  equivalent of the assignments
  
      $opt_size = 10;
      @opt_sizes = (24, 48);
  
  =head2 Alternative option starters
  
  A string of alternative option starter characters may be passed as the
  first argument (or the first argument after a leading hash reference
  argument).
  
      my $len = 0;
      GetOptions ('/', 'length=i' => $len);
  
  Now the command line may look like:
  
      /length 24 -- arg
  
  Note that to terminate options processing still requires a double dash
  C<-->.
  
  GetOptions() will not interpret a leading C<< "<>" >> as option starters
  if the next argument is a reference. To force C<< "<" >> and C<< ">" >> as
  option starters, use C<< "><" >>. Confusing? Well, B<using a starter
  argument is strongly deprecated> anyway.
  
  =head2 Configuration variables
  
  Previous versions of Getopt::Long used variables for the purpose of
  configuring. Although manipulating these variables still work, it is
  strongly encouraged to use the C<Configure> routine that was introduced
  in version 2.17. Besides, it is much easier.
  
  =head1 Tips and Techniques
  
  =head2 Pushing multiple values in a hash option
  
  Sometimes you want to combine the best of hashes and arrays. For
  example, the command line:
  
    --list add=first --list add=second --list add=third
  
  where each successive 'list add' option will push the value of add
  into array ref $list->{'add'}. The result would be like
  
    $list->{add} = [qw(first second third)];
  
  This can be accomplished with a destination routine:
  
    GetOptions('list=s%' =>
                 sub { push(@{$list{$_[1]}}, $_[2]) });
  
  =head1 Troubleshooting
  
  =head2 GetOptions does not return a false result when an option is not supplied
  
  That's why they're called 'options'.
  
  =head2 GetOptions does not split the command line correctly
  
  The command line is not split by GetOptions, but by the command line
  interpreter (CLI). On Unix, this is the shell. On Windows, it is
  COMMAND.COM or CMD.EXE. Other operating systems have other CLIs.
  
  It is important to know that these CLIs may behave different when the
  command line contains special characters, in particular quotes or
  backslashes. For example, with Unix shells you can use single quotes
  (C<'>) and double quotes (C<">) to group words together. The following
  alternatives are equivalent on Unix:
  
      "two words"
      'two words'
      two\ words
  
  In case of doubt, insert the following statement in front of your Perl
  program:
  
      print STDERR (join("|",@ARGV),"\n");
  
  to verify how your CLI passes the arguments to the program.
  
  =head2 Undefined subroutine &main::GetOptions called
  
  Are you running Windows, and did you write
  
      use GetOpt::Long;
  
  (note the capital 'O')?
  
  =head2 How do I put a "-?" option into a Getopt::Long?
  
  You can only obtain this using an alias, and Getopt::Long of at least
  version 2.13.
  
      use Getopt::Long;
      GetOptions ("help|?");    # -help and -? will both set $opt_help
  
  Other characters that can't appear in Perl identifiers are also
  supported in aliases with Getopt::Long of at version 2.39. Note that
  the characters C<!>, C<|>, C<+>, C<=>, and C<:> can only appear as the
  first (or only) character of an alias.
  
  As of version 2.32 Getopt::Long provides auto-help, a quick and easy way
  to add the options --help and -? to your program, and handle them.
  
  See C<auto_help> in section L<Configuring Getopt::Long>.
  
  =head1 AUTHOR
  
  Johan Vromans <jvromans@squirrel.nl>
  
  =head1 COPYRIGHT AND DISCLAIMER
  
  This program is Copyright 1990,2015,2023 by Johan Vromans.
  This program is free software; you can redistribute it and/or
  modify it under the terms of the Perl Artistic License or the
  GNU General Public License as published by the Free Software
  Foundation; either version 2 of the License, or (at your option) any
  later version.
  
  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.
  
  If you do not have a copy of the GNU General Public License write to
  the Free Software Foundation, Inc., 675 Mass Ave, Cambridge,
  MA 02139, USA.
  
  =cut
  
GETOPT_LONG

$fatpacked{"Getopt/Long/Parser.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GETOPT_LONG_PARSER';
  #! perl
  
  # Parser.pm -- Getopt::Long object-oriented interface
  # Author          : Johan Vromans
  # Created On      : Thu Nov  9 10:37:00 2023
  # Last Modified On: Tue Jun 11 13:17:57 2024
  # Update Count    : 16
  # Status          : Released
  
  use strict;
  use warnings;
  
  package Getopt::Long::Parser;
  
  # Must match Getopt::Long::VERSION!
  our $VERSION = 2.58;
  
  =head1 NAME
  
  Getopt::Long::Parser - Getopt::Long object-oriented interface
  
  =head1 SYNOPSIS
  
      use Getopt::Long::Parser;
      my $p = Getopt::Long::Parser->new;
      $p->configure( %options );
      if ( $p->getoptions( @options ) ) { ... }
      if ( $p->getoptionsfromarray( \@array, @options ) ) { ... }
  
  Configuration options can be passed to the constructor:
  
      my $p = Getopt::Long::Parser->new( config => [ %options ] );
  
  =head1 DESCRIPTION
  
  C<Getopt::Long::Parser> is an object-oriented interface to
  L<Getopt::Long>. See its documentation for configuration and use.
  
  Note that C<Getopt::Long> and C<Getopt::Long::Parser> are not
  object-oriented.
  C<Getopt::Long::Parser> emulates an object-oriented interface,
  which should be okay for most purposes.
  
  =head1 CONSTRUCTOR
  
      my $p = Getopt::Long::Parser->new( %options );
  
  The constructor takes an optional hash with parameters.
  
  =over 4
  
  =item config
  
  An array reference with configuration settings.
  See L<Getopt::Long/"Configuring Getopt::Long"> for all possible settings.
  
  =back
  
  =cut
  
  # Getopt::Long has a stub for Getopt::Long::Parser::new.
  use Getopt::Long ();
  no warnings 'redefine';
  
  sub new {
      my $that = shift;
      my $class = ref($that) || $that;
      my %atts = @_;
  
      # Register the callers package.
      my $self = { caller_pkg => (caller)[0] };
  
      bless ($self, $class);
  
      my $default_config = Getopt::Long::_default_config();
  
      # Process config attributes.
      if ( defined $atts{config} ) {
  	my $save = Getopt::Long::Configure ($default_config, @{$atts{config}});
  	$self->{settings} = Getopt::Long::Configure ($save);
  	delete ($atts{config});
      }
      # Else use default config.
      else {
  	$self->{settings} = $default_config;
      }
  
      if ( %atts ) {		# Oops
  	die(__PACKAGE__.": unhandled attributes: ".
  	    join(" ", sort(keys(%atts)))."\n");
      }
  
      $self;
  }
  
  use warnings 'redefine';
  
  =head1 METHODS
  
  In the examples, C<$p> is assumed to be the result of a call to the constructor.
  
  =head2 configure
  
      $p->configure( %settings );
  
  Update the current config settings.
  See L<Getopt::Long/"Configuring Getopt::Long"> for all possible settings.
  
  =cut
  
  sub configure {
      my ($self) = shift;
  
      # Restore settings, merge new settings in.
      my $save = Getopt::Long::Configure ($self->{settings}, @_);
  
      # Restore orig config and save the new config.
      $self->{settings} = Getopt::Long::Configure ($save);
  }
  
  =head2 getoptionsfromarray
  
      my $res = $p->getoptionsfromarray( $aref, @opts );
  
  =head2 getoptions
  
      my $res = $p->getoptions( @opts );
  
  The same as C<getoptionsfromarray( \@ARGV, @opts )>.
  
  =cut
  
  sub getoptions {
      my ($self) = shift;
  
      return $self->getoptionsfromarray(\@ARGV, @_);
  }
  
  sub getoptionsfromarray {
      my ($self) = shift;
  
      # Restore config settings.
      my $save = Getopt::Long::Configure ($self->{settings});
  
      # Call main routine.
      my $ret = 0;
      $Getopt::Long::caller = $self->{caller_pkg};
  
      eval {
  	# Locally set exception handler to default, otherwise it will
  	# be called implicitly here, and again explicitly when we try
  	# to deliver the messages.
  	local ($SIG{__DIE__}) = 'DEFAULT';
  	$ret = Getopt::Long::GetOptionsFromArray (@_);
      };
  
      # Restore saved settings.
      Getopt::Long::Configure ($save);
  
      # Handle errors and return value.
      die ($@) if $@;
      return $ret;
  }
  
  =head1 SEE ALSO
  
  L<Getopt::Long>
  
  =head1 AUTHOR
  
  Johan Vromans <jvromans@squirrel.nl>
  
  =head1 COPYRIGHT AND DISCLAIMER
  
  This program is Copyright 1990,2015,2023 by Johan Vromans.
  This program is free software; you can redistribute it and/or
  modify it under the same terms as Perl.
  
  =cut
  
  1;
GETOPT_LONG_PARSER

$fatpacked{"parent.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PARENT';
  package parent;
  use strict;
  
  our $VERSION = '0.241';
  
  sub import {
      my $class = shift;
  
      my $inheritor = caller(0);
  
      if ( @_ and $_[0] eq '-norequire' ) {
          shift @_;
      } else {
          for ( my @filename = @_ ) {
              s{::|'}{/}g;
              require "$_.pm"; # dies if the file is not found
          }
      }
  
      {
          no strict 'refs';
          push @{"$inheritor\::ISA"}, @_; # dies if a loop is detected
      };
  };
  
  1;
  
  __END__
  
  =encoding utf8
  
  =head1 NAME
  
  parent - Establish an ISA relationship with base classes at compile time
  
  =head1 SYNOPSIS
  
      package Baz;
      use parent qw(Foo Bar);
  
  =head1 DESCRIPTION
  
  Allows you to both load one or more modules, while setting up inheritance from
  those modules at the same time.  Mostly similar in effect to
  
      package Baz;
      BEGIN {
          require Foo;
          require Bar;
          push @ISA, qw(Foo Bar);
      }
  
  By default, every base class needs to live in a file of its own.
  If you want to have a subclass and its parent class in the same file, you
  can tell C<parent> not to load any modules by using the C<-norequire> switch:
  
    package Foo;
    sub exclaim { "I CAN HAS PERL" }
  
    package DoesNotLoadFooBar;
    use parent -norequire, 'Foo', 'Bar';
    # will not go looking for Foo.pm or Bar.pm
  
  This is equivalent to the following code:
  
    package Foo;
    sub exclaim { "I CAN HAS PERL" }
  
    package DoesNotLoadFooBar;
    push @DoesNotLoadFooBar::ISA, 'Foo', 'Bar';
  
  This is also helpful for the case where a package lives within
  a differently named file:
  
    package MyHash;
    use Tie::Hash;
    use parent -norequire, 'Tie::StdHash';
  
  This is equivalent to the following code:
  
    package MyHash;
    require Tie::Hash;
    push @ISA, 'Tie::StdHash';
  
  If you want to load a subclass from a file that C<require> would
  not consider an eligible filename (that is, it does not end in
  either C<.pm> or C<.pmc>), use the following code:
  
    package MySecondPlugin;
    require './plugins/custom.plugin'; # contains Plugin::Custom
    use parent -norequire, 'Plugin::Custom';
  
  =head1 HISTORY
  
  This module was forked from L<base> to remove the cruft
  that had accumulated in it.
  
  =head1 CAVEATS
  
  =head1 SEE ALSO
  
  =over 4
  
  =item L<base>
  
  =item L<parent::versioned>
  
  A fork of L<parent> that provides version checking in parent class modules.
  
  =back
  
  =head1 AUTHORS AND CONTRIBUTORS
  
  Rafaël Garcia-Suarez, Bart Lateur, Max Maischein, Anno Siegel, Michael Schwern
  
  =head1 MAINTAINER
  
  Max Maischein C< corion@cpan.org >
  
  Copyright (c) 2007-2017 Max Maischein C<< <corion@cpan.org> >>
  Based on the idea of C<base.pm>, which was introduced with Perl 5.004_04.
  
  =head1 LICENSE
  
  This module is released under the same terms as Perl itself.
  
  =cut
PARENT

s/^  //mg for values %fatpacked;

my $class = 'FatPacked::'.(0+\%fatpacked);
no strict 'refs';
*{"${class}::files"} = sub { keys %{$_[0]} };

if ($] < 5.008) {
  *{"${class}::INC"} = sub {
    if (my $fat = $_[0]{$_[1]}) {
      my $pos = 0;
      my $last = length $fat;
      return (sub {
        return 0 if $pos == $last;
        my $next = (1 + index $fat, "\n", $pos) || $last;
        $_ .= substr $fat, $pos, $next - $pos;
        $pos = $next;
        return 1;
      });
    }
  };
}

else {
  *{"${class}::INC"} = sub {
    if (my $fat = $_[0]{$_[1]}) {
      open my $fh, '<', \$fat
        or die "FatPacker error loading $_[1] (could be a perl installation issue?)";
      return $fh;
    }
    return;
  };
}

unshift @INC, bless \%fatpacked, $class;
  } # END OF FATPACK CODE

## no critic (ControlStructures::ProhibitPostfixControls)
## no critic (ValuesAndExpressions::ProhibitConstantPragma)
use strict;
use warnings;
use open ':std', IO => ':encoding(UTF-8)';

# ABSTRACT: Ensure that the environment variables match what you need, or abort.

# PODNAME: envassert

our $VERSION = '0.015';

use English      qw( -no_match_vars );                   # Avoids regex performance penalty in perl 5.18 and earlier
use Getopt::Long qw( :config auto_version auto_help );
use Carp;
use Pod::Usage;

use Env::Assert::Functions qw( :all );

local $OUTPUT_AUTOFLUSH = 1;

use constant {
    YEAR_START        => 1900,
    MONTH_START       => 1,
    ENV_DESC_FILENAME => '.envdesc',
    INDENT            => q{    },
};

my $man = 0;
my $break_at_first_error;
my $env_desc_filename = ENV_DESC_FILENAME;
my $exact;
my $stdin = 0;
GetOptions(
    'man'                     => \$man,
    'break-at-first-error|b!' => \$break_at_first_error,
    'env-description|e=s'     =>,
    \$env_desc_filename,
    'exact|x!' => \$exact,
    'stdin!'   => \$stdin,
) or pod2usage(2);
pod2usage( -exitval => 0, -verbose => 2 ) if $man;

sub main {

    my @env_desc_rows;
    if ($stdin) {
        @env_desc_rows = <>;
    }
    else {
        open my $fh, q{<}, $env_desc_filename or croak "Cannot open file '$env_desc_filename'";
        @env_desc_rows = <$fh>;
        close $fh or croak "Cannot close file '$env_desc_filename'";
    }

    my $desc = file_to_desc(@env_desc_rows);
    my %parameters;
    $parameters{'break_at_first_error'} = $break_at_first_error
      if defined $break_at_first_error;
    $desc->{'options'}->{'exact'} = $exact
      if defined $exact;
    my $r = assert( \%ENV, $desc, \%parameters );
    if ( !$r->{'success'} ) {
        print {*STDOUT} report_errors( $r->{'errors'} )
          or croak 'Cannot print errors to STDOUT';
        return 1;
    }
    return 0;
}

exit main(@ARGV);

__END__

=pod

=encoding UTF-8

=head1 NAME

envassert - Ensure that the environment variables match what you need, or abort.

=head1 VERSION

version 0.015

=head1 SYNOPSIS

envassert [options]

Options:
    --help
    --man
    --version
    --break-at-first-error, -b
    --env-description, -e
    --exact, -x
    --stdin, -s

=head1 DESCRIPTION

B<envassert> checks that your runtime environment, as defined
with environment variables, matches with what you want.

You can define your required environment in a file.
Default file is F<.envassert> but you can use any file.

It is advantageous to use B<envassert> for example when running
a container. If you check your environment for missing or
wrongly defined environment variables at the beginning of
the container run, your container will fail sooner instead
of in a later point in execution when the variables are needed.

=head2 Errors

There are three kinds of errors:

=over 8

=item ENV_ASSERT_MISSING_FROM_ENVIRONMENT

"Variable <var_name> is missing from environment"

=item ENV_ASSERT_INVALID_CONTENT_IN_VARIABLE

"Variable <var_name> has invalid content"

=item ENV_ASSERT_MISSING_FROM_DEFINITION

"Variable <var_name> is missing from description"

This error will only be reported if you have set
the special option B<exact>. See below.

=back

=head2 Environment Description Language

Environment is described in file F<.envdesc>.
Environment description file is a Unix shell compatible file,
similar to a F<.env> file.

=head3 F<.envdesc> Format

In F<.envdesc> file there is only environment variables, comments
or empty rows.
Example:

    # Required env
    ## envassert (opts: exact=1)
    FILENAME=^[[:word:]]{1,}$

Env var name is followed by a regular expression. The regexp is
an extended Perl regular expression without quotation marks.
One env var and its descriptive regexp use one row.

A comment begins at the beginning of the row and uses the whole row.
It start with '#' character.

Two comment characters and the word B<envassert> at the beginning of the row
mean this is an B<envassert> meta command.
You can specify different environment related options with these commands.

Supported options:

=over 8

=item exact

The option I<exact> means that all allowed env variables
are described in this file. Any unknown env var causes an error
when verifying.

=back

=head2 CLI interface without dependencies

The F<envassert> command is also available
as self contained executable.
You can download it and run it as it is without
additional installation of CPAN packages.
Of course, you still need Perl, but Perl comes with any
normal Linux installation.

This can be convenient if you want to, for instance,
include F<envassert> in a docker container build.

    curl -LSs -o envassert https://raw.githubusercontent.com/mikkoi/env-assert/main/envassert.self-contained
    chmod +x ./envassert

=for stopwords env envassert envdesc

=head1 NAME

envassert - Ensure that the environment variables match what you need, or abort.

=head1 OPTIONS

=over 8

=item B<--help>

Print a brief help message and exits.

=item B<--man>

Prints the manual page and exits.

=item B<--version>

Prints the version and exits.

=item B<-b>, B<--break-at-first-error>

Break checking at the first error and report back.
Default: false

=item B<-e>, B<--env-description>

Path to file which has the environment description.
Default: .envdesc

=item B<-x>, B<--exact>

Fail check if environment contains variables not defined in environment description.
This option will override the equivalent option in .envdesc file.
Default: false

=item B<-s>, B<--stdin>

Read environment description from STDIN, not from a file.
Incompatible with option B<--env-description>.
Default: false

=back

=head1 EXAMPLES

    $ envassert
    Environment Assert: ERRORS:
        variables:
            FIRST_VAR: Variable FIRST_VAR is missing from environment
            FOURTH_VAR: Variable FOURTH_VAR is missing from environment

=head2 Embedded In a Script

    #!/usr/bin/env sh
    # Ensure we have the required environment setup.
    envassert <<'EOF'
    NUMERIC_VAR=^[[:digit:]]+$
    TIME_VAR=^\d{2}:\d{2}:\d{2}$
    EOF
    echo "${NUMERIC_VAR}: ${TIME_VAR}"

=head1 DEPENDENCIES

No external dependencies outside Perl's standard distribution.

=head1 SEE ALSO

L<Env::Dot> is a "sister" to Env::Assert.
Read environment variables from a F<.env> file directly into you program.
There is also script F<envdot> which can turn F<.env> file's content
into environment variables for different shells.

=head1 AUTHOR

Mikko Koivunalho <mikkoi@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2023 by Mikko Koivunalho.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut