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.
Note that, if your code is running under the recommended C<use strict
-'vars'> pragma, it may be helpful to declare these package variables
-via C<use vars> perhaps something like this:
+'vars'> pragma, you will need to declare these package variables
+with "our":
- use vars qw/ $opt_foo $opt_bar /;
+ our($opt_x, $opt_y);
-For those of you who don't like additional variables being created, getopt()
+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.
Hash keys will be x (where x is the switch name) with key values the value of
the argument or 1 if no argument is specified.
+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.
+
=cut
@ISA = qw(Exporter);
@EXPORT = qw(getopt getopts);
-$VERSION = '1.01';
+$VERSION = '1.03';
# Process single-character switches with switch clustering. Pass one argument
# which is a string containing all switches that take an argument. For each
# 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]) =~ /^-(.)(.*)/) {
($first,$rest) = ($1,$2);
+ if (/^--$/) { # early exit if --
+ shift @ARGV;
+ last;
+ }
if (index($argumentative,$first) >= 0) {
if ($rest ne '') {
shift(@ARGV);
shift(@ARGV);
$rest = shift(@ARGV);
}
- if (ref $hash) {
- $$hash{$first} = $rest;
- }
- else {
- ${"opt_$first"} = $rest;
- push( @EXPORT, "\$opt_$first" );
- }
+ if (ref $hash) {
+ $$hash{$first} = $rest;
+ }
+ else {
+ ${"opt_$first"} = $rest;
+ push( @EXPORT, "\$opt_$first" );
+ }
}
else {
- if (ref $hash) {
- $$hash{$first} = 1;
- }
- else {
- ${"opt_$first"} = 1;
- push( @EXPORT, "\$opt_$first" );
- }
+ if (ref $hash) {
+ $$hash{$first} = 1;
+ }
+ else {
+ ${"opt_$first"} = 1;
+ push( @EXPORT, "\$opt_$first" );
+ }
if ($rest ne '') {
$ARGV[0] = "-$rest";
}
# # side effect.
sub getopts ($;$) {
- local($argumentative, $hash) = @_;
- local(@args,$_,$first,$rest);
- local($errs) = 0;
+ my ($argumentative, $hash) = @_;
+ my (@args,$first,$rest);
+ my $errs = 0;
+ local $_;
local @EXPORT;
@args = split( / */, $argumentative );
while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
($first,$rest) = ($1,$2);
+ if (/^--$/) { # early exit if --
+ shift @ARGV;
+ last;
+ }
$pos = index($argumentative,$first);
- if($pos >= 0) {
- if(defined($args[$pos+1]) and ($args[$pos+1] eq ':')) {
+ if ($pos >= 0) {
+ if (defined($args[$pos+1]) and ($args[$pos+1] eq ':')) {
shift(@ARGV);
- if($rest eq '') {
+ if ($rest eq '') {
++$errs unless @ARGV;
$rest = shift(@ARGV);
}
- if (ref $hash) {
- $$hash{$first} = $rest;
- }
- else {
- ${"opt_$first"} = $rest;
- push( @EXPORT, "\$opt_$first" );
- }
+ if (ref $hash) {
+ $$hash{$first} = $rest;
+ }
+ else {
+ ${"opt_$first"} = $rest;
+ push( @EXPORT, "\$opt_$first" );
+ }
}
else {
- if (ref $hash) {
- $$hash{$first} = 1;
- }
- else {
- ${"opt_$first"} = 1;
- push( @EXPORT, "\$opt_$first" );
- }
- if($rest eq '') {
+ if (ref $hash) {
+ $$hash{$first} = 1;
+ }
+ else {
+ ${"opt_$first"} = 1;
+ push( @EXPORT, "\$opt_$first" );
+ }
+ if ($rest eq '') {
shift(@ARGV);
}
else {
else {
warn "Unknown option: $first\n";
++$errs;
- if($rest ne '') {
+ if ($rest ne '') {
$ARGV[0] = "-$rest";
}
else {
}
1;
-
projects / p5sagit/p5-mst-13.2.git / blobdiff