diff options
Diffstat (limited to 'Master/tlpkg/tlperl0/lib/getopts.pl')
-rwxr-xr-x | Master/tlpkg/tlperl0/lib/getopts.pl | 66 |
1 files changed, 66 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl0/lib/getopts.pl b/Master/tlpkg/tlperl0/lib/getopts.pl new file mode 100755 index 00000000000..e30820a3189 --- /dev/null +++ b/Master/tlpkg/tlperl0/lib/getopts.pl @@ -0,0 +1,66 @@ +;# 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; + local($[) = 0; + + @args = split( / */, $argumentative ); + while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) { + ($first,$rest) = ($1,$2); + $pos = index($argumentative,$first); + if($pos >= $[) { + if($args[$pos+1] eq ':') { + shift(@ARGV); + if($rest eq '') { + ++$errs unless(@ARGV); + $rest = shift(@ARGV); + } + eval " + push(\@opt_$first, \$rest); + if (!defined \$opt_$first or \$opt_$first eq '') { + \$opt_$first = \$rest; + } + else { + \$opt_$first .= ' ' . \$rest; + } + "; + } + else { + eval "\$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; |