diff options
| author | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
|---|---|---|
| committer | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
| commit | e0c6872cf40896c7be36b11dcc744620f10adf1d (patch) | |
| tree | 60335e10d2f4354b0674ec22d7b53f0f8abee672 /support/easylatex/Getopt | |
Initial commit
Diffstat (limited to 'support/easylatex/Getopt')
| -rw-r--r-- | support/easylatex/Getopt/Declare.pm | 3189 |
1 files changed, 3189 insertions, 0 deletions
diff --git a/support/easylatex/Getopt/Declare.pm b/support/easylatex/Getopt/Declare.pm new file mode 100644 index 0000000000..df2f6afd70 --- /dev/null +++ b/support/easylatex/Getopt/Declare.pm @@ -0,0 +1,3189 @@ +package Getopt::Declare; + +use strict; +use vars qw($VERSION); +use UNIVERSAL qw(isa); + +$VERSION = '1.09'; + + +package Getopt::Declare::StartOpt; + +sub new { bless {} } +sub matcher { '(?:()' } +sub code { '' } +sub cachecode { '' } +sub trailer { undef } +sub ows { return $_[1]; } + +package Getopt::Declare::EndOpt; + +sub new { bless {} } +sub matcher { '())?' } +sub code { '' } +sub cachecode { '' } +sub trailer { undef } +sub ows { return $_[1]; } + +package Getopt::Declare::ScalarArg; + +my %stdtype = (); + +sub _reset_stdtype +{ + %stdtype = + ( + ':i' => { pattern => '(?:(?:%T[+-]?)%D+)' }, + ':n' => { pattern => '(?:(?:%T[+-]?)(?:%D+(?:%T\.%D*)?(?:%T[eE]%D+)?' + . '|%T\.%D+(?:%T[eE]%D+)?))' }, + ':s' => { pattern => '(?:%T(?:\S|\0))+' }, + ':qs' => { pattern => q{"(?:\\"|[^"])*"|'(?:\\'|[^"])*|(?:%T(?:\S|\0))+} }, + ':id' => { pattern => '%T[a-zA-Z_](?:%T\w)*' }, + ':if' => { pattern => '%F(?:%T(?:\S|\0))+', + action => '{reject(!defined $_VAL_ || $_VAL_ ne "-" && ! -r $_VAL_, "in parameter \'$_PARAM_\' (file \"$_VAL_\" is not readable)")}' }, + ':of' => { pattern => '%F(?:%T(?:\S|\0))+', + action => '{reject (!defined $_VAL_ || $_VAL_ ne "-" && -e $_VAL_ && ! -w $_VAL_ , "in parameter \'$_PARAM_\' (file \"$_VAL_\" is not writable)")}' }, + '' => { pattern => ':s', ind => 1 }, + + ':+i' => { pattern => ':i', + action => '{reject (!defined $_VAL_ || $_VAL_<=0, "in parameter \'$_PARAM_\' ($_VAR_ must be an integer greater than zero)")}', + ind => 1}, + + ':+n' => { pattern => ':n', + action => '{reject (!defined $_VAL_ || $_VAL_<=0, "in parameter \'$_PARAM_\' ($_VAR_ must be a number greater than zero)")}', + ind => 1}, + + ':0+i' => { pattern => ':i', + action => '{reject (!defined $_VAL_ || $_VAL_<0, "in parameter \'$_PARAM_\' ($_VAR_ must be an positive integer)")}', + ind => 1}, + + ':0+n' => { pattern => ':n', + action => '{reject (!defined $_VAL_ || $_VAL_<0, "in parameter \'$_PARAM_\' ($_VAR_ must be a positive number)")}', + ind => 1}, + + ); +} + +sub stdtype # ($typename) +{ + my $name = shift; + my %seen = (); + while (!$seen{$name} && $stdtype{$name} && $stdtype{$name}->{ind}) + { $seen{$name} = 1; $name = $stdtype{$name}->{pattern} } + + return undef if $seen{$name} || !$stdtype{$name}; + return $stdtype{$name}->{pattern}; +} + +sub stdactions # ($typename) +{ + my $name = shift; + my %seen = (); + my @actions = (); + while (!$seen{$name} && $stdtype{$name} && $stdtype{$name}->{ind}) + { + $seen{$name} = 1; + push @actions, $stdtype{$name}->{action} + if $stdtype{$name}->{action}; + $name = $stdtype{$name}->{pattern} + } + push @actions, $stdtype{$name}->{action} + if $stdtype{$name}->{action}; + + return @actions; +} + +sub addtype # ($abbrev, $pattern, $action, $ref) +{ + my $typeid = ":$_[0]"; + unless ($_[1] =~ /\S/) { $_[1] = ":s" , $_[3] = 1; } + $stdtype{$typeid} = {}; + $stdtype{$typeid}->{pattern} = "(?:$_[1])" if $_[1] && !$_[3]; + $stdtype{$typeid}->{pattern} = ":$_[1]" if $_[1] && $_[3]; + $stdtype{$typeid}->{action} = $_[2] if $_[2]; + $stdtype{$typeid}->{ind} = $_[3]; +} + +sub new # ($self, $name, $type, $nows) +{ + bless + { name => $_[1], + type => $_[2], + nows => $_[3], + }, ref($_[0])||$_[0]; +} + +sub matcher # ($self, $trailing) +{ + my ($self, $trailing) = @_; + #WAS: $trailing = $trailing ? '(?!\Q'.$trailing.'\E)' : ''; + $trailing = $trailing ? '(?!'.quotemeta($trailing).')' : ''; + my $stdtype = stdtype($self->{type}); + + if (!$stdtype && $self->{type} =~ m#\A:/([^/]+)/\Z#) { $stdtype = $1; } + if (!$stdtype) + { + die "Error: bad type in Getopt::Declare parameter variable specification near '<$self->{name}$self->{type}>'\n"; + } + $stdtype =~ s/\%D/(?:$trailing\\d)/g; + $stdtype =~ s/\%T/$trailing/g; + unless ($stdtype =~ s/\%F//) + { + $stdtype = Getopt::Declare::Arg::negflagpat().$stdtype; + } + return "(?:$stdtype)"; +} + +sub code # ($self, $pos, $package) +{ + my $code = ' + $_VAR_ = q|<' . $_[0]->{name} . '>|; + $_VAL_ = defined $' . ($_[1]+1) . '? $' . ($_[1]+1) . ': undef; + $_VAL_ =~ tr/\0/ / if $_VAL_;'; + + my @actions = stdactions($_[0]->{type}); + foreach ( @actions ) + { + s/(\s*\{)/$1 package $_[2]; /; + $code .= "\n\t\tdo $_;"; + } + + $code .= ' + my $' . $_[0]->{name} . ' = $_VAL_;'; + + return $code; +} + +sub cachecode # ($self, $ownerflag, $itemcount) +{ + return "\t\t\$self->{'$_[1]'}{'<$_[0]->{name}>'} = \$$_[0]->{name};\n" + if $_[2] > 1; + return "\t\t\$self->{'$_[1]'} = \$$_[0]->{name};\n"; +} + +sub trailer { '' }; # MEANS TRAILING PARAMETER VARIABLE + +sub ows +{ + return '(?:\s|\0)*('.$_[1].')' unless $_[0]->{nows}; + return '('.$_[1].')'; +} + + +package Getopt::Declare::ArrayArg; + +use vars qw { @ISA }; +@ISA = qw ( Getopt::Declare::ScalarArg ); + +sub matcher # ($self, $trailing) +{ + my ($self, $trailing) = @_; + my $suffix = (defined $trailing && !$trailing) ? '\s+' : ''; + my $scalar = $self->SUPER::matcher($trailing); + + return $scalar.'(?:\s+'.$scalar.')*'.$suffix; +} + +sub code # ($self, $pos, $package) +{ + my $code = ' + $_VAR_ = q|<' . $_[0]->{name} . '>|; + $_VAL_ = undef; + my @' . $_[0]->{name} . ' = + map { tr/\0/ /; $_ } split " ", $'.($_[1]+1)."||'';\n"; + + + my @actions = Getopt::Declare::ScalarArg::stdactions($_[0]->{type}); + if (@actions) + { + $code .= ' + foreach $_VAL_ ( @' . $_[0]->{name} . ' ) + {'; + foreach ( @actions ) + { + s/(\s*\{)/$1 package $_[2]; /; + $code .= "\t\t\tdo $_;\n"; + } + $code .= ' + }'; + } + return $code; +} + +sub cachecode # ($self, $ownerflag, $itemcount) +{ + return "\t\t\$self->{'$_[1]'}{'<$_[0]->{name}>'} = [] + unless \$self->{'$_[1]'}{'<$_[0]->{name}>'}; + push \@{\$self->{'$_[1]'}{'<$_[0]->{name}>'}}, \@$_[0]->{name};\n" + if $_[2] > 1; + return "\t\t\$self->{'$_[1]'} = [] + unless \$self->{'$_[1]'}; + push \@{\$self->{'$_[1]'}}, \@$_[0]->{name};\n"; +} + + +package Getopt::Declare::Punctuator; + +sub new # ($self, $text, $nows) +{ + bless { text => $_[1], nows => $_[2] } +} + +sub matcher # ($self, $trailing) +{ + #WAS: Getopt::Declare::Arg::negflagpat() . '\Q' . $_[0]->{text} . '\E'; + Getopt::Declare::Arg::negflagpat() . quotemeta($_[0]->{text}); +} + +sub code # ($self, $pos) +{ + " + \$_PUNCT_{'" . $_[0]->{text} . "'" . '} = $' . ($_[1]+1) . ";\n"; +} + +sub cachecode # ($self, $ownerflag, $itemcount) +{ + return "\t\t\$self->{'$_[1]'}{'$_[0]->{text}'} = \$_PUNCT_{'$_[0]->{text}'};\n" + if $_[2] > 1; + return "\t\t\$self->{'$_[1]'} = \$_PUNCT_{'$_[0]->{text}'};\n"; +} + +sub trailer { $_[0]->{text} }; + +sub ows +{ + return '(?:\s|\0)*('.$_[1].')' unless $_[0]->{nows}; + return '('.$_[1].')'; +} + + +package Getopt::Declare::Arg; + +use Text::Balanced qw( extract_bracketed ); + +my $nextID = 0; + +my @helpcmd = qw( -help --help -Help --Help -HELP --HELP -h -H ); +my %helpcmd = map { $_ => 1 } @helpcmd; + +sub besthelp { foreach ( @helpcmd ) { return $_ if exists $helpcmd{$_}; } } +sub helppat { return join '|', keys %helpcmd; } + +my @versioncmd = qw( -version --version -Version --Version + -VERSION --VERSION -v -V ); +my %versioncmd = map { $_ => 1 } @versioncmd; + +sub bestversion {foreach (@versioncmd) { return $_ if exists $versioncmd{$_}; }} +sub versionpat { return join '|', keys %versioncmd; } + +my @flags; +my $posflagpat = ''; +my $negflagpat = ''; +sub negflagpat +{ + $negflagpat = join '', map { "(?!".quotemeta($_).")" } @flags + if !$negflagpat && @flags; + return $negflagpat; +} + +sub posflagpat +{ + $posflagpat = '(?:'.join('|', map { quotemeta($_) } @flags).')' + if !$posflagpat && @flags; + return $posflagpat; +} + +sub new # ($class, $spec, $desc, $dittoflag) +{ + my ($class,$spec,$desc,$ditto) = @_; + my $first = 1; + my $arg; + my $nows; + + my $self = + { + flag => '', + args => [], + actions => [], + ditto => $ditto, + required => 0, + requires => '', + ID => $nextID++, + desc => $spec, + items => 0, + }; + + $self->{desc} =~ s/\A\s*(.*?)\s*\Z/$1/; + + while ($spec) + { + # OPTIONAL + if ($spec =~ s/\A(\s*)\[/$1/) + { + push @{$self->{args}}, new Getopt::Declare::StartOpt; + next; + } + elsif ($spec =~ s/\A\s*\]//) + { + push @{$self->{args}}, new Getopt::Declare::EndOpt; + next; + } + + # ARG + + ($arg,$spec,$nows) = extract_bracketed($spec,'<>'); + if ($arg) + { + $arg =~ m/\A(\s*)(<)([a-zA-Z]\w*)(:[^>]+|)>/ or + die "Error: bad Getopt::Declare parameter variable specification near '$arg'\n"; + + my @details = ( $3, $4, !$first && !length($nows) ); # NAME,TYPE,NOWS + + if ($spec =~ s/\A\.\.\.//) # ARRAY ARG + { + push @{$self->{args}}, + new Getopt::Declare::ArrayArg (@details); + } + else # SCALAR ARG + { + push @{$self->{args}}, + new Getopt::Declare::ScalarArg (@details); + } + $self->{items}++; + next; + } + + # PUNCTUATION + + elsif ( $spec =~ s/\A(\s*)((\\.|[^] \t\n[<])+)// ) + { + my ($ows, $punct) = ($1,$2); + $punct =~ s/\\(?!\\)(.)/$1/g; + if ($first) { $self->{flag} = $punct; push @flags, $punct; } + + else { push @{$self->{args}}, + new Getopt::Declare::Punctuator ($punct,!length($ows)); + $self->{items}++; } + + } + + else { last; } + + } + continue + { + $first = 0; + } + + delete $helpcmd{$self->{flag}} if exists $helpcmd{$self->{flag}}; + delete $versioncmd{$self->{flag}} if exists $versioncmd{$self->{flag}}; + + bless $self; +} + +sub code +{ + my ($self, $owner,$package) = @_; + + my $code = "\n"; + my $flag = $self->{flag}; + my $clump = $owner->{_internal}{clump}; + my $i = 0; + my $nocase = (Getopt::Declare::_nocase() || $self->{nocase} ? 'i' : ''); + + $code .= (!$self->{repeatable}) + ? q# param: while (!$_FOUND_{'# . $self->name . q#'}# + : q# param: while (1#; + + if ($flag && ($clump==1 && $flag !~ /\A[^a-z0-9]+[a-z0-9]\Z/i + || ($clump<3 && @{$self->{args}} ))) + { + $code .= q# && !$_lastprefix#; + } + + $code .= q#) + { + pos $_args = $_nextpos if defined $_args; + %_PUNCT_ = ();#; + + if ($flag) + { + #WAS: $_args =~ m/\G(?:\s|\0)*\Q# . $flag . q#\E/g# . $nocase + $code .= q# + + $_args && $_args =~ m/\G(?:\s|\0)*# . quotemeta($flag) . q#/g# . $nocase + . q# or last; + $_errormsg = q|incorrect specification of '# . $flag . q#' parameter| unless $_errormsg; + + #; + } + elsif ((Getopt::Declare::ScalarArg::stdtype($self->{args}[0]{type})||'') !~ /\%F/) + { + $code .= q# + + last if $_errormsg; + + #; + } + + $code .= q# + $_PARAM_ = '# . $self->name . q#'; + #; + my @trailer; + $#trailer = @{$self->{args}}; + for ($i=$#{$self->{args}} ; $i>0 ; $i-- ) + { + $trailer[$i-1] = $self->{args}[$i]->trailer(); + $trailer[$i-1] = $trailer[$i] unless defined $trailer[$i-1]; + } + + if (@{$self->{args}}) + { + $code .= ' + $_args && $_args =~ m/\G'; + + for ($i=0; $i < @{$self->{args}} ; $i++ ) + { + $code .= + $self->{args}[$i]->ows($self->{args}[$i]->matcher($trailer[$i])) + } + + $code .= '/gx' . $nocase . ' or last;' + } + + + for ($i=0; $i < @{$self->{args}} ; $i++ ) + { + $code .= $self->{args}[$i]->code($i,$package); #, $flag ???? + } + + if ($flag) + { + $code .= q# + if (exists $_invalid{'# . $flag . q#'}) + { + $_errormsg = q|parameter '# . $flag + . q#' not allowed with parameter '| + . $_invalid{'# . $flag . q#'} . q|'|; + last; + } + else + { + foreach (# + . ($owner->{_internal}{mutex}{$flag} + ? join(',', map {"'$_'"} @{$owner->{_internal}{mutex}{$flag}}) + : '()') + . q#) + { + $_invalid{$_} = '# . $flag . q#'; + } + } + # + } + + foreach my $action ( @{$self->{actions}} ) + { + $action =~ s{(\s*\{)} + { $1 package $package; }; + $code .= "\n\t\tdo " . $action . ";\n"; + } + + if ($flag && $self->{items}==0) + { + $code .= "\n\t\t\$self->{'$flag'} = '$flag';\n"; + } + foreach my $subarg ( @{$self->{args}} ) + { + $code .= $subarg->cachecode($self->name,$self->{items}); + } + + if ($flag =~ /\A([^a-z0-9]+)/i) { $code .= '$_lastprefix = "'.quotemeta($1).'";'."\n" } + else { $code .= '$_lastprefix = "";' } + + $code .= q# + $_FOUND_{'# . $self->name . q#'} = 1; + next arg if pos $_args; + $_nextpos = length $_args; + last arg; + } + + #; +} + +sub name +{ + my $self = shift; + return $self->{flag} || "<$self->{args}[0]{name}>"; +} + + +package Getopt::Declare; + +use Text::Balanced qw( :ALL ); +use Text::Tabs qw( expand ); + +# PREDEFINED GRAMMARS + +my %_predef_grammar = +( + "-PERL" => +q{ -<varname:id> Set $<varname> to 1 [repeatable] + { no strict "refs"; ${"::$varname"} = 1 } + +}, + + "-AWK" => +q{ <varname:id>=<val> Set $<varname> to <val> [repeatable] + {no strict "refs"; ${"::$varname"} = $val } + <varname:id>= Set $<varname> to '' [repeatable] + {no strict "refs"; ${"::$varname"} = '' } + +}, +); +my $_predef_grammar = join '|', keys %_predef_grammar; + +sub _quoteat +{ + my $text = shift; + $text =~ s/\A\@/\\\@/; + $text =~ s/([^\\])\@/$1\\\@/; + $text; +} + +sub new # ($self, $grammar; $source) +{ +# HANDLE SHORT-CIRCUITS + + return 0 if @_==3 && (!defined($_[2]) || $_[2] eq '-SKIP'); + +# SET-UP + + my ($_class, $_grammar) = @_; + +# PREDEFINED GRAMMAR? + + if ($_grammar =~ /\A(-[A-Z]+)+/) + { + my $predef = $_grammar; + my %seen = (); + $_grammar = ''; + $predef =~ s{($_predef_grammar)}{ do {$_grammar .= $_predef_grammar{$1} unless $seen{$1}; $seen{$1} = 1; ""} }ge; + return undef if $predef || !$_grammar; + } + +# PRESERVE ESCAPED '['s + + $_grammar =~ s/\\\[/\255/g; + +# MAKE SURE GRAMMAR ENDS WITH A NEWLINE + + $_grammar =~ s/([^\n])\Z/$1\n/; + +# SET-UP + + local $_ = $_grammar; + my @_args = (); + my $_mutex = {}; + my $_action; + my $_strict = 0; + my $_all_repeatable = 0; + my $_lastdesc = undef; + _nocase(0); + Getopt::Declare::ScalarArg::_reset_stdtype(); + +# CONSTRUCT GRAMMAR + + while (length $_ > 0) + { + # COMMENT: + s/\A[ ]*#.*\n// and next; + + # TYPE DIRECTIVE: + + #WAS: if (m/\A\s*\[pvtype:/ and $_action = extract_codeblock($_,'[{}]')) + if (m/\A\s*\[pvtype:/ and $_action = extract_codeblock($_,'[]')) + { + $_action =~ s/.*?\[pvtype:\s*//; + _typedef($_action); + next; + } + + # ACTION + if ($_action = extract_codeblock) + { + # WAS: eval q{no strict;my $ref = sub }._quoteat($_action).q{;1} + my $_check_action = $_action; + $_check_action =~ s{(\s*\{)} + { $1 sub defer(&); sub finish(;\$); sub reject(;\$\$); }; + eval q{no strict;my $ref = sub }.$_check_action.q{;1} + or die "Error: bad action in Getopt::Declare specification:" + . "\n\n$_action\n\n$@\n"; + if ($#_args < 0) + { + die "Error: unattached action in Getopt::Declare specification:\n$_action\n" + . "\t(did you forget the tab after the preceding parameter specification?)\n" + } + push @{$_args[$#_args]->{actions}}, $_action; + next; + } + elsif (m/\A(\s*[{].*)/) + { + die "Error: incomplete action in Getopt::Declare specification:\n$1.....\n" + . "\t(did you forget a closing '}'?)\n"; + } + + # ARG + DESC: + if ( s/\A(.*?\S.*?)(\t.*\n)// ) + { + my $spec = $1; + my $desc = $2; + my $ditto; + $_strict ||= $desc =~ /\Q[strict]/; + + $desc .= $1 while s/\A((?![ ]*({|\n)|.*?\S.*?\t.*?\S).*?\S.*\n)//; + + $_lastdesc and $desc =~ s/\A\s*\[ditto\]/$_lastdesc/ + and $ditto = 1; + $_lastdesc = $desc; + + my $arg = new Getopt::Declare::Arg($spec,$desc,$ditto) ; + push @_args, $arg; + + _infer($desc, $arg, $_mutex); + next; + } + + + # OTHERWISE: DECORATION + + s/((?:(?!\[pvtype:).)*)(\n|(?=\[pvtype:))//; + my $decorator = $1; + $_strict ||= $decorator =~ /\Q[strict]/; + _infer($decorator, undef, $_mutex); + $_all_repeatable = 1 if $decorator =~ /\[repeatable\]/; + } + + my $_lastactions; + foreach ( @_args ) + { + if ($_lastactions && $_->{ditto} && !@{$_->{actions}}) + { $_->{actions} = $_lastactions } + else + { $_lastactions = $_->{actions} } + + if ($_all_repeatable) + { + $_->{repeatable} = 1; + } + } + + @_args = sort + { + length($b->{flag}) <=> length($a->{flag}) + or + $b->{flag} eq $a->{flag} and $#{$b->{args}} <=> $#{$a->{args}} + or + $a->{ID} <=> $b->{ID} + + } @_args; + +# CONSTRUCT OBJECT ITSELF + + my $clump = ($_grammar =~ /\[cluster:\s*none\s*\]/i) ? 0 + : ($_grammar =~ /\[cluster:\s*singles?\s*\]/i) ? 1 + : ($_grammar =~ /\[cluster:\s*flags?\s*\]/i) ? 2 + : ($_grammar =~ /\[cluster:\s*any\s*\]/i) ? 3 + : ($_grammar =~ /\[cluster:(.*)\s*\]/i) ? + die "Error: unknown clustering mode: [cluster:$1]\n" + : 3; + + my $self = bless + { + _internal => + { + args => [@_args], + mutex => $_mutex, + usage => $_grammar, + helppat => Getopt::Declare::Arg::helppat(), + verspat => Getopt::Declare::Arg::versionpat(), + strict => $_strict, + clump => $clump, + source => '', + 'caller' => scalar caller(), + } + }, ref($_class)||$_class; + + +# VESTIGAL DEBUGGING CODE + + open (CODE, ">.CODE") + and print CODE $self->code($self->{_internal}{'caller'}) + and close CODE + if $::Declare_debug; + +# DO THE PARSE (IF APPROPRIATE) + + + if (@_==3) { return undef unless defined $self->parse($_[2]) } + else { return undef unless defined $self->parse(); } + + return $self; +} + +sub _get_nextline { scalar <> } + +sub _load_sources # ( \$_get_nextline, @files ) +{ + my $text = ''; + my @found = (); + my $gnlref = shift; + foreach ( @_ ) + { + open FILE, $_ or next; + if (-t FILE) + { + push @found, '<STDIN>'; + $$gnlref = \&_get_nextline; + } + else + { + push @found, $_; + $text .= join "\n", <FILE>; + } + } + return undef unless @found; + $text = <STDIN> unless $text; + return ( $text, join(" or ",@found)); +} + + +sub parse # ($self;$source) +{ + my ( $self, $source ) = @_; + my $_args = (); + my $_get_nextline = sub { undef }; + if (@_>1) + { + if (!defined $source) + { + return 0; + } + elsif (isa($source,'CODE')) + { + $_get_nextline = $source; + $_args = &{$_get_nextline}($self); + $source = '[SUB]'; + } + elsif (isa($source,'GLOB')) + { + if (-t *$source) + { + $_get_nextline = \&_get_nextline ; + $_args = <STDIN>; + $source = '<STDIN>'; + } + else + { + $_args = join ' ', (<$source>); + $_args =~ tr/\t\n/ /s; + $source = ref($source); + } + } + elsif (isa($source,'IO::Handle')) + { + if (!($source->fileno) && -t) + { + $_get_nextline = \&_get_nextline ; + $_args = <STDIN>; + $source = '<STDIN>'; + } + else + { + $_args = join ' ', (<$source>); + $_args =~ tr/\t\n/ /s; + $source = ref($source); + } + } + elsif (ref($source) eq 'ARRAY') + { + if (@$source == 1 && (!defined($source->[0]) + || $source->[0] eq '-BUILD' + || $source->[0] eq '-SKIP') ) + { + return 0; + } + elsif (@$source == 1 && $source->[0] eq '-STDIN') + { + $_get_nextline = \&_get_nextline ; + $_args = <STDIN>; + $source = '<STDIN>'; + } + elsif (@$source == 1 && $source->[0] eq '-CONFIG') + { + my $progname = "$0rc"; + $progname =~ s#.*/##; + ($_args,$source) = _load_sources(\$_get_nextline,"$ENV{HOME}/.$progname", ".$progname"); + } + else + { + my $stdin; + ($_args,$source) = _load_sources(\$_get_nextline,@$source); + } + } + else # LITERAL STRING TO PARSE + { + $_args = $source; + substr($source,7) = '...' if length($source)>7; + $source = "\"$source\""; + } + return 0 unless defined $_args; + $source = " (in $source)"; + } + else + { + foreach (@ARGV) { $_ =~ tr/ \t\n/\0\0\0/; } + $_args = join(' ', @ARGV); + $source = ''; + } + + $self->{_internal}{source} = $source; + + if (!eval $self->code($self->{_internal}{'caller'})) + { + die "Error: in generated parser code:\n$@\n" + if $@; + return undef; + } + + return 1; +} + +sub type # ($abbrev, $pattern, $action) +{ + &Getopt::Declare::ScalarArg::addtype; +} + +sub _enbool +{ + my $expr = shift; + $expr =~ s/\s*\|\|\s*/ or /g; + $expr =~ s/\s*&&\s*/ and /g; + $expr =~ s/\s*!\s*/ not /g; + return $expr; +} + +sub _enfound +{ + my $expr = shift; + my $original = $expr; + $expr =~ s/((?:&&|\|\|)?\s*(?:[!(]\s*)*)([^ \t\n|&\)]+)/$1\$_FOUND_{'$2'}/gx; + die "Error: bad condition in [requires: $original]\n" + unless eval 'no strict; my $ref = sub { '.$expr.' }; 1'; + return $expr; +} + +my $_nocase = 0; + +sub _nocase +{ + $_nocase = $_[0] if $_[0]; + return $_nocase; +} + +sub _infer # ($desc, $arg, $mutex) +{ + my ($desc, $arg, $mutex) = @_; + + _mutex($mutex, split(' ',$1)) + while $desc =~ s/\[mutex:\s*(.*?)\]//i; + + if ( $desc =~ m/\[no\s*case\]/i) + { + if ($arg) { $arg->{nocase} = 1 } + else { _nocase(1); } + } + + if (defined $arg) + { + _exclude($mutex, $arg->name, (split(' ',$1))) + if $desc =~ m/.*\[excludes:\s*(.*?)\]/i; + $arg->{requires} = $1 + if $desc =~ m/.*\[requires:\s*(.*?)\]/i; + + $arg->{required} = ( $desc =~ m/\[required\]/i ); + $arg->{repeatable} = ( $desc =~ m/\[repeatable\]/i ); + } + + _typedef($desc) while $desc =~ s/.*?\[pvtype:\s*//; +} + +sub _typedef +{ + my $desc = $_[0]; + my ($name,$pat,$action,$ind); + + ($name,$desc) = (extract_quotelike($desc))[5,1]; + do { $desc =~ s/\A\s*([^] \t\n]+)// and $name = $1 } unless $name; + die "Error: bad type directive (missing type name): [pvtype: " + . substr($desc,0,index($desc,']')||20). "....\n" + unless $name; + + ($pat,$desc,$ind) = (extract_quotelike($desc,'\s*:?\s*'))[5,1,2]; + do { $desc =~ s/\A\s*(:?)\s*([^] \t\n]+)// + and $pat = $2 and $ind = $1 } unless $pat; + $pat = '' unless $pat; + + $action = extract_codeblock($desc) || ''; + die "Error: bad type directive (expected closing ']' but found" + . "'$1' instead): [pvtype: $name " . ($pat?"/$pat/":'') + . " $action $1$2....\n" if $desc =~ /\A\s*([^] \t\n])(\S*)/; + + Getopt::Declare::ScalarArg::addtype($name,$pat,$action,$ind=~/:/); +} + +sub _ditto # ($originalflag, $orginaldesc, $extra) +{ + my ($originalflag, $originaldesc, $extra) = @_; + if ($originaldesc =~ /\n.*\n/) + { + $originaldesc = "Same as $originalflag "; + } + else + { + chomp $originaldesc; + $originaldesc =~ s/\S/"/g; + 1 while $originaldesc =~ s/"("+)"/ $1 /g; + $originaldesc =~ s/""/" /g; + } + return "$originaldesc$extra\n"; +} + +sub _mutex # (\%mutex, @list) +{ + my ($mref, @mutexlist) = @_; + + foreach my $flag ( @mutexlist ) + { + $mref->{$flag} = [] unless $mref->{$flag}; + foreach my $otherflag ( @mutexlist ) + { + next if ($flag eq $otherflag); + push @{$mref->{$flag}}, $otherflag; + } + } +} + +sub _exclude # (\%mutex, $excluded, @list) +{ + my ($mref, $excluded, @mutexlist) = @_; + + foreach my $flag ( @mutexlist ) + { + unless ($flag eq $excluded) + { + $mref->{$flag} = [] unless $mref->{$flag}; + push @{$mref->{$excluded}}, $flag; + push @{$mref->{$flag}}, $excluded; + } + } +} + +sub version +{ + # my $filedate = localtime(time - 86400 * -M $0); + my $filedate = localtime((stat $0)[9]); + if ($::VERSION) { print "\n\t$0: version $::VERSION ($filedate)\n\n" } + else { print "\n\t$0: version dated $filedate\n\n" } + exit $_[1] if defined $_[1]; +} + +sub usage +{ + my $self = $_[0]; + local $_ = $self->{_internal}{usage}; + + my $lastflag = undef; + my $lastdesc = undef; + + my $usage = ''; + my $uoff; + my $decfirst; + my $ditto; + + while (length $_ > 0) + { + # COMMENT: + s/\A[ ]*#.*\n// and next; + + # TYPE DIRECTIVE: + + if (m/\A\s*\[pvtype:/ and extract_codeblock($_,'[{}]')) + { + next; + } + + # ACTION + extract_codeblock + and do { s/\A[ ]*\n//; + $decfirst = 0 unless defined $decfirst; + next; }; + + # ARG + DESC: + if ( s/\A(.*?\S.*?\t+)(.*?\n)// ) + { + $decfirst = 0 unless defined $decfirst; + + my ($spec) = expand $1; + my ($desc) = expand $2; + + $desc .= (expand $1)[0] + while s/\A((?![ ]*({|\n)|.*?\S.*?\t.*?\S).*?\S.*\n)//; + + next if $desc =~ /\[undocumented\]/i; + + $uoff = 0; + $spec =~ s/(<[a-zA-Z]\w*):([^>]+)>/$uoff+=1+length $2 and "$1>"/ge; + $ditto = $desc =~ /\A\s*\[ditto\]/; + $desc =~ s/^\s*\[.*?\]\s*\n//gm; + $desc =~ s/\[.*?\]//g; + + if ($ditto) + { $desc = ($lastdesc? _ditto($lastflag,$lastdesc,$desc) : "" ) } + elsif ($desc =~ /\A\s*\Z/) + { next; } + else + { $lastdesc = $desc; } + $spec =~ /\A\s*(\S+)/ and $lastflag = $1; + + $usage .= $spec . ' ' x $uoff . $desc; + + next; + }; + + + # OTHERWISE, DECORATION + if (s/((?:(?!\[pvtype:).)*)(\n|(?=\[pvtype:))//) + { + my $desc = $1.($2||''); + $desc =~ s/^(\s*\[.*?\])+\s*\n//gm; + $desc =~ s/\[.*?\]//g; + $decfirst = 1 unless defined $decfirst + or $desc =~ m/\A\s*\Z/; + $usage .= $desc; + } + } + + my $required = ''; + + foreach my $arg ( @{$self->{_internal}{args}} ) + { + if ($arg->{required}) + { + $required .= ' ' . $arg->{desc} . ' '; + } + } + + $usage =~ s/\255/[/g; # REINSTATE ESCAPED '['s + + $required =~ s/<([a-zA-Z]\w*):[^>]+>/<$1>/g; + + my $helpcmd = Getopt::Declare::Arg::besthelp; + my $versioncmd = Getopt::Declare::Arg::bestversion; + + my $PAGER = \*STDOUT; + + if (eval { require IO::Pager }) + { + $PAGER = new IO::Pager ( resume => 1 ); + } + + unless ($self->{_internal}{source}) + { + print $PAGER "\nUsage: $0 [options] $required\n"; + print $PAGER " $0 $helpcmd\n" if $helpcmd; + print $PAGER " $0 $versioncmd\n" if $versioncmd; + print $PAGER "\n" unless $decfirst && $usage =~ /\A[ \t]*\n/; + } + print $PAGER "Options:\n" unless $decfirst; + print $PAGER $usage; + + exit $_[1] if defined $_[1]; +} + +sub unused { + return @{$_[0]->{_internal}{unused}} if wantarray; + return join " ", @{$_[0]->{_internal}{unused}}; +} + +sub flatten { + my ($val, $nested) = @_; + if (ref $val eq 'ARRAY') { + return join " ", map {flatten($_,1)} @$val; + } + elsif (ref $val eq 'HASH') { + return join " ", map { + $nested || /^-/ ? ($_, flatten($val->{$_},1)) + : (flatten($val->{$_},1)) + } keys %$val; + } + else { + return $val; + } +} + +sub used { + my $self = shift; + my @used = map { /^_/ ? () : ($_, $self->{$_}) } keys %$self; + return @used if wantarray; + return join " ", map { flatten $_ } @used; +} + +sub code +{ + my $self = shift; + my $package = shift||'main'; + my $code = q# + + do + { + my @_deferred = (); + my @_unused = (); + sub # . $package . q#::defer (&); + { + package # . $package . q#; local $^W; + *defer = sub (&) { push @_deferred, $_[0]; } + } + my %_FOUND_ = (); + my $_errors = 0; + my $_nextpos; + my %_invalid = (); + my $_lastprefix = ''; + my $_finished = 0; + my %_PUNCT_; + my $_errormsg; + my $_VAL_; + my $_VAR_; + my $_PARAM_; + + sub # . $package . q#::reject (;$$); + sub # . $package . q#::finish (;$); + + { + package # . $package . q#; local $^W; + *reject = sub (;$$) { local $^W; if (!@_ || $_[0]) { $_errormsg = $_[1] if defined $_[1]; last param; } }; + *finish = sub (;$) { if (!@_ || $_[0]) { $_finished = 1; } }; + } + + $_nextpos = 0; + arg: while (!$_finished) + { + $_errormsg = ''; + # . ( $self->{_internal}{clump} ? q# + while ($_lastprefix) + { + my $substr = substr($_args,$_nextpos); + $substr =~ m/\A(?!\s|\0|\Z)# + . Getopt::Declare::Arg::negflagpat() . q#/ + or do { $_lastprefix='';last}; + "$_lastprefix$substr" =~ m/\A(# + . Getopt::Declare::Arg::posflagpat() + . q#)/ + or do { $_lastprefix='';last}; + substr($_args,$_nextpos,0) = $_lastprefix; + last; + } + # : '') . q# + pos $_args = $_nextpos if defined $_args; + + $self->usage(0) if $_args && $_args =~ m/\G(# . $self->{_internal}{helppat} . q#)(\s|\0|\Z)/g; + $self->version(0) if $_args && $_args =~ m/(# . $self->{_internal}{verspat} . q#)(\s|\0|\Z)/; + + #; + + foreach my $arg ( @{$self->{_internal}{args}} ) + { + $code .= $arg->code($self,$package); + } + + $code .= q# + + if ($_lastprefix) + { + pos $_args = $_nextpos+length($_lastprefix); + $_lastprefix = ''; + next; + } + + pos $_args = $_nextpos; + $_args && $_args =~ m/\G(?:\s|\0)*(\S+)/g or last; + if ($_errormsg) { print STDERR "Error"."$self->{_internal}{source}: $_errormsg\n" } + + else { push @_unused, $1; } + $_errors++ if ($_errormsg); + } + continue + { + $_nextpos = pos $_args if defined $_args; + if (defined $_args and $_args =~ m/\G(\s|\0)*\Z/g) + { + $_args = &{$_get_nextline}($self); + last unless defined($_args); + $_nextpos = 0; + $_lastprefix = ''; + } + } + #; + + foreach my $arg ( @{$self->{_internal}{args}} ) + { + next unless $arg->{required}; + $code .= q# + do { print STDERR "Error"."$self->{_internal}{source}".': required parameter # . $arg->name . q# not found.',"\n"; $_errors++ } + unless $_FOUND_{'# . $arg->name . q#'}#; + if ($self->{_internal}{mutex}{$arg->name}) + { + foreach my $mutex (@{$self->{_internal}{mutex}{$arg->name}}) + { + $code .= q# or $_FOUND_{'# . $mutex . q#'}#; + } + } + $code .= ';'; + } + + foreach my $arg ( @{$self->{_internal}{args}} ) + { + if ($arg->{requires}) + { + $code .= q# + do { print STDERR q|Error|.$self->{_internal}{source}.q|: parameter '# . $arg->name + . q#' can only be specified with '# . _enbool($arg->{requires}) + . q#'|,"\n"; $_errors++ } + if $_FOUND_{'# . $arg->name . "'} && !(" . _enfound($arg->{requires}) . ');' + } + } + + $code .= q# + push @_unused, split(' ', substr($_args,$_nextpos)) + if $_args && $_nextpos && length($_args) >= $_nextpos; + #; + + if ($self->{_internal}{strict}) + { + $code .= q# + unless ($_nextpos < length($_args||'')) + { + foreach (@_unused) + { + tr/\0/ /; + print STDERR "Error"."$self->{_internal}{source}: unrecognizable argument ('$_')\n"; + $_errors++; + } + } + # + } + + $code .= q# + + if ($_errors && !$self->{_internal}{source}) + { + print STDERR "\n(try '$0 ".'# . Getopt::Declare::Arg::besthelp + . q#'."' for more information)\n"; + } + + $self->{_internal}{unused} = [map { tr/\0/ /; $_ } @_unused]; + @ARGV = @{$self->{_internal}{unused}} + unless $self->{_internal}{source}; + + unless ($_errors) { foreach (@_deferred) { &$_ } } + + !$_errors; + + } + #; +} + +1; +__END__ + +=head1 NAME + +Getopt::Declare - Declaratively Expressed Command-Line Arguments via Regular Expressions + +=head1 VERSION + +This document describes version 1.08 of Getopt::Declare, +released May 21, 1999. + +=head1 SYNOPSIS + + use Getopt::Declare; + + $args = new Getopt::Declare ($specification_string, $optional_source); + + +=head1 DESCRIPTION + +=head2 Overview + +F<Getopt::Declare> is I<yet another> command-line argument parser, +one which is specifically designed to be powerful but exceptionally +easy to use. + +To parse the command-line in C<@ARGV>, one simply creates a +F<Getopt::Declare> object, by passing C<Getopt::Declare::new()> a +specification of the various parameters that may be encountered: + + $args = new Getopt::Declare($specification); + +The specification is a single string such as this: + + $specification = q( + + -a Process all data + + -b <N:n> Set mean byte length threshold to <N> + { bytelen = $N; } + + +c <FILE> Create new file <FILE> + + --del Delete old file + { delold() } + + delete [ditto] + + e <H:i>x<W:i> Expand image to height <H> and width <W> + { expand($H,$W); } + + -F <file>... Process named file(s) + { defer {for (@file) {process()}} } + + =getrand [<N>] Get a random number + (or, optionally, <N> of them) + { $N = 1 unless defined $N; } + + -- Traditionally indicates end of arguments + { finish } + ); + +in which the syntax of each parameter is declared, along with a +description and (optionally) one or more actions to be performed when +the parameter is encountered. The specification string may also +include other usage formatting information (such as group headings or +separators) as well as standard Perl comments (which are ignored). + +Calling C<Getopt::Delare::new()> parses the contents of the array C<@ARGV>, +extracting any arguments which match the parameters defined in the +specification string, and storing the parsed values as hash elements +within the new F<Getopt::Declare> object being created. + +Other features of the F<Getopt::Declare> package include: + +=over 4 + +=item * + +The use of full Perl regular expressions to constrain matching +of parameter components. + +=item * + +Automatic generation of error, usage and version information. + +=item * + +Optional conditional execution of embedded actions (i.e. only on +successful parsing of the entire command-line) + +=item * + +Strict or non-strict parsing (unrecognized command-line elements may either +trigger an error or may simply be left in C<@ARGV>) + +=item * + +Declarative specification of various inter-parameter relationships (for +example, two parameters may be declared mutually exclusive and this +relationship will then be automatically enforced). + +=item * + +Intelligent clustering of adjacent flags (for example: the +command-line sequence "S<-a -b -c>" may be abbreviated to "-abc", unless +there is also a C<-abc> flag declared). + +=item * + +Selective or global case-insensitivity of parameters. + +=item * + +The ability to parse files (especially configuration files) instead of +the command-line. + +=back + +=head2 Terminology + +The terminology of command-line processing is often confusing, with various +terms (such as "argument", "parameter", "option", "flag", etc.) +frequently being used interchangeably and inconsistently in the various +F<Getopt::> packages available. In this documentation, the following +terms are used consistently: + +=over 4 + +=item "command-line" + +The space-separated concatenation of the elements of the array C<@ARGV> +at the time a F<Getopt::Declare> object is created. + +=item "parameter specification" (or just "parameter") + +A specification of a single entity which may appear in the +command-line. Always includes at least one syntax for the entity. +Optionally may include other (I<variant>) syntaxes, one or more +I<descriptions> of the entity, and/or I<actions> to be performed when +the entity is encountered. For example, the following is a single +parameter specification (with two variants): + + --window <height> x <width> Set window to <height> by <width> + { setwin($width,$height); } + + --window <h>x<w>@<x>,<y> Set window size and centroid + { setwin($w,$h,$x,$y); } + + +=item "argument" + +A substring of the command-line which matches a single parameter variant. +Unlike some other Getopt:: packages, in F<Getopt::Declare> an argument +may be a single element of C<@ARGV>, or part of a single C<@ARGV> element, +or the concatenation of several adjacent C<@ARGV> elements. + + +=item "parameter definition" + +A specification of one actual syntax variant matched by a parameter. Always +consists of a leading I<parameter flag> or I<parameter variable>, +optionally followed by one or more I<parameter components> (that is, +other parameter variables or I<punctuators>). In the above example, +C<S<--window E<lt>heightE<gt> x E<lt>widthE<gt>>> is a parameter definition. + + +=item "parameter flag" (or just "flag") + +A sequence of non-space characters which introduces a parameter. Traditionally +a parameter flag begins with "-" or "--", but F<Getopt::Declare> allows +almost any sequence of characters to be used as a flag. In the above example, +C<--window> is the parameter flag. + + +=item "parameter variable" + +A place-holder (within a parameter specification) for a value that +will appear in any argument matching that parameter. In the above example, +C<E<lt>heightE<gt>>, C<E<lt>widthE<gt>>, C<E<lt>hE<gt>>, C<E<lt>yE<gt>>, +C<E<lt>xE<gt>>, and C<E<lt>yE<gt>> are all parameter variables. + + +=item "parameter punctuator" (or just "punctuator") + +A literal sequence of characters (within a parameter specification) +which will appear in any argument matching that parameter. In the above +example, the literals C<x> and C<@> are punctuators. + + +=item "parameter description" + +A textual description of the purpose and/or use of a particular variant of +parameter. In the above examples, the string: + + Set window to <height> by <width> + +is a parameter description. + + +=item "parameter action" (or just "action") + +A block of Perl code to be executed in response to encountering a specific +parameter. In the above example: + + { setwin($width,$height); } + +is a parameter action. + +=item "parameter variants" + +One or more different syntaxes for a single parameter, all sharing +the same leading flag, but having different trailing parameter +variables and/or punctuators. F<Getopt::Declare> considers all parameter +definitions with the same leading flag to be merely variant forms of +a single "underlying" parameter. The above example shows two parameter +variants for the C<--window> parameter. + +=back + + +=head2 Parameter definitions + +As indicated above, a parameter specification consists of three +parts: the parameter definition, a textual description, and any +actions to be performed when the parameter is matched. + +The parameter definition consists of a leading flag or parameter +variable, followed by any number of parameter variables or +punctuators, optionally separated by spaces. The parameter definition +is terminated by one or more tabs (at least one trailing tab I<must> +be present). + +For example, all of the following are valid F<Getopt::Declare> parameter +definitions: + + -v + in=<infile> + +range <from>..<to> + --lines <start> - <stop> + ignore bad lines + <outfile> + +Note that each of the above examples has at least one trailing tab +(even if you can't see them). Note too that this hodge-podge of +parameter styles is certainly not recommended within a single program, +but is shown so as to illustrate some of the range of parameter syntax +conventions F<Getopt::Declare> supports. + +The spaces between components of the parameter definition are optional but +significant, both in the definition itself and in the arguments that +the definition may match. If there is no space between components in the +specification, then no space is allowed between corresponding arguments +on the command-line. If there I<is> space between components of the +specification, then space between those components is optional on the +command-line. + +For example, the C<--lines> parameter above matches: + + --lines1-10 + --lines 1-10 + --lines 1 -10 + --lines 1 - 10 + --lines1- 10 + +If it were instead specified as: + + --lines <start>-<stop> + +then it would match only: + + --lines1-10 + --lines 1-10 + +Note that the optional nature of spaces in parameter specification implies that +flags and punctuators cannot contain the character '<' (which is taken as the +delimiter for a parameter variable) nor the character '[' (which +introduces an optional parameter component - see +L<"Optional parameter components">). + + +=head2 Types of parameter variables + +By default, a parameter variable will match a single blank-terminated +or comma-delimited string. For example, the parameter: + + -val <value> + +would match any of the following the arguments: + + -value # <value> <- "ue" + -val abcd # <value> <- "abcd" + -val 1234 # <value> <- "1234" + -val "a value" # <value> <- "a value" + + +It is also possible to restrict the types of values which may be +matched by a given parameter variable. For example: + + -limit <threshold:n> Set threshold to some (real) value + -count <N:i> Set count to <N> (must be an integer) + +If a parameter variable is suffixed with ":n", it will match any +reasonable numeric value, whilst the ":i" suffix restricts a +parameter variable to only matching integer values. +These two "type specifiers" are the simplest examples of a much more +powerful mechanism, which allows parameter variables to be restricted +to matching any specific regular expression. See L<"Defining new +parameter variable types">. + +Parameter variables are treated as scalars by default, but this too +can be altered. Any parameter variable immediately followed by +an ellipsis (C<...>) is treated as a list variable, and matches its +specified type sequentially as many times as possible. For example, +the parameter specification: + + -pages <page:i>... + +would match either of the following arguments: + + -pages 1 + -pages 1 2 7 20 + +Note that both scalar and list parameter variables are "respectful" of the +flags of other parameters as well as their own trailing punctuators. +For example, given the specifications: + + -a + -b <b_list>... + -c <c_list>... ; + +The following arguments will be parsed as indicated: + + -b -d -e -a # <b_list> <- ("-d", "-e") + -b -d ; # <b_list> <- ("-d", ";") + -c -d ; # <c_list> <- ("-d") + +List parameter variables are also "repectful" of the needs of +subsequent parameter variables. That is, a parameter specification +like: + + -copy <files>... <dir> + +will behave as expected, putting all but the last string after the C<-copy> +flag into the parameter variable C<E<lt>filesE<gt>>, whilst the very +last string is assigned to C<E<lt>dirE<gt>>. + + +=head2 Optional parameter components + +Except for the leading flag, any part of a parameter definition +may be made optional by placing it in square brackets. +For example: + + +range <from> [..] [<to>] + +which matches any of: + + +range 1..10 + +range 1.. + +range 1 10 + +range 1 + +List parameter variables may also be made optional (the ellipsis must +follow the parameter variable name immediately, so it goes I<inside> +the square brackets): + + -list [<page>...] + +Two or more parameter components may be made jointly optional, by specifying +them in the same pair of brackets. Optional components may also be nested. For +example: + + -range <from> [.. [<to>] ] + +Scalar optional parameter variables (such as C<[E<lt>toE<gt>]>) +are given undefined values if they are skipped during +a successful parameter match. List optional parameter variables (such as +C<[E<lt>pageE<gt>...]>) are assigned an empty list if unmatched. + +One important use for optional punctuators is to provide abbreviated +versions of specific flags. For example: + + -num[eric] # Match "-num" or "-numeric" + -lexic[ographic]al # Match "-lexical" or "-lexicographical" + -b[ells+]w[histles] # Match "-bw" or "-bells+whistles" + +Note that the actual flags for these three parameters are C<-num>, C<-lexic> +and C<-b>, respectively. + +=head2 Parameter descriptions + +Providing a textual description for each parameter (or parameter +variant) is optional, but strongly recommended. Apart from providing internal +documentation, parameter descriptions are used in the automatically-generated +usage information provided by F<Getopt::Declare>. + +Descriptions may be placed after the tab(s) following the +parameter definition and may be continued on subsequent lines, +provided those lines do not contain any tabs after the first +non-whitespace character (because any such line will instead be +treated as a new parameter specification). The description is +terminated by a blank line, an action specification (see below) or +another parameter specification. + +For example: + + -v Verbose mode + in=<infile> Specify input file + (will fail if file does not exist) + + +range <from>..<to> Specify range of columns to consider + --lines <start> - <stop> Specify range of lines to process + + ignore bad lines Ignore bad lines :-) + + <outfile> Specify an output file + +The parameter description may also contain special directives which +alter the way in which the parameter is parsed. See the various +subsections of L<"ADVANCED FEATURES"> for more information. + + +=head2 Actions + +Each parameter specification may also include one or more blocks of +Perl code, specified in a pair of curly brackets (which I<must> start on +a new line). + +Each action is executed as soon as the corresponding parameter is +successfully matched in the command-line (but see L<"Deferred actions"> +for a means of delaying this response). + +For example: + + -v Verbose mode + { $::verbose = 1; } + -q Quiet mode + { $::verbose = 0; } + +Actions are executed (as C<do> blocks) in the package in which the +F<Getopt::Declare> object containing them was created. Hence they +have access to all package variables and functions in that namespace. + +In addition, each parameter variable belonging to the corresponding +parameter is made available as a (block-scoped) Perl variable with the +same name. For example: + + +range <from>..<to> Set range + { setrange($from, $to); } + + -list <page:i>... Specify pages to list + { foreach (@page) + { + list($_) if $_ > 0; + } + } + +Note that scalar parameter variables become scalar Perl variables, +and list parameter variables become Perl arrays. + + +=head2 Predefined variables available in actions + +Within an action the following variables are also available: + +=over 4 + +=item C<$_PARAM_> + +Stores the identifier of the current parameter: either the leading +flag or, if there is no leading flag, the name of the first parameter +variable. + + +=item C<%_PUNCT_> + +Stores the substring matched by each punctuator in the current parameter. +The hash is indexed by the punctuator itself. The main purpose of this variable +is to allow actions to check whether optional punctuators were in fact matched. +For example: + + -v[erbose] Set verbose mode + (doubly verbose if full word used) + { if ($_PUNCT_{"erbose"}) { $verbose = 2; } + else { $verbose = 1; } + } + +=item C<%_FOUND_> + +This hash stores boolean values indicating whether or not a given +parameter has already been found. The hash keys are the leading flags +or parameter variables of each parameter. For instance, the following +specification makes the C<-q> and C<-v> parameters mutually exclusive +(but see L<"Parameter dependencies"> for a I<much> easier way to achieve +this effect): + + -v Set verbose mode + { die "Can't be verbose *and* quiet!\n" + if $_FOUND_{"-q"}; + } + + -q Set quiet mode + { die "Can't be quiet *and* verbose!\n" + if $_FOUND_{"-v"}; + } + +For reasons that will be explained in L<"Rejection and termination">, +a given parameter is not marked as found until I<after> its +associated actions are executed. That is, C<$_FOUND_{$_PARAM_}> will not +(usually) be true during a parameter action. + +=back + +Note that, although numerous other internal variables on which the +generated parser relies are also visible within parameter actions, +accessing any of them may have Dire Consequences. Moreover, these +other variables may no longer be accessible (or even present) in +future versions of F<Getopt::Declare>. All such internal variables +have names beginning with an underscore. Avoiding such variables names +will ensure there are no conflicts between actions and the parser +itself. + + +=head2 The command-line parsing process + +Whenever a F<Getopt::Declare> object is created, the current command-line +is parsed by sequentially, by attempting to match each parameter +in the object's specification string against the current elements in the +C<@ARGV> array (but see L<"Parsing from other sources">). The order +in which parameters are tried against C<@ARGV> is determined by +three rules: + +=over 4 + +=item 1. + +Parameters with longer flags are tried first. Hence the command-line +argument "-quiet" would be parsed as matching the parameter C<-quiet> +rather than the parameter C<S<-q E<lt>stringE<gt>>>, even if the C<-q> +parameter was defined first. + +=item 2. + +Parameter I<variants> with the most components are +matched first. Hence the argument "-rand 12345" would be parsed as matching +the parameter variant C<S<-rand E<lt>seedE<gt>>>, rather than the +variant C<-rand>, even if the "shorter" C<-rand> variant was defined first. + +=item 3. + +Otherwise, parameters are matched in the order they are defined. + +=back + +Elements of C<@ARGV> which do not match any defined parameter are collected +during the parse and are eventually put back into C<@ARGV> +(see L<"Strict and non-strict command-line parsing">). + + +=head1 ADVANCED FEATURES + +=head2 Case-insensitive parameter matching + +By default, a F<Getopt::Declare> object parses the command-line in +a I<case-sensitive> manner. The C<[nocase]> directive enables a specific +parameter (or, alternatively, I<all> parameters) to be matched +case-insensitively. + +If a C<[nocase]> directive is included in the description of a +specific parameter variant, then that variant (only) will be matched +without regard for case. For example, the specification: + + -q Quiet mode [nocase] + + -v Verbose mode + +means that the arguments "S<-q>" and "S<-Q>" will both match the C<-q> parameter, but +that only "S<-v>" (and I<not> "S<-V>") will match the C<-v> parameter. + +If a C<[nocase]> directive appears anywhere I<outside> a parameter description, +then the entire specification is declared case-insensitive and all parameters +defined in that specification are matched without reagrd to case. + + +=head2 Termination and rejection + +It is sometimes useful to be able to terminate command-line +processing before all arguments have been parsed. To this end, +F<Getopt::Declare> provides a special local operator (C<finish>) which +may be used within actions. The C<finish> operator takes a single optional +argument. If the argument is true (or omitted), +command-line processing is terminated at once (although the current +parameter is still marked as having been successfully matched). For +example: + + -- Traditional argument list terminator + { finish } + + -no-- Use non-traditional terminator instead + { $nontrad = 1; } + + ## Non-traditional terminator (only valid if -no-- flag seen) + { finish($nontrad); } + +It is also possible to reject a single parameter match from within an +action (and then continue trying other candidates). This allows +actions to be used to perform more sophisticated tests on the type of +a parameter variable, or to implement complicated parameter +interdependencies. + +To reject a parameter match, the C<reject> operator is used. The +C<reject> operator takes an optional argument. +If the argument is true (or was omitted), the current parameter +match is immediately rejected. For example: + + -ar <R:n> Set aspect ratio (must be in the range (0..1]) + { + $::sawaspect++; + reject $R <= 0 || $R > 1 ; + setaspect($R); + } + + -q Quiet option (not available on Wednesdays) + { + reject((localtime)[6] == 3); + $::verbose = 0; + } + +Note that any actions performed I<before> the call to C<reject> will +still have effect (for example, the variable C<$::sawaspect> remains +incremented even if the aspect ratio parameter is subsequently rejected). + +The C<reject> operator may also take a second argument, which is +used as an error message if the rejected argument subsequently +fails to match any other parameter. For example: + + -q Quiet option (not available on Wednesdays) + { + reject((localtime)[6] == 3 => "Not today!"); + $::verbose = 0; + } + + +=head2 Specifying other parameter variable types + +As was mentioned in L<"Type of parameter variables">, parameter +variables can be restricted to matching only numbers or only integers +by using the type specifiers ":n" and ":i". F<Getopt::Declare> +provides seven other inbuilt type specifiers, as well as two mechanisms +for defining new restrictions on parameter variables. + +The other inbuilt type specifiers are: + +=over 4 + +=item :+i + +which restricts a parameter variable to matching positive, non-zero +integers (that is: 1, 2, 3, etc.) + +=item :+n + +which restricts a parameter variable to matching positive, non-zero +numbers (that is, floating point numbers strictly greater than zero). + +=item :0+i + +which restricts a parameter variable to matching non-negative integers (that +is: 0, 1, 2, 3, etc.) + +=item :0+n + +which restricts a parameter variable to matching non-negative numbers (that +is, floating point numbers greater than or equal to zero). + +=item :s + +which allows a parameter variable to match any quote-delimited or +whitespace-terminated string. Note that this specifier simply makes +explicit the default behaviour. + +=item :if + +which is used to match input file names. Like type ':s', type ':if' +matches any quote-delimited or whitespace-terminated string. However +this type does I<not> respect other command-line flags and also +requires that the matched string is either "-" (indicating standard +input) or the name of a readable file. + +=item :of + +which is used to match output file names. It is exactly like type ':if' except +that it requires that the string is either "-" (indicating standard output) +or the name of a file that is either writable or non-existent. + +=item :s + +which allows a parameter variable to match any quote-delimited or +whitespace-terminated string. Note that this specifier simply makes +explicit the default behaviour. + +=back + +For example: + + -repeat <count:+i> Repeat <count> times (must be > 0) + + -scale <factor:0+n> Set scaling factor (cannot be negative) + + +Alternatively, parameter variables can be restricted to matching a +specific regular expression, by providing the required pattern +explicitly (in matched "/" delimiters after the ":"). For example: + + -parity <p:/even|odd|both/> Set parity (<p> must be "even", + "odd" or "both") + + -file <name:/\w*\.[A-Z]{3}/> File name must have a three- + capital-letter extension + +If an explicit regular expression is used, there are three "convenience" +extensions available: + +=over 4 + +=item %T + +If the sequence C<%T> appears in a pattern, it is translated to a negative +lookahead containing the parameter variable's trailing context. +Hence the parameter definition: + + -find <what:/(%T\.)+/> ; + +ensures that the command line argument "-find abcd;" causes C<E<lt>whatE<gt>> +to match "abcd", I<not> "abcd;". + + +=item %D + +If the sequence C<%D> appears in a pattern, it is translated into a subpattern +which matches any single digit (like a C<\d>), but only if that digit +would I<not> match the parameter variable's trailing context. +Hence C<%D> is just a convenient short-hand for C<(?:%T\d)> (and is actually +implemented that way). + +=item %F + +By default, any explicit pattern is modified by F<Getopt::Declare> +so that it fails if the argument being matched represents some defined +parameter flag. If however the sequence C<%F> appears anywhere in a +pattern, it causes the pattern I<not> to reject strings which would +otherwise match another flag. For example, the inbuilt types ':if' and +':of' use C<%F> to enable them to match filenames which happen to be +identical to parameter flags. + +=back + +=head2 Defining new parameter variable types + +Explicit regular expressions are very powerful, but also cumbersome to +use (or reuse) in some situations. F<Getopt::Declare> provides a general +"parameter variable type definition" mechanism to simplify such cases. + +To declare a new parameter variable type, the C<[pvtype:...]> directive +is used. A C<[pvtype...]> directive specifies the name, matching +pattern, and action for the new parameter variable type (though both +the pattern and action are optional). + +The name string may be I<any> whitespace-terminated sequence of +characters which does not include a ">". The name may also be specified +within a pair of quotation marks (single or double) or within any Perl +quotelike operation. For example: + + [pvtype: num ] # Makes this valid: -count <N:num> + [pvtype: 'a num' ] # Makes this valid: -count <N:a num> + [pvtype: q{nbr} ] # Makes this valid: -count <N:nbr> + +The pattern is used in initial matching of the parameter variable. +Patterns are normally specified as a "/"-delimited Perl regular +expression: + + [pvtype: num /\d+/ ] + [pvtype: 'a num' /\d+(\.\d*)/ ] + [pvtype: q{nbr} /[+-]?\d+/ ] + +Alternatively the pattern associated with a new type may be specified +as a ":" followed by the name of another parameter variable type (in +quotes if necessary). In this case the new type matches the same +pattern (and action! - see below) as the named type. For example: + + [pvtype: num :+i ] # <X:num> is the same as <X:+i> + [pvtype: 'a num' :n ] # <X:a num> is the same as <X:n> + [pvtype: q{nbr} :'a num' ] # <X:nbr> is also the same as <X:n> + +As a third alternative, the pattern may be omitted altogether, in +which case the new type matches whatever the inbuilt pattern ":s" +matches. + +The optional action which may be included in any C<[pvtype:...]> +directive is executed I<after> the corresponding parameter variable +matches the command line but I<before> any actions belonging to the +enclosing parameter are executed. Typically, such type actions +will call the C<reject> operator (see L<"Termination and rejection">) +to test extra conditions, but any valid Perl code is acceptible. For +example: + + [pvtype: num /\d+/ { reject if (localtime)[6]==3 } ] + [pvtype: 'a num' :n { print "a num!" } ] + [pvtype: q{nbr} :'a num' { reject $::no_nbr } ] + +If a new type is defined in terms of another (for example, ":a num" +and ":nbr" above), any action specified by that new type is +I<prepended> to the action of that other type. Hence: + +=over 4 + +=item * + +the new type ":num" matches any string of digits, but then rejects the +match if it's Wednesday. + +=item * + +the new type ":a num" matches any string of digits (like its parent +type ":num"), I<then> prints out "a num!", I<and then> rejects the +match if it's Wednesday (like its parent type ":num"). + +=item * + +the new type ":nbr" matches any string of digits (like its parent type +":a num"), but then rejects the match if the global C<$::no_nbr> variable +is true. Otherwise it next prints out "a num!" (like its parent type +":a num"), and finally rejects the match if it's Wednesday (like its +grandparent type ":num"). + +=back + +When a type action is executed (as part of a particular parameter +match), three local variables are available: + +=over 4 + +=item C<$_VAL_> + +which contains the value matched by the type's pattern. It is this value which +is ultimately assigned to the local Perl variable which is available to +parameter actions. Hence if the type action changes the value of C<$_VAL_>, +that changed value becomes the "real" value of the corresponding parameter +variable (see the Roman numeral example below). + +=item C<$_VAR_> + +which contains the name of the parameter variable being matched. + +=item C<$_PARAM_> + +which contains the name of the parameter currently being matched. + +=back + +Here is a example of the use of these variables: + + $args = new Getopt::Declare <<'EOPARAM'; + + [pvtype: type /[OAB]|AB')/ ] + [pvtype: Rh? /Rh[+-]/ ] + [pvtype: days :+i { reject $_VAL_<14 " $_PARAM_ (too soon!)"} ] + + -donated <D:days> Days since last donation + -applied <A:days> Days since applied to donate + + -blood <type:type> [<rh:Rh?>] Specify blood type + and (optionally) rhesus factor + EOPARAM + +In the above example, the ":days" parameter variable type is defined +to match whatever the ":+i" type matches (that is positive, non-zero +integers), with the proviso that the matching value (C<$_VAL_>) must +be at least 14. If a shorter value is specified for C<E<lt>DE<gt>>, +or C<E<lt>AE<gt>> parameter variables, then F<Getopt::Declare> would +issue the following (respective) error messages: + + Error: -donated (too soon!) + Error: -applied (too soon!) + +Note that the "inbuilt" parameter variable types ("i", "n", etc.) are +really just predefined type names, and hence can be altered if necessary: + + $args = new Getopt::Declare <<'EOPARAM'; + + [pvtype: 'n' /[MDCLXVI]+/ { reject !($_VAL_=to_roman $_VAL_) } ] + + -index <number:n> Index number + { print $data[$number]; } + EOPARAM + +The above C<[pvtype:...]> directive means that all parameter variables +specified with a type ":n" henceforth only match valid Roman +numerals, but that any such numerals are I<automatically> converted to +ordinary numbers (by passing C<$_VAL_>) through the C<to_roman> +function). + +Hence the requirement that all ":n" numbers now must be Roman can be +imposed I<transparently>, at least as far as the actual parameter +variables which use the ":n" type are concerned. Thus C<$number> can +be still used to index the array C<@data> despite the new restrictions +placed upon it by the redefinition of type ":n". + +Note too that, because the ":+n" and ":0+n" types are implicitly +defined in terms of the original ":n" type (as if the directives: + + [pvtype: '+n' :n { reject if $_VAL <= 0 } ] + [pvtype: '0+n' :n { reject if $_VAL < 0 } ] + +were included in every specification), the above redefinition of ":n" +affects those types as well. In such cases the format conversion is +performed I<before> the "sign" tests (in other words, the "inherited" +actions are performed I<after> any newly defined ones). + +Parameter variable type definitions may appear anywhere in a +F<Getopt::Declare> specification and are effective for the entire +scope of the specification. In particular, new parameter variable +types may be defined I<after> they are used. + +=head2 Undocumented parameters + +If a parameter description is omitted, or consists entirely of +whitespace, or contains the special directive C<[undocumented]>, then +the parameter is still parsed as normal, but will not appear in the +automatically generated usage information (see L<"Usage information">). + +Apart from allowing for "secret" parameters (a dubious benefit), this +feature enables the programmer to specify some undocumented action +which is to be taken on encountering an otherwise unknown argument. +For example: + + <unknown> + { handle_unknown($unknown); } + + +=head2 "Dittoed" parameters + +Sometimes it is desirable to provide two or more alternate flags for +the same behaviour (typically, a short form and a long form). To +reduce the burden of specifying such pairs, the special directive +C<[ditto]> is provided. If the description of a parameter I<begins> with +a C<[ditto]> directive, that directive is replaced with the +description for the immediately preceding parameter (including any +other directives). For example: + + -v Verbose mode + --verbose [ditto] (long form) + +In the automatically generated usage information this would be displayed as: + + -v Verbose mode + --verbose " " (long form) + +Furthermore, if the "dittoed" parameter has no action(s) specified, the +action(s) of the preceding parameter are reused. For example, the +specification: + + -v Verbose mode + { $::verbose = 1; } + --verbose [ditto] + +would result in the C<--verbose> option setting C<$::verbose> just like the +C<-v> option. On the other hand, the specification: + + -v Verbose mode + { $::verbose = 1; } + --verbose [ditto] + { $::verbose = 2; } + +would give separate actions to each flag. + + +=head2 Deferred actions + +It is often desirable or necessary to defer actions taken in response +to particular flags until the entire command-line has been parsed. The most +obvious case is where modifier flags must be able to be specified I<after> +the command-line arguments they modify. + +To support this, F<Getopt::Declare> provides a local operator (C<defer>) which +delays the execution of a particular action until the command-line processing +is finished. The C<defer> operator takes a single block, the execution of which +is deferred until the command-line is fully and successfully parsed. If +command-line processing I<fails> for some reason (see L<"DIAGNOSTICS">), the +deferred blocks are never executed. + +For example: + + <files>... Files to be processed + { defer { foreach (@files) { proc($_); } } } + + -rev[erse] Process in reverse order + { $::ordered = -1; } + + -rand[om] Process in random order + { $::ordered = 0; } + +With the above specification, the C<-rev> and/or C<-rand> flags can be +specified I<after> the list of files, but still affect the processing of +those files. Moreover, if the command-line parsing fails for some reason +(perhaps due to an unrecognized argument), the deferred processing will +not be performed. + + +=head2 Flag clustering + +Like some other F<Getopt::> packages, F<Getopt::Declare> allows parameter +flags to be "clustered". That is, if two or more flags have the same +"flag prefix" (one or more leading non-whitespace, non-alphanumeric characters), +those flags may be concatenated behind a single copy of that flag prefix. +For example, given the parameter specifications: + + -+ Swap signs + -a Append mode + -b Bitwise compare + -c <FILE> Create new file + +del Delete old file + +e <NICE:i> Execute (at specified nice level) when complete + +The following command-lines (amongst others) are all exactly equivalent: + + -a -b -c newfile +e20 +del + -abc newfile +dele20 + -abcnewfile+dele20 + -abcnewfile +e 20del + +The last two alternatives are correctly parsed because +F<Getopt::Declare> allows flag clustering at I<any point> where the +remainder of the command-line being processed starts with a +non-whitespace character and where the remaining substring would not +otherwise immediately match a parameter flag. + +Hence the trailing "+dele20" in the third command-line example is parsed as +S<"+del +e20"> and not S<"-+ del +e20">. This is because the previous "-" +prefix is I<not> propagated (since the leading "+del" I<is> a valid flag). + +In contrast, the trailing S<"+e 20del"> in the fourth example is parsed as +S<"+e 20 +del"> because, after the S<" 20"> is parsed (as the integer +parameter variable C<E<lt>NICEE<gt>>), the next characters are "del", +which I<do not> form a flag themselves unless prefixed with the +controlling "+". + +In some circumstances a clustered sequence of flags on the command-line +might also match a single (multicharacter) parameter flag. For example, given +the specifications: + + -a Blood type is A + -b Blood type is B + -ab Blood type is AB + -ba Donor has a Bachelor of Arts + +A command-line argument "-aba" might be parsed as +S<"-a -b -a"> or S<"-a -ba"> or S<"-ab -a">. In all such +cases, F<Getopt::Declare> prefers the longest unmatched flag first. +Hence the previous example would be parsed as S<"-ab -a">, unless +the C<-ab> flag had already appeared in the command-line (in which +case, it would be parsed as S<"-a -ba">). + +These rules are designed to produce consistency and "least surprise", +but (as the above example illustrates) may not always do so. If the +idea of unconstrained flag clustering is too libertarian for a particular +application, the feature may be restricted (or removed completely), +by including a C<[cluster:...]> directive anywhere in the specification string. + +The options are: + +=over 8 + +=item C<[cluster: any]> + +This version of the directive allows any flag to be clustered (that is, +it merely makes explicit the default behaviour). + +=item C<[cluster: flags]> + +This version of the directive restricts clustering to parameters which are +"pure" flags (that is, those which have no parameter variables or punctuators). + +=item C<[cluster: singles]> + +This version of the directive restricts clustering to parameters which are +"pure" flags, and which consist of a flag prefix followed by a single +alphanumeric character. + +=item C<[cluster: none]> + +This version of the directive turns off clustering completely. + +=back + +For example: + + $args = new Getopt::Declare <<'EOSPEC'; + -a Append mode + -b Back-up mode + -bu [ditto] + -c <file> Copy mode + -d [<file>] Delete mode + -e[xec] Execute mode + + [cluster:singles] + EOSPEC + +In the above example, only the C<-a> and C<-b> parameters may be clustered. +The C<-bu> parameter is excluded because it consists of more than one +letter, whilst the C<-c> and C<-d> parameters are excluded because they +take (or may take, in C<-d>'s case) a variable. The C<-e[xec]> parameter +is excluded because it may take a trailing punctuator (C<[xec]>). + +By comparison, if the directive had been C<[cluster: flags]>, then +C<-bu> I<could> be clustered, though C<-c>, C<-d> and C<-e[xec]> would +still be excluded since they are not "pure flags"). + + +=head2 Strict and non-strict command-line parsing + +"Strictness" in F<Getopt::Declare> refers to the way in which unrecognized +command-line arguments are handled. By default, F<Getopt::Declare> is +"non-strict", in that it simply skips silently over any unrecognized +command-line argument, leaving it in C<@ARGV> at the conclusion of +command-line processing (but only if they were originally parsed +from C<@ARGV>). + +No matter where they came from, the remaining arguments are also available +by calling the C<unused> method on the Getopt::Declare object, after it +has parsed. In a list context, this method returns a list of the +unprocessed arguments; in a scalar context a single string with the unused +arguments concatenated is returned. + +Likewise, there is a C<used> method that returns the arguments that were +successfully processed by the parser. + +However, if a new F<Getopt::Declare> object is created with a +specification string containing the C<[strict]> directive (at any +point in the specification): + + $args = new Getopt::Declare <<'EOSPEC'; + + [strict] + + -a Append mode + -b Back-up mode + -c Copy mode + EOSPEC + +then the command-line is parsed "strictly". In this case, any +unrecognized argument causes an error message (see L<"DIAGNOSTICS">) to +be written to STDERR, and command-line processing to (eventually) +fail. On such a failure, the call to C<Getopt::Declare::new()> returns +C<undef> instead of the usual hash reference. + +The only concession that "strict" mode makes to the unknown is that, +if command-line processing is prematurely terminated via the +C<finish> operator, any command-line arguments which have not yet +been examined are left in C<@ARGV> and do not cause the parse to fail (of +course, if any unknown arguments were encountered I<before> the +C<finish> was executed, those earlier arguments I<will> cause +command-line processing to fail). + +The "strict" option is useful when I<all> possible parameters +can be specified in a single F<Getopt::Declare> object, whereas the +"non-strict" approach is needed when unrecognized arguments are either +to be quietly tolerated, or processed at a later point (possibly in a +second F<Getopt::Declare> object). + + +=head2 Parameter dependencies + +F<Getopt::Declare> provides five other directives which modify the +behaviour of the command-line parser in some way. One or more of these +directives may be included in any parameter description. In addition, +the C<[mutex:...]> directive may also appear in any usage "decoration" +(see L<"Usage information">). + +Each directive specifies a particular set of conditions that a +command-line must fulfil (for example, that certain parameters may not +appear on the same command-line). If any such condition is violated, +an appropriate error message is printed (see L<"DIAGNOSTICS">). +Furthermore, once the command-line is completely parsed, if any +condition was violated, the program terminates +(whilst still inside C<Getopt::Declare::new()>). + +The directives are: + +=over 4 + +=item C<[required]> + +Specifies that an argument matching at least one variant of the +corresponding parameter I<must> be specified somewhere in the +command-line. That is, if two or more required parameters share the +same flag, it suffices that I<any one> of them matches an argument +(recall that F<Getopt::Declare> considers all parameter specifications +with the same flag merely to be variant forms of a single "underlying" +parameter). + +If an argument matching a "required" flag is I<not> found in the +command-line, an error message to that effect is issued, +command-line processing fails, and C<Getopt::Declare::new()> returns +C<undef>. + + +=item C<[repeatable]> + +By default, F<Getopt::Declare> objects allow each of their parameters to +be matched only once (that is, once any variant of a particular +parameter matches an argument, I<all> variants of that same parameter +are subsequently excluded from further consideration when parsing the +rest of the command-line). + +However, it is sometimes useful to allow a particular parameter to match +more than once. Any parameter whose description includes the directive +C<[repeatable]> is I<never> excluded as a potential argument match, no matter +how many times it has matched previously: + + -nice Increase nice value (linearly if repeated) + [repeatable] + { set_nice( get_nice()+1 ); } + + -w Toggle warnings [repeatable] for the rest + of the command-line + { $warn = !$warn; } + +As a more general mechanism is a C<[repeatable]> directive appears in a +specification anywhere other than a flag's description, then I<all> parameters +are marked repeatable: + + [repeatable] + + -nice Increase nice value (linearly if repeated) + { set_nice( get_nice()+1 ); } + + -w Toggle warnings for the rest of the command-line + { $warn = !$warn; } + + +=item C<[mutex: E<lt>flag listE<gt>]> + +The C<[mutex:...]> directive specifies that the parameters whose +flags it lists are mutually exclusive. That is, no two or more of them +may appear in the same command-line. For example: + + -case set to all lower case + -CASE SET TO ALL UPPER CASE + -Case Set to sentence case + -CaSe SeT tO "RAnSom nOTe" CasE + + [mutex: -case -CASE -Case -CaSe] + +The interaction of the C<[mutex:...]> and C<[required]> directives is +potentially awkward in the case where two "required" arguments are +also mutually exclusive (since the C<[required]> directives insist +that both parameters must appear in the command-line, whilst the +C<[mutex:...]> directive expressly forbids this). + +F<Getopt::Declare> resolves such contradictory constraints by +relaxing the meaning of "required" slightly. If a flag is marked +"required", it is considered "found" for the purposes of error +checking if it or I<any other flag with which it is mutually +exclusive> appears on the command-line. + +Hence the specifications: + + -case set to all lower case [required] + -CASE SET TO ALL UPPER CASE [required] + -Case Set to sentence case [required] + -CaSe SeT tO "RAnSom nOTe" CasE [required] + + [mutex: -case -CASE -Case -CaSe] + +mean that I<exactly one> of these four flags must appear on the +command-line, but that the presence of any one of them will suffice +to satisfy the "requiredness" of all four. + +It should also be noted that mutual exclusion is only tested for +I<after> a parameter has been completely matched (that is, after the +execution of its actions, if any). This prevents "rejected" parameters +(see L<"Termination and rejection">) from incorrectly generating +mutual exclusion errors. However, it also sometimes makes it necessary +to defer the actions of a pair of mutually exclusive parameters (for +example, if those actions are expensive or irreversible). + + +=item C<[excludes: E<lt>flag listE<gt>]> + +The C<[excludes:...]> directive provides a "pairwise" version of +mutual exclusion, specifying that the current parameter is mutually exclusive +with all the other parameters lists, but those other parameters are not +mutually exclusive with each other. That is, whereas the specification: + + -left Justify to left margin + -right Justify to right margin + -centre Centre each line + + [mutex: -left -right -centre] + +means that only one of these three justification alternatives can ever be used +at once, the specification: + + -left Justify to left margin + -right Justify to right margin + -centre Centre each line [excludes: -left -right] + +means that C<-left> and C<-right> can still be used together +(probably to indicate "left I<and> right" justification), but that +neither can be used with C<-centre>. Note that the C<[excludes:...]> +directive also differs from the C<[mutex:...]> in that it is always +connected with a paricular parameter, I<implicitly> +using the flag of that parameter as the target of exclusion. + + +=item C<[requires: E<lt>conditionE<gt>]> + +The C<[requires]> directive specifies a set of flags which +must also appear in order for a particular flag to be permitted in the +command-line. The condition is a boolean expression, in which the +terms are the flags or various parameters, and the operations are +C<&&>, C<||>, C<!>, and bracketting. For example, the specifications: + + -num Use numeric sort order + -lex Use "dictionary" sort order + -len Sort on length of line (or field) + + -field <N:+i> Sort on value of field <N> + + -rev Reverse sort order + [requires: -num || -lex || !(-len && -field)] + +means that the C<-rev> flag is allowed only if either the C<-num> or the +C<-lex> parameter has been used, or if it is not true that +I<both> the C<-len> I<and> the C<-field> parameters have been used. + +Note that the operators C<&&>, C<||>, and C<!> retain their normal +Perl precedences. + + +=head2 Parsing from other sources + +F<Getopt::Declare> normally parses the contents of C<@ARGV>, but can +be made to parse specified files instead. To accommodate this, +C<Getopt::Declare::new()> takes an optional second parameter, which specifies +a file to be parsed. The parameter may be either: + +=over 8 + +=item A C<IO::Handle> reference or a filehandle GLOB reference + +in which case C<Getopt::Declare::new()> reads the corresponding handle until +end-of-file, and parses the resulting text (even if it is an empty string). + +=item An ARRAY reference containing the single string C<'-CONFIG'> + +in which case C<Getopt::Declare::new()> looks for the files +F<$ENV{HOME}/.${progname}rc> and F<$ENV{PWD}/.${progname}rc>, +concatenates their contents, and parses that. + +If neither file is found (or if both are inaccessible) +C<Getopt::Declare::new()> immediately returns zero. If a +file is found but the parse subsequently fails, C<undef> is returned. + +=item An ARRAY reference containing the single string C<'-BUILD'> + +in which case C<Getopt::Declare::new()> builds a parser from the +supplied grammar and returns a reference to it, but does not parse anything. +See L<"The Getopt::Declare::code() method"> and +L<"The Getopt::Declare::parse() method">. + +=item An ARRAY reference containing the single string C<'-SKIP'> or the single value C<undef> or nothing + +in which case C<Getopt::Declare::new()> immediately returns zero. +This alternative is useful when using a C<FileHandle>: + + my $args = new Getopt::Declare($grammar, + new FileHandle ($filename) || -SKIP); + +because it makes explicit what happens if C<FileHandle::new()> fails. Of course, +if the C<-SKIP> alternative were omitted, <Getopt::Declare::new> would +still return immediately, having found C<undef> as its second argument. + +=item Any other ARRAY reference + +in which case C<Getopt::Declare::new()> treats the array elements as a +list of filenames, concatenates the contents of those files, and parses that. + +If the list does not denote any accessible file(s) +C<Getopt::Declare::new()> immediately returns zero. If matching files +are found, but not successfully parsed, C<undef> is returned. + +=item A string + +in which case C<Getopt::Declare::new()> parses that string directly. + +=back + +Note that when C<Getopt::Declare::new()> parses from a +source other than C<@ARGV>, unrecognized arguments are I<not> +placed back in C<@ARGV>. + + +=head2 Using F<Getopt::Declare> objects after command-line processing + +After command-line processing is completed, the object returned by +C<Getopt::Declare::new()> will have the following features: + +=over 4 + +=item Parameter data + +For each successfully matched parameter, the F<Getopt::Declare> object +will contain a hash element. The key of that element will be the leading flag +or parameter variable name of the parameter. + +The value of the element will be a reference to another hash which contains +the names and values of each distinct parameter variable and/or +punctuator which was matched by the parameter. Punctuators generate +string values containing the actual text matched. Scalar parameter +variables generate scalar values. List parameter variables +generate array references. + +As a special case, if a parameter consists of a single component +(either a single flag or a single parameter variable), then the value for the +corresponding hash key is not a hash reference, but the actual value matched. + +The following example illustrates the various possibilities: + + $args = new Getopt::Declare, q{ + + -v <value> [etc] One or more values + <infile> Input file [required] + -o <outfiles>... Output files + }; + + if ( $args->{'-v'} ) + { + print "Using value: ", $args->{'-v'}{'<value>'}; + print " (et cetera)" if $args->{'-v'}{'etc'}; + print "\n"; + } + + open INFILE, $args->{'<infile>'} or die; + @data = <INFILE>; + + foreach $outfile ( @{$args->{'-o'}{'<outfiles>'}} ) + { + open OUTFILE, ">$outfile" or die; + print OUTFILE process(@data); + close OUTFILE; + } + + +The values which are assigned to the various hash elements are copied from +the corresponding blocked-scoped variables which are available within +actions. In particular, if the value of any of those block-scoped variables +is changed within an action, that changed value is saved in the hash. For +example, given the specification: + + $args = new Getopt::Declare, q{ + + -ar <R:n> Set aspect ratio (will be clipped to [0..1]) + { + $R = 0 if $R < 0; + $R = 1 if $R > 1; + } + }; + +then the value of C<$args-E<gt>{'-ar'}{'E<lt>RE<gt>'}> +will always be between zero and one. + + +=item The C<@ARGV> array + +In its "non-strict" mode, once a F<Getopt::Declare> object has +completed its command-line processing, it pushes any unrecognized +arguments back into the emptied command-line array C<@ARGV> (whereas +all I<recognized> arguments will have been removed). + +Note that these remaining arguments will be in sequential elements +(starting at C<$ARGV[0]>), I<not> in their original positions in +C<@ARGV>. + + +=item The C<Getopt::Declare::usage()> method + +Once a F<Getopt::Declare> object is created, its C<usage()> method may be called +to explicitly print out usage information corresponding to the specification +with which it was built. See L<"Usage information"> for more details. +If the C<usage()> method is called with an argument, that argument is passed +to C<exit> after the usage information is printed (the no-argument version of +C<usage()> simply returns at that point). + + +=item The C<Getopt::Declare::version()> method + +Another useful method of a F<Getopt::Declare> object is C<version()>, +which prints out the name of the enclosing program, the last time it +was modified, and the value of C<$::VERSION>, if it is defined. +Note that this implies that I<all> F<Getopt::Declare> objects in a +single program will print out identical version information. + +Like the C<usage()> method, if C<version> is passed an argument, it +will exit with that value after printing. + + +=item The C<Getopt::Declare::parse()> method + +It is possible to separate the construction of a F<Getopt::Declare> +parser from the actual parsing it performs. If +C<Getopt::Declare::new()> is called with a second parameter C<'-BUILD'> +(see L<"Parsing from other sources">, it constructs and returns a +parser, without parsing anything. +The resulting parser object can then be used to parse multiple sources, +by calling its C<parse()> method. + +C<Getopt::Declare::parse()> takes an optional parameter which specifies +the source of the text to be parsed (it parses C<@ARGV> if the +parameter is omitted). This parameter takes the same set of values as the +optional second parameter of C<Getopt::Declare::new()> (see L<"Parsing +from other sources">). + +C<Getopt::Declare::parse()> returns true if the source is located and +parsed successfully. It returns a defined false (zero) if the source is +not located. An C<undef> is returned if the source is located, but not +successfully parsed. + +Thus, the following code first constructs a parsers for a series of alternate +configuration files and the command line, and then parses them: + + # BUILD PARSERS + my $config = Getopt::Declare::new($config_grammar, -BUILD); + my $cmdline = Getopt::Declare::new($cmdline_grammar, -BUILD); + + # TRY STANDARD CONFIG FILES + $config->parse(-CONFIG) + + # OTHERWISE, TRY GLOBAL CONFIG + or $config->parse('/usr/local/config/.demo_rc') + + # OTHERWISE, TRY OPENING A FILEHANDLE (OR JUST GIVE UP) + or $config->parse(new FileHandle (".config") || -SKIP); + + # NOW PARSE THE COMMAND LINE + + $cmdline->parse() or die; + + +=item The C<Getopt::Declare::code()> method + +It is also possible to retreive the command-line parsing code generated +internally by C<Getopt::Declare::new()>. The C<Getopt::Declare::code()> +method returns a string containing the complete command-line processing +code, as a single C<do> block plus a leading C<package> declaration. + +C<Getopt::Declare::code()> takes as its sole argument a string +containing the complete name of the package (for the leading +C<package> declaration in the generated code). If this string is empty +or undefined, the package name defaults to "main". + +Since the default behaviour of C<Getopt::Declare::new()> is to execute +the command-line parsing code it generates, if the goal is only to +generate the parser code, the optional second '-BUILD' parameter +(see L<"Parsing from other sources">) should be specified when calling +<Getopt::Declare::new()>. + +For example, the following program "inlines" a C<Getopt::Declare> +specification, by extracting it from between the first "=for +Getopt::Declare" and the next "=cut" appearing on C<STDIN>: + + use Getopt::Declare; + + sub encode { return new Getopt::Declare (shift,-BUILD)->code() || die } + + undef $/; + if (<>) + { + s {^=for\s+Getopt::Declare\s*\n(.*?)\n=cut} + {'my (\$self,$source) = ({});'.encode($1).' or die "\n";'} + esm; + } + + print; + +Note that the generated inlined version expects to find a lexical variable +named C<$source>, which tells it what to parse (this variable is +normally set by the optional parameters of C<Getopt::Declare::new()> or +C<Getopt::Declare::parse()>). + +The inlined code leaves all extracted parameters in the lexical +variable C<$self> and the does not autogenerate help or version flags +(since there is no actual F<Getopt::Declare> object in the inlined code +through which to generate them). + +=back + + +=head1 AUTOGENERATED FEATURES + +=head2 Usage information + +The specification passed to C<Getopt::Declare::new> is used (almost +verbatim) as a "usage" display whenever usage information is +requested. + +Such requests may be made either by specifying an argument matching +the help parameter (see L<"Help parameters">) or by explicitly calling +the C<Getopt::Declare::usage()> method (through an action or after +command-line processing): + + $args = new Getopt::Declare, q{ + + -usage Show usage information and exit + { $self->usage(0); } + + +usage Show usage information at end of program + }; + + # PROGRAM HERE + + $args->usage() if $args->{'+usage'}; + + +The following changes are made to the original specification before +it is displayed: + +=over 4 + +=item * + +All actions and comments are deleted, + +=item * + +any C<[ditto]> directive is converted to an appropriate set of "ditto" marks, + +=item * + +any text in matching square brackets (including any directive) is deleted, + +=item * + +any parameter variable type specifier (":i", ":n", ":/pat/", etc.) is deleted. + +=back + +Otherwise, the usage information displayed retains all the formatting +present in the original specification. + +In addition to this information, if the input source is @ARGV, +F<Getopt::Declare> displays three sample command-lines: one indicating +the normal usage (including any required parameter variables), one +indicating how to invoke help (see L<"Help parameters">), and one +indicating how to determine the current version of the program (see +L<"Version parameters">). + +The usage information is printed to C<STDOUT> and (since F<Getopt::Declare> +tends to encourage longer and better-documented parameter lists) if +the F<IO::Pager> package is available, an F<IO::Pager> object is used to +page out the entire usage documentation. + +=head2 Usage "decoration" + +It is sometimes convenient to add other "decorative" features to a +program's usage information, such as subheadings, general notes, +separators, etc. F<Getopt::Declare> accommodates this need by ignoring +such items when interpreting a specification string, but printing them +when asked for usage information. + +Any line which cannot be interpreted as either a parameter +definition, a parameter description, or a parameter action, is treated +as a "decorator" line, and is printed verbatim (after any square +bracketted substrings have been removed from it). + +The key to successfully decorating F<Getopt::Declare> usage +information is to ensure that decorator lines are separated from +any preceding parameter specification, either by an action or by an +empty line. In addition, like a parameter description, a decorator +line cannot contain a tab character after the first non-whitespace +character (because it would then be treated as a parameter +specification). + +The following specification demonstrates various forms of usage +decoration. In fact, there are only four actual parameters (C<-in>, +C<-r>, C<-p>, and C<-out>) specified. Note in particular that I<leading> tabs +are perfectly acceptible in decorator lines. + + $args = new Getopt::Declare (<<'EOPARAM'); + + ============================================================ + Required parameter: + + -in <infile> Input file [required] + + ------------------------------------------------------------ + + Optional parameters: + + (The first two are mutually exclusive) [mutex: -r -p] + + -r[and[om]] Output in random order + -p[erm[ute]] Output all permutations + + --------------------------------------------------- + + -out <outfile> Optional output file + + ------------------------------------------------------------ + Note: this program is known to run very slowly of files with + long individual lines. + ============================================================ + EOPARAM + + +=head2 Help parameters + +By default, F<Getopt::Declare> automatically defines I<all> of the following +parameters: + + -help Show usage information [undocumented] + { $self->usage(0); } + -Help [ditto] + -HELP [ditto] + --help [ditto] + --Help [ditto] + --HELP [ditto] + -h [ditto] + -H [ditto] + +Hence, most attempts by the user to get help will automatically work +successfully. + +Note however that, if a parameter with any of these flags is +explicitly specified in the string passed to C<Getopt::Declare::new()>, +that flag (only) is removed from the list of possible help flags. For +example: + + -w <pixels:+i> Specify width in pixels + -h <pixels:+i> Specify height in pixels + +would cause the C<-h> help parameter to be removed (although help +would still be accessible through the other seven alternatives). + + +=head2 Version parameters + +F<Getopt::Declare> also automatically creates a set of parameters which can be +used to retreive program version information: + + -version Show version information [undocumented] + { $self->version(0); } + -Version [ditto] + -VERSION [ditto] + --version [ditto] + --Version [ditto] + --VERSION [ditto] + -v [ditto] + -V [ditto] + +As with the various help commands, explicitly specifying a parameter +with any of the above flags removes that flag from the list of version +flags. + + +=head1 DIAGNOSTICS + +F<Getopt::Declare> may issue the following diagnostics whilst parsing a +command-line. All of them are fatal (the first five, instantly so): + +=over 4 + +=item "Error: bad Getopt::Declare parameter variable specification near %s" + +A matching pair of angle brackets were specified as part of a +parameter definition, but did not form a valid parameter variable +specification (that is, it wasn't in the form: <I<name>> or +<I<name>:I<type>>). + +=item "Error: bad type in Getopt::Declare parameter variable specification near %s" + +An unknown type specifier was used in a parameter variable type suffix. + +=item "Error: bad action in Getopt::Declare specification:\n %s" + +A Perl syntax error was detected in the indicated action. + +=item "Error: unattached action in Getopt::Declare specification:\n %s" + +An action was found for which there was no preceding parameter specification. +This usually occurs because the trailing tab was omitted from the preceding +parameter specification. + +=item "Error: incomplete action in Getopt::Declare specification:\n %s" + +An action was found, but it was missing one or more closing '}'s. + +=item "Error: bad condition in directive [requires: %s]\n" + +The condition specified as part of the indicated C<[requires:...]> +directive was not a well-formed boolean expression. Common problems +include: omitting a C<&&>/C<||> operator between two flags, +mismatched brackets, or using C<and>/C<or> instead of C<&&>/C<||>. + +=item "Error: in generated command-line parser code:\n %s" + +Either there was a Perl syntax error in one some action (which was +not caught by the previous diagnostic), or (less likely) there is a +bug in the code generator inside F<Getopt::Declare>. + +=item "Error: incorrect specification of %s parameter" + +The flag for the indicated parameter was found, but the argument did not +then match any of that parameter's variant syntaxes. + +=item "Error: parameter %s not allowed with %s" + +Two mutually exclusive flags were specified together. + +=item "Error: required parameter %s not found" + +No argument matching the specified "required" parameter was found +during command-line processing. + +=item "Error: parameter %s can only be specified with %s" + +The indicated parameter has a C<[requires:...]> directive, which +was not satisfied. + +=item "Error: unknown command-line argument (%s)" + +A command-line argument was encountered which did not match any +specified parameter. This diagnostic can only only appear if the +"strict" option is in effect. + +=item "Error: in parameter %s (%s must be an integer greater than zero)" + +A parameter variable in the indicated parameter was declared with the +type ":+i" (or a type derived from it), but the corresponding +argument was not a positive, non-zero integer. + +=item "Error: in parameter %s (%s must be a number greater than zero)" + +A parameter variable in the indicated parameter was declared with the +type ":+n" (or a type derived from it), but the corresponding +argument was not a positive, non-zero number. + +=item "Error: in parameter %s (%s must be an positive integer)" + +A parameter variable in the indicated parameter was declared with the +type ":0+i" (or a type derived from it), but the corresponding +argument was not a positive integer. + +=item "Error: in parameter %s (%s must be a positive number)" + +A parameter variable in the indicated parameter was declared with the +type ":0+n" (or a type derived from it), but the corresponding +argument was not a positive number. + +=back + +=head1 AUTHOR + +Damian Conway (damian@conway.org) + + +=head1 BUGS AND ANNOYANCES + +There are undoubtedly serious bugs lurking somewhere in this code. + +If nothing else, it shouldn't take 1500 lines to explain a +package that was designed for intuitive ease of use! + +Bug reports and other feedback are most welcome. + + +=head1 COPYRIGHT + + Copyright (c) 1997-2000, Damian Conway. All Rights Reserved. + This module is free software. It may be used, redistributed + and/or modified under the terms of the Perl Artistic License + (see http://www.perl.com/perl/misc/Artistic.html) |