1package Getopt::Std; 2require 5.000; 3require Exporter; 4 5=head1 NAME 6 7Getopt::Std, getopt, getopts - Process single-character switches with switch clustering 8 9=head1 SYNOPSIS 10 11 use Getopt::Std; 12 13 getopt('oDI'); # -o, -D & -I take arg. Sets $opt_* as a side effect. 14 getopt('oDI', \%opts); # -o, -D & -I take arg. Values in %opts 15 getopts('oif:'); # -o & -i are boolean flags, -f takes an argument 16 # Sets $opt_* as a side effect. 17 getopts('oif:', \%opts); # options as above. Values in %opts 18 19=head1 DESCRIPTION 20 21The getopt() function processes single-character switches with switch 22clustering. Pass one argument which is a string containing all switches 23that take an argument. For each switch found, sets $opt_x (where x is the 24switch name) to the value of the argument if an argument is expected, 25or 1 otherwise. Switches which take an argument don't care whether 26there is a space between the switch and the argument. 27 28The getopts() function is similar, but you should pass to it the list of all 29switches to be recognized. If unspecified switches are found on the 30command-line, the user will be warned that an unknown option was given. 31 32Note that, if your code is running under the recommended C<use strict 33'vars'> pragma, you will need to declare these package variables 34with "our": 35 36 our($opt_x, $opt_y); 37 38For those of you who don't like additional global variables being created, getopt() 39and getopts() will also accept a hash reference as an optional second argument. 40Hash keys will be x (where x is the switch name) with key values the value of 41the argument or 1 if no argument is specified. 42 43To allow programs to process arguments that look like switches, but aren't, 44both functions will stop processing switches when they see the argument 45C<-->. The C<--> will be removed from @ARGV. 46 47=cut 48 49@ISA = qw(Exporter); 50@EXPORT = qw(getopt getopts); 51$VERSION = '1.03'; 52 53# Process single-character switches with switch clustering. Pass one argument 54# which is a string containing all switches that take an argument. For each 55# switch found, sets $opt_x (where x is the switch name) to the value of the 56# argument, or 1 if no argument. Switches which take an argument don't care 57# whether there is a space between the switch and the argument. 58 59# Usage: 60# getopt('oDI'); # -o, -D & -I take arg. Sets opt_* as a side effect. 61 62sub getopt (;$$) { 63 my ($argumentative, $hash) = @_; 64 $argumentative = '' if !defined $argumentative; 65 my ($first,$rest); 66 local $_; 67 local @EXPORT; 68 69 while (@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) { 70 ($first,$rest) = ($1,$2); 71 if (/^--$/) { # early exit if -- 72 shift @ARGV; 73 last; 74 } 75 if (index($argumentative,$first) >= 0) { 76 if ($rest ne '') { 77 shift(@ARGV); 78 } 79 else { 80 shift(@ARGV); 81 $rest = shift(@ARGV); 82 } 83 if (ref $hash) { 84 $$hash{$first} = $rest; 85 } 86 else { 87 ${"opt_$first"} = $rest; 88 push( @EXPORT, "\$opt_$first" ); 89 } 90 } 91 else { 92 if (ref $hash) { 93 $$hash{$first} = 1; 94 } 95 else { 96 ${"opt_$first"} = 1; 97 push( @EXPORT, "\$opt_$first" ); 98 } 99 if ($rest ne '') { 100 $ARGV[0] = "-$rest"; 101 } 102 else { 103 shift(@ARGV); 104 } 105 } 106 } 107 unless (ref $hash) { 108 local $Exporter::ExportLevel = 1; 109 import Getopt::Std; 110 } 111} 112 113# Usage: 114# getopts('a:bc'); # -a takes arg. -b & -c not. Sets opt_* as a 115# # side effect. 116 117sub getopts ($;$) { 118 my ($argumentative, $hash) = @_; 119 my (@args,$first,$rest); 120 my $errs = 0; 121 local $_; 122 local @EXPORT; 123 124 @args = split( / */, $argumentative ); 125 while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) { 126 ($first,$rest) = ($1,$2); 127 if (/^--$/) { # early exit if -- 128 shift @ARGV; 129 last; 130 } 131 $pos = index($argumentative,$first); 132 if ($pos >= 0) { 133 if (defined($args[$pos+1]) and ($args[$pos+1] eq ':')) { 134 shift(@ARGV); 135 if ($rest eq '') { 136 ++$errs unless @ARGV; 137 $rest = shift(@ARGV); 138 } 139 if (ref $hash) { 140 $$hash{$first} = $rest; 141 } 142 else { 143 ${"opt_$first"} = $rest; 144 push( @EXPORT, "\$opt_$first" ); 145 } 146 } 147 else { 148 if (ref $hash) { 149 $$hash{$first} = 1; 150 } 151 else { 152 ${"opt_$first"} = 1; 153 push( @EXPORT, "\$opt_$first" ); 154 } 155 if ($rest eq '') { 156 shift(@ARGV); 157 } 158 else { 159 $ARGV[0] = "-$rest"; 160 } 161 } 162 } 163 else { 164 warn "Unknown option: $first\n"; 165 ++$errs; 166 if ($rest ne '') { 167 $ARGV[0] = "-$rest"; 168 } 169 else { 170 shift(@ARGV); 171 } 172 } 173 } 174 unless (ref $hash) { 175 local $Exporter::ExportLevel = 1; 176 import Getopt::Std; 177 } 178 $errs == 0; 179} 180 1811; 182