This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Banishing eval from getopt.pl and Getopt/Std.pm
[perl5.git] / lib / Getopt / Std.pm
1 package Getopt::Std;
2 require 5.000;
3 require Exporter;
4
5 =head1 NAME
6
7 getopt - Process single-character switches with switch clustering
8
9 getopts - 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
23 The getopt() functions processes single-character switches with switch
24 clustering.  Pass one argument which is a string containing all switches
25 that take an argument.  For each switch found, sets $opt_x (where x is the
26 switch name) to the value of the argument, or 1 if no argument.  Switches
27 which take an argument don't care whether there is a space between the
28 switch and the argument.
29
30 For those of you who don't like additional variables being created, getopt()
31 and getopts() will also accept a hash reference as an optional second argument. 
32 Hash keys will be x (where x is the switch name) with key values the value of
33 the argument or 1 if no argument is specified.
34
35 =cut
36
37 @ISA = qw(Exporter);
38 @EXPORT = qw(getopt getopts);
39
40 # $RCSfile: getopt.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:23:58 $
41
42 # Process single-character switches with switch clustering.  Pass one argument
43 # which is a string containing all switches that take an argument.  For each
44 # switch found, sets $opt_x (where x is the switch name) to the value of the
45 # argument, or 1 if no argument.  Switches which take an argument don't care
46 # whether there is a space between the switch and the argument.
47
48 # Usage:
49 #       getopt('oDI');  # -o, -D & -I take arg.  Sets opt_* as a side effect.
50
51 sub getopt ($;$) {
52     local($argumentative, $hash) = @_;
53     local($_,$first,$rest);
54     local $Exporter::ExportLevel;
55
56     while (@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
57         ($first,$rest) = ($1,$2);
58         if (index($argumentative,$first) >= 0) {
59             if ($rest ne '') {
60                 shift(@ARGV);
61             }
62             else {
63                 shift(@ARGV);
64                 $rest = shift(@ARGV);
65             }
66           if (ref $hash) {
67               $$hash{$first} = $rest;
68           }
69           else {
70               ${"opt_$first"} = $rest;
71               push( @EXPORT, "\$opt_$first" );
72           }
73         }
74         else {
75           if (ref $hash) {
76               $$hash{$first} = 1;
77           }
78           else {
79               ${"opt_$first"} = 1;
80               push( @EXPORT, "\$opt_$first" );
81           }
82             if ($rest ne '') {
83                 $ARGV[0] = "-$rest";
84             }
85             else {
86                 shift(@ARGV);
87             }
88         }
89     }
90     $Exporter::ExportLevel++;
91     import Getopt::Std;
92 }
93
94 # Usage:
95 #   getopts('a:bc');    # -a takes arg. -b & -c not. Sets opt_* as a
96 #                       #  side effect.
97
98 sub getopts ($;$) {
99     local($argumentative, $hash) = @_;
100     local(@args,$_,$first,$rest);
101     local($errs) = 0;
102     local $Exporter::ExportLevel;
103
104     @args = split( / */, $argumentative );
105     while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
106         ($first,$rest) = ($1,$2);
107         $pos = index($argumentative,$first);
108         if($pos >= 0) {
109             if(defined($args[$pos+1]) and ($args[$pos+1] eq ':')) {
110                 shift(@ARGV);
111                 if($rest eq '') {
112                     ++$errs unless @ARGV;
113                     $rest = shift(@ARGV);
114                 }
115               if (ref $hash) {
116                   $$hash{$first} = $rest;
117               }
118               else {
119                   ${"opt_$first"} = $rest;
120                   push( @EXPORT, "\$opt_$first" );
121               }
122             }
123             else {
124               if (ref $hash) {
125                   $$hash{$first} = 1;
126               }
127               else {
128                   ${"opt_$first"} = 1;
129                   push( @EXPORT, "\$opt_$first" );
130               }
131                 if($rest eq '') {
132                     shift(@ARGV);
133                 }
134                 else {
135                     $ARGV[0] = "-$rest";
136                 }
137             }
138         }
139         else {
140             print STDERR "Unknown option: $first\n";
141             ++$errs;
142             if($rest ne '') {
143                 $ARGV[0] = "-$rest";
144             }
145             else {
146                 shift(@ARGV);
147             }
148         }
149     }
150     $Exporter::ExportLevel++;
151     import Getopt::Std;
152     $errs == 0;
153 }
154
155 1;
156