package Getopt::Long;
use strict;
BEGIN{require 5.004;
use Exporter();
use vars     qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
$VERSION     = "2.19";
@ISA=qw(Exporter);
@EXPORT=qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER);
%EXPORT_TAGS=qw();
@EXPORT_OK=qw();
use AutoLoader qw(AUTOLOAD);}use vars@EXPORT,@EXPORT_OK;
use vars qw($error $debug $major_version $minor_version);
use vars qw($autoabbrev $getopt_compat $ignorecase $bundling $order
  $passthrough);
use vars qw($genprefix);
sub Configure (@);
sub config (@);
sub GetOptions;
sub ConfigDefaults ();
sub FindOption ($$$$$$$);
sub Croak (@);
sub ConfigDefaults (){if(defined$ENV{"POSIXLY_CORRECT"}){$genprefix="(--|-)";
$autoabbrev=0;
$bundling=0;
$getopt_compat=0;
$order=$REQUIRE_ORDER;}else{$genprefix="(--|-|\\+)";
$autoabbrev=1;
$bundling=0;
$getopt_compat=1;
$order=$PERMUTE;}$debug=0;
$error=0;
$ignorecase=1;
$passthrough=0;}($REQUIRE_ORDER,$PERMUTE,$RETURN_IN_ORDER)=(0..2);
($major_version,$minor_version)=$VERSION=~/^(\d+)\.(\d+)/;
ConfigDefaults();
1;
__END__
sub GetOptions{my@optionlist=@_;
my$argend='--';
my%opctl=();
my%bopctl=();
my$pkg=(caller)[0];
my%aliases=();
my@ret=();
my%linkage;
my$userlinkage;
my$opt;
my$genprefix=$genprefix;
my@opctl;
$error='';
print STDERR("GetOpt::Long $Getopt::Long::VERSION ","called from package \"$pkg\".","\n  ",'GetOptionsAl $Revision: 2.20 $ ',"\n  ","ARGV: (@ARGV)","\n  ","autoabbrev=$autoabbrev,"."bundling=$bundling,","getopt_compat=$getopt_compat,","order=$order,","\n  ","ignorecase=$ignorecase,","passthrough=$passthrough,","genprefix=\"$genprefix\".","\n")if$debug;
$userlinkage=undef;
if(ref($optionlist[0])and"$optionlist[0]"=~/^(?:.*\=)?HASH\([^\(]*\)$/){$userlinkage=shift(@optionlist);
print STDERR("=> user linkage: $userlinkage\n")if$debug;}if($optionlist[0]=~/^\W+$/){$genprefix=shift(@optionlist);
$genprefix=~s/(\W)/\\$1/g;
$genprefix="([".$genprefix."])";}%opctl=();
%bopctl=();
while(@optionlist>0){my$opt=shift(@optionlist);
$opt=$+if$opt=~/^$genprefix+(.*)$/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";
next;}$linkage{'<>'}=shift(@optionlist);
next;}if($opt!~/^((\w+[-\w]*)(\|(\?|\w[-\w]*)?)*)?([!~+]|[=:][infse][@%]?)?$/){$error.="Error in option spec: \"$opt\"\n";
next;}my($o,$c,$a)=($1,$5);
$c='' unless defined$c;
if(!defined$o){$opctl{$o=''}=$c;}else{my@o=split(/\|/,$o);
my$linko=$o=$o[0];
$a=$o unless$o eq lc($o);
$o=lc($o)if$ignorecase>1||($ignorecase&&($bundling?length($o)>1:1));
foreach(@o){if($bundling&&length($_)==1){$_=lc($_)if$ignorecase>1;
if($c eq '!'){$opctl{"no$_"}=$c;
warn("Ignoring '!' modifier for short option $_\n");
$c='';}$opctl{$_}=$bopctl{$_}=$c;}else{$_=lc($_)if$ignorecase;
if($c eq '!'){$opctl{"no$_"}=$c;
$c='';}$opctl{$_}=$c;}if(defined$a){$aliases{$_}=$a;}else{$a=$_;}}$o=$linko;}if(defined$userlinkage){unless(@optionlist>0&&ref($optionlist[0])){if(exists$userlinkage->{$o}&&ref($userlinkage->{$o})){print STDERR("=> found userlinkage for \"$o\": ","$userlinkage->{$o}\n")if$debug;
unshift(@optionlist,$userlinkage->{$o});}else{next;}}}if(@optionlist>0&&ref($optionlist[0])){print STDERR("=> link \"$o\" to $optionlist[0]\n")if$debug;
if(ref($optionlist[0])=~/^(SCALAR|CODE)$/){$linkage{$o}=shift(@optionlist);}elsif(ref($optionlist[0])=~/^(ARRAY)$/){$linkage{$o}=shift(@optionlist);
$opctl{$o}.='@' if$opctl{$o}ne '' and$opctl{$o}!~/\@$/;
$bopctl{$o}.='@' if$bundling and defined$bopctl{$o}and$bopctl{$o}ne '' and$bopctl{$o}!~/\@$/;}elsif(ref($optionlist[0])=~/^(HASH)$/){$linkage{$o}=shift(@optionlist);
$opctl{$o}.='%' if$opctl{$o}ne '' and$opctl{$o}!~/\%$/;
$bopctl{$o}.='%' if$bundling and defined$bopctl{$o}and$bopctl{$o}ne '' and$bopctl{$o}!~/\%$/;}else{$error.="Invalid option linkage for \"$opt\"\n";}}else{my$ov=$o;
$ov=~s/\W/_/g;
if($c=~/@/){print STDERR("=> link \"$o\" to \@$pkg","::opt_$ov\n")if$debug;
eval("\$linkage{\$o} = \\\@".$pkg."::opt_$ov;");}elsif($c=~/%/){print STDERR("=> link \"$o\" to \%$pkg","::opt_$ov\n")if$debug;
eval("\$linkage{\$o} = \\\%".$pkg."::opt_$ov;");}else{print STDERR("=> link \"$o\" to \$$pkg","::opt_$ov\n")if$debug;
eval("\$linkage{\$o} = \\\$".$pkg."::opt_$ov;");}}}die($error)if$error;
$error=0;
@opctl=sort(keys(%opctl))if$autoabbrev;
if($debug){my($arrow,$k,$v);
$arrow="=> ";
while(($k,$v)=each(%opctl)){print STDERR($arrow,"\$opctl{\"$k\"} = \"$v\"\n");
$arrow="   ";}$arrow="=> ";
while(($k,$v)=each(%bopctl)){print STDERR($arrow,"\$bopctl{\"$k\"} = \"$v\"\n");
$arrow="   ";}}while(@ARGV>0){$opt=shift(@ARGV);
print STDERR("=> option \"",$opt,"\"\n")if$debug;
if($opt eq$argend){unshift(@ARGV,@ret)if$order==$PERMUTE;
return($error==0);}my$tryopt=$opt;
my$found;
my$dsttype;
my$incr;
my$key;
my$arg;
($found,$opt,$arg,$dsttype,$incr,$key)=FindOption($genprefix,$argend,$opt,\%opctl,\%bopctl,\@opctl,\%aliases);
if($found){next unless defined$opt;
if(defined$arg){$opt=$aliases{$opt}if defined$aliases{$opt};
if(defined$linkage{$opt}){print STDERR("=> ref(\$L{$opt}) -> ",ref($linkage{$opt}),"\n")if$debug;
if(ref($linkage{$opt})eq 'SCALAR'){if($incr){print STDERR("=> \$\$L{$opt} += \"$arg\"\n")if$debug;
if(defined${$linkage{$opt}}){${$linkage{$opt}}+=$arg;}else{${$linkage{$opt}}=$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\", \"$arg\")\n")if$debug;
&{$linkage{$opt}}($opt,$arg);}else{print STDERR("Invalid REF type \"",ref($linkage{$opt}),"\" in linkage\n");
Croak("Getopt::Long -- internal error!\n");}}elsif($dsttype eq '@'){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($dsttype eq '%'){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($incr){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;}}}}elsif($order==$PERMUTE){my$cb;
if((defined($cb=$linkage{'<>'}))){&$cb($tryopt);}else{print STDERR("=> saving \"$tryopt\" ","(not an option, may permute)\n")if$debug;
push(@ret,$tryopt);}next;}else{unshift(@ARGV,$tryopt);
return($error==0);}}if($order==$PERMUTE){print STDERR("=> restoring \"",join('" "',@ret),"\"\n")if$debug&&@ret>0;
unshift(@ARGV,@ret)if@ret>0;}return($error==0);}sub FindOption ($$$$$$$){my($prefix,$argend,$opt,$opctl,$bopctl,$names,$aliases)=@_;
my$key;
my$arg;
print STDERR("=> find \"$opt\", prefix=\"$prefix\"\n")if$debug;
return(0)unless$opt=~/^$prefix(.*)$/s;
$opt=$+;
my($starter)=$1;
print STDERR("=> split \"$starter\"+\"$opt\"\n")if$debug;
my$optarg=undef;
my$rest=undef;
if(($starter eq"--"||($getopt_compat&&!$bundling))&&$opt=~/^([^=]+)=(.*)$/s){$opt=$1;
$optarg=$2;
print STDERR("=> option \"",$opt,"\", optarg = \"$optarg\"\n")if$debug;}my$tryopt=$opt;
my$optbl=$opctl;
my$type;
my$dsttype='';
my$incr=0;
if($bundling&&$starter eq '-'){$rest=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 '';
$optbl=$bopctl;
if($bundling==2 and defined($rest)and defined($type=$opctl->{$tryopt.$rest})){print STDERR("=> $starter$tryopt rebundled to ","$starter$tryopt$rest\n")if$debug;
$tryopt.=$rest;
undef$rest;}}elsif($autoabbrev){$tryopt=$opt=lc($opt)if$ignorecase;
my$pat=quotemeta($opt);
my@hits=grep (/^$pat/,@{$names});
print STDERR("=> ",scalar(@hits)," hits (@hits) with \"$pat\" ","out of ",scalar(@{$names}),"\n")if$debug;
unless((@hits<=1)||(grep ($_ eq$opt,@hits)==1)){my%hit;
foreach(@hits){$_=$aliases->{$_}if defined$aliases->{$_};
$hit{$_}=1;}unless(keys(%hit)==1){return(0)if$passthrough;
warn("Option ",$opt," is ambiguous (",join(", ",@hits),")\n");
$error++;
undef$opt;
return(1,$opt,$arg,$dsttype,$incr,$key);}@hits=keys(%hit);}if(@hits==1&&$hits[0]ne$opt){$tryopt=$hits[0];
$tryopt=lc($tryopt)if$ignorecase;
print STDERR("=> option \"$opt\" -> \"$tryopt\"\n")if$debug;}}elsif($ignorecase){$tryopt=lc($opt);}$type=$optbl->{$tryopt}unless defined$type;
unless(defined$type){return(0)if$passthrough;
warn("Unknown option: ",$opt,"\n");
$error++;
return(1,$opt,$arg,$dsttype,$incr,$key);}$opt=$tryopt;
print STDERR("=> found \"$type\" for ",$opt,"\n")if$debug;
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;}elsif($type eq ''||$type eq '+'){$arg=1;
$incr=$type eq '+';}else{substr($opt,0,2)='';
$arg=0;}unshift(@ARGV,$starter.$rest)if defined$rest;
return(1,$opt,$arg,$dsttype,$incr,$key);}my$mand;
($mand,$type,$dsttype,$key)=$type=~/^(.)(.)([@%]?)$/;
if(defined$optarg?($optarg eq ''):!(defined$rest||@ARGV>0)){if($mand eq"="){return(0)if$passthrough;
warn("Option ",$opt," requires an argument\n");
$error++;
undef$opt;}if($mand eq":"){$arg=$type eq"s"?'':0;}return(1,$opt,$arg,$dsttype,$incr,$key);}$arg=(defined$rest?$rest:(defined$optarg?$optarg:shift(@ARGV)));
$key=undef;
if($dsttype eq '%'&&defined$arg){($key,$arg)=($arg=~/^(.*)=(.*)$/s)?($1,$2):($arg,1);}if($type eq"s"){return(1,$opt,$arg,$dsttype,$incr,$key)if$mand eq"=";
return(1,$opt,$arg,$dsttype,$incr,$key)if defined$optarg||defined$rest;
return(1,$opt,$arg,$dsttype,$incr,$key)if$arg eq"-";
if($arg eq$argend||$arg=~/^$prefix.+/){unshift(@ARGV,$arg);
$arg='';}}elsif($type eq"n"||$type eq"i"){if($bundling&&defined$rest&&$rest=~/^(-?[0-9]+)(.*)$/s){$arg=$1;
$rest=$2;
unshift(@ARGV,$starter.$rest)if defined$rest&&$rest ne '';}elsif($arg!~/^-?[0-9]+$/){if(defined$optarg||$mand eq"="){if($passthrough){unshift(@ARGV,defined$rest?$starter.$rest:$arg)unless defined$optarg;
return(0);}warn("Value \"",$arg,"\" invalid for option ",$opt," (number expected)\n");
$error++;
undef$opt;
unshift(@ARGV,$starter.$rest)if defined$rest;}else{unshift(@ARGV,defined$rest?$starter.$rest:$arg);
$arg=0;}}}elsif($type eq"f"){if($bundling&&defined$rest&&$rest=~/^(-?[0-9]+(\.[0-9]+)?([eE]-?[0-9]+)?)(.*)$/s){$arg=$1;
$rest=$+;
unshift(@ARGV,$starter.$rest)if defined$rest&&$rest ne '';}elsif($arg!~/^-?[0-9.]+(\.[0-9]+)?([eE]-?[0-9]+)?$/){if(defined$optarg||$mand eq"="){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++;
undef$opt;
unshift(@ARGV,$starter.$rest)if defined$rest;}else{unshift(@ARGV,defined$rest?$starter.$rest:$arg);
$arg=0.0;}}}else{Croak("GetOpt::Long internal error (Can't happen)\n");}return(1,$opt,$arg,$dsttype,$incr,$key);}sub Configure (@){my(@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'){ConfigDefaults()if$action;}elsif($try eq 'auto_abbrev' or$try eq 'autoabbrev'){$autoabbrev=$action;}elsif($try eq 'getopt_compat'){$getopt_compat=$action;}elsif($try eq 'ignorecase' or$try eq 'ignore_case'){$ignorecase=$action;}elsif($try eq 'ignore_case_always'){$ignorecase=$action?2:0;}elsif($try eq 'bundling'){$bundling=$action;}elsif($try eq 'bundling_override'){$bundling=$action?2:0;}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=(.+)$/){$genprefix=$1;
$genprefix="(".quotemeta($genprefix).")";
eval{''=~/$genprefix/;};
Croak("Getopt::Long: invalid pattern \"$genprefix\"")if$@;}elsif($try=~/^prefix_pattern=(.+)$/){$genprefix=$1;
$genprefix="(".$genprefix.")" unless$genprefix=~/^\(.*\)$/;
eval{''=~/$genprefix/;};
Croak("Getopt::Long: invalid pattern \"$genprefix\"")if$@;}elsif($try eq 'debug'){$debug=$action;}else{Croak("Getopt::Long: unknown config parameter \"$opt\"")}}}sub config (@){Configure(@_);}sub Croak (@){require 'Carp.pm';
$Carp::CarpLevel=1;
Carp::croak(@_);};
