1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
|
;# NAME
;# newgetopts.pl - a better newgetopt (which is a better getopts which is
;# a better getopt ;-)
;#
;# AUTHOR
;# Mike Muegel (mmuegel@mot.com)
;#
;# mmuegel
;# /usr/local/ustart/src/mail-tools/dist/foo/libs/newgetopts.pl,v 1.1 1993/07/28 08:07:19 mmuegel Exp
;###############################################################################
;# New_Getopts
;#
;# Does not care about order of switches, options, and arguments like
;# getopts.pl. Thus all non-switches/options will be kept in ARGV even if they
;# are not at the end. If $Pass_Invalid is set all unkown options will be
;# passed back to the caller by keeping them in @ARGV. This is useful when
;# parsing a command line for your script while ignoring options that you
;# may pass to another script. If this is set New_Getopts tries to maintain
;# the switch clustering on the unkown switches.
;#
;# Accepts the special argument -usage to print the Usage string. Also accepts
;# the special option -version which prints the contents of the string
;# $VERSION. $VERSION may or may not have an embeded \n in it. If -usage
;# or -version are specified a status of -1 is returned. Note that the usage
;# option is only accepted if the usage string is not null.
;#
;# $Switches is just like the formal arguemnt of getopts.pl. $Usage is a usage
;# string with or without a trailing \n. *Switch_To_Order is an optional
;# pointer to the name of an associative array which will contain a mapping of
;# switch names to the order in which (if at all) the argument was entered.
;#
;# For example, if @ARGV contains -v, -x, test:
;#
;# $Switch_To_Order {"v"} = 1;
;# $Switch_To_Order {"x"} = 2;
;#
;# Note that in the case of multiple occurances of an option $Switch_To_Order
;# will store each occurance of the argument via a string that emulates
;# an array. This is done by using join ($;, ...). You can retrieve the
;# array by using split (/$;/, ...).
;#
;# *Split_ARGV is an optional pointer to an array which will conatin the
;# original switches along with their values. For the example used above
;# Split_ARGV would contain:
;#
;# @Split_ARGV = ("v", "", "x", "test");
;#
;# Another exciting ;-) feature that newgetopts has. Along with creating the
;# normal $opt_ scalars for the last value of an argument the list @opt_ is
;# created. It is an array which contains all the values of arguments to the
;# basename of the variable. They are stored in the order which they occured
;# on the command line starting with $[. Note that blank arguments are stored
;# as "". Along with providing support for multiple options on the command
;# line this also provides a method of counting the number of times an option
;# was specified via $#opt_.
;#
;# Automatically resets all $opt_, @opt_, %Switch_To_Order, and @Split_ARGV
;# variables so that New_Getopts may be called more than once from within
;# the same program. Thus, if $opt_v is set upon entry to New_Getopts and
;# -v is not in @ARGV $opt_v will not be set upon exit.
;#
;# Arguments:
;# $Switches, $Usage, $Pass_Invalid, *Switch_To_Order, *Split_ARGV
;#
;# Returns:
;# -1, 0, or 1 depending on status (printed Usage/Version, OK, not OK)
;###############################################################################
sub New_Getopts
{
local($taint_argumentative, $Usage, $Pass_Invalid, *Switch_To_Order,
*Split_ARGV) = @_;
local(@args,$_,$first,$rest,$errs, @leftovers, @current_leftovers,
%Switch_Found);
local($[, $*, $Script_Name, $argumentative);
# Untaint the argument cluster so that we can use this with taintperl
$taint_argumentative =~ /^(.*)$/;
$argumentative = $1;
# Clear anything that might still be set from a previous New_Getopts
# call.
@Split_ARGV = ();
# Get the basename of the calling script
($Script_Name = $0) =~ s/.*\///;
# Make Usage have a trailing \n
$Usage .= "\n" if ($Usage !~ /\n$/);
@args = split( / */, $argumentative );
# Clear anything that might still be set from a previous New_Getopts call.
foreach $first (@args)
{
next if ($first eq ":");
delete $Switch_Found {$first};
delete $Switch_To_Order {$first};
eval "undef \@opt_$first; undef \$opt_$first;";
};
while (@ARGV)
{
# Let usage through
if (($ARGV[0] eq "-usage") && ($Usage ne "\n"))
{
print $Usage;
exit (-1);
}
elsif ($ARGV[0] eq "-version")
{
if ($VERSION)
{
print $VERSION;
print "\n" if ($VERSION !~ /\n$/);
}
else
{
warn "${Script_Name}: no version information available, sorry\n";
}
exit (-1);
}
elsif (($_ = $ARGV[0]) =~ /^-(.)(.*)/)
{
($first,$rest) = ($1,$2);
$pos = index($argumentative,$first);
$Switch_To_Order {$first} = join ($;, split (/$;/, $Switch_To_Order {$first}), ++$Order);
if($pos >= $[)
{
if($args[$pos+1] eq ':')
{
shift(@ARGV);
if($rest eq '')
{
$rest = shift(@ARGV);
}
eval "\$opt_$first = \$rest;";
eval "push (\@opt_$first, \$rest);";
push (@Split_ARGV, $first, $rest);
}
else
{
eval "\$opt_$first = 1";
eval "push (\@opt_$first, '');";
push (@Split_ARGV, $first, "");
if($rest eq '')
{
shift(@ARGV);
}
else
{
$ARGV[0] = "-$rest";
}
}
}
else
{
# Save any other switches if $Pass_Valid
if ($Pass_Invalid)
{
push (@current_leftovers, $first);
}
else
{
warn "${Script_Name}: unknown option: $first\n";
++$errs;
};
if($rest ne '')
{
$ARGV[0] = "-$rest";
}
else
{
shift(@ARGV);
}
}
}
else
{
push (@leftovers, shift (@ARGV));
};
# Save any other switches if $Pass_Valid
if ((@current_leftovers) && ($rest eq ''))
{
push (@leftovers, "-" . join ("", @current_leftovers));
@current_leftovers = ();
};
};
# Automatically print Usage if a warning was given
@ARGV = @leftovers;
if ($errs != 0)
{
warn $Usage;
return (0);
}
else
{
return (1);
}
}
1;
|
