X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FGetopt%2FStd.pm;h=823bc4dd910ecf3964f57f95e5867472ad738f6f;hb=e63b33793c3cf76a134a6446d1f83479e030a15f;hp=e5b369ceb5782ebe4b98585f57f85509fa6df9c2;hpb=5812d790acd59b98b5e3e7519f0367585106cb30;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/Getopt/Std.pm b/lib/Getopt/Std.pm index e5b369c..823bc4d 100644 --- a/lib/Getopt/Std.pm +++ b/lib/Getopt/Std.pm @@ -4,34 +4,37 @@ require Exporter; =head1 NAME -getopt - Process single-character switches with switch clustering - -getopts - Process single-character switches with switch clustering +getopt, getopts - Process single-character switches with switch clustering =head1 SYNOPSIS use Getopt::Std; - getopt('oDI'); # -o, -D & -I take arg. Sets opt_* as a side effect. + getopt('oDI'); # -o, -D & -I take arg. Sets $opt_* as a side effect. getopt('oDI', \%opts); # -o, -D & -I take arg. Values in %opts getopts('oif:'); # -o & -i are boolean flags, -f takes an argument - # Sets opt_* as a side effect. + # Sets $opt_* as a side effect. getopts('oif:', \%opts); # options as above. Values in %opts =head1 DESCRIPTION -The getopt() functions processes single-character switches with switch +The getopt() function processes single-character switches with switch clustering. Pass one argument which is a string containing all switches that take an argument. For each switch found, sets $opt_x (where x is the -switch name) to the value of the argument, or 1 if no argument. Switches -which take an argument don't care whether there is a space between the -switch and the argument. +switch name) to the value of the argument if an argument is expected, +or 1 otherwise. Switches which take an argument don't care whether +there is a space between the switch and the argument. + +The getopts() function is similar, but you should pass to it the list of all +switches to be recognized. If unspecified switches are found on the +command-line, the user will be warned that an unknown option was given. +The getopts() function returns true unless an invalid option was found. Note that, if your code is running under the recommended C pragma, you will need to declare these package variables with "our": - our($opt_foo, $opt_bar); + our($opt_x, $opt_y); For those of you who don't like additional global variables being created, getopt() and getopts() will also accept a hash reference as an optional second argument. @@ -42,11 +45,36 @@ To allow programs to process arguments that look like switches, but aren't, both functions will stop processing switches when they see the argument C<-->. The C<--> will be removed from @ARGV. +=head1 C<--help> and C<--version> + +If C<-> is not a recognized switch letter, getopts() supports arguments +C<--help> and C<--version>. If C and/or +C are defined, they are called; the arguments are +the output file handle, the name of option-processing package, its version, +and the switches string. If the subroutines are not defined, an attempt is +made to generate intelligent messages; for best results, define $main::VERSION. + +If embedded documentation (in pod format, see L) is detected +in the script, C<--help> will also show how to access the documentation. + +Note that due to excessive paranoia, if $Getopt::Std::STANDARD_HELP_VERSION +isn't true (the default is false), then the messages are printed on STDERR, +and the processing continues after the messages are printed. This being +the opposite of the standard-conforming behaviour, it is strongly recommended +to set $Getopt::Std::STANDARD_HELP_VERSION to true. + +One can change the output file handle of the messages by setting +$Getopt::Std::OUTPUT_HELP_VERSION. One can print the messages of C<--help> +(without the C line) and C<--version> by calling functions help_mess() +and version_mess() with the switches string as an argument. + =cut @ISA = qw(Exporter); @EXPORT = qw(getopt getopts); -$VERSION = '1.02'; +$VERSION = '1.06'; +# uncomment the next line to disable 1.03-backward compatibility paranoia +# $STANDARD_HELP_VERSION = 1; # Process single-character switches with switch clustering. Pass one argument # which is a string containing all switches that take an argument. For each @@ -57,9 +85,11 @@ $VERSION = '1.02'; # Usage: # getopt('oDI'); # -o, -D & -I take arg. Sets opt_* as a side effect. -sub getopt ($;$) { - local($argumentative, $hash) = @_; - local($_,$first,$rest); +sub getopt (;$$) { + my ($argumentative, $hash) = @_; + $argumentative = '' if !defined $argumentative; + my ($first,$rest); + local $_; local @EXPORT; while (@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) { @@ -106,24 +136,101 @@ sub getopt ($;$) { } } +sub output_h () { + return $OUTPUT_HELP_VERSION if defined $OUTPUT_HELP_VERSION; + return \*STDOUT if $STANDARD_HELP_VERSION; + return \*STDERR; +} + +sub try_exit () { + exit 0 if $STANDARD_HELP_VERSION; + my $p = __PACKAGE__; + print {output_h()} <= 5.006; + print $h <) { + $has_pod = 1, last if /^=(pod|head1)/; + } + } + print $h <= 0) { if (defined($args[$pos+1]) and ($args[$pos+1] eq ':')) { shift(@ARGV); @@ -156,6 +263,18 @@ sub getopts ($;$) { } } else { + if ($first eq '-' and $rest eq 'help') { + version_mess($argumentative, 'main'); + help_mess($argumentative, 'main'); + try_exit(); + shift(@ARGV); + next; + } elsif ($first eq '-' and $rest eq 'version') { + version_mess($argumentative, 'main'); + try_exit(); + shift(@ARGV); + next; + } warn "Unknown option: $first\n"; ++$errs; if ($rest ne '') {