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