58 lines
1.2 KiB
Perl
58 lines
1.2 KiB
Perl
;# getopts.pl - a better getopt.pl
|
|
#
|
|
# This library is no longer being maintained, and is included for backward
|
|
# compatibility with Perl 4 programs which may require it.
|
|
#
|
|
# In particular, this should not be used as an example of modern Perl
|
|
# programming techniques.
|
|
#
|
|
# Suggested alternatives: Getopt::Long or Getopt::Std
|
|
#
|
|
;# Usage:
|
|
;# do Getopts('a:bc'); # -a takes arg. -b & -c not. Sets opt_* as a
|
|
;# # side effect.
|
|
|
|
sub Getopts {
|
|
local($argumentative) = @_;
|
|
local(@args,$_,$first,$rest);
|
|
local($errs) = 0;
|
|
|
|
@args = split( / */, $argumentative );
|
|
while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
|
|
($first,$rest) = ($1,$2);
|
|
$pos = index($argumentative,$first);
|
|
if($pos >= 0) {
|
|
if($pos < $#args && $args[$pos+1] eq ':') {
|
|
shift(@ARGV);
|
|
if($rest eq '') {
|
|
++$errs unless @ARGV;
|
|
$rest = shift(@ARGV);
|
|
}
|
|
${"opt_$first"} = $rest;
|
|
}
|
|
else {
|
|
${"opt_$first"} = 1;
|
|
if($rest eq '') {
|
|
shift(@ARGV);
|
|
}
|
|
else {
|
|
$ARGV[0] = "-$rest";
|
|
}
|
|
}
|
|
}
|
|
else {
|
|
print STDERR "Unknown option: $first\n";
|
|
++$errs;
|
|
if($rest ne '') {
|
|
$ARGV[0] = "-$rest";
|
|
}
|
|
else {
|
|
shift(@ARGV);
|
|
}
|
|
}
|
|
}
|
|
$errs == 0;
|
|
}
|
|
|
|
1;
|