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