X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/55204971972392ce5a252fbbd6d78b1c48ed70e3..c1741bad1bfa5215302880114d7b0b580cf8f0c1:/lib/getopts.pl diff --git a/lib/getopts.pl b/lib/getopts.pl index 6590918..37ecb4a 100644 --- a/lib/getopts.pl +++ b/lib/getopts.pl @@ -1,4 +1,14 @@ +warn "Legacy library @{[(caller(0))[6]]} will be removed from the Perl core distribution in the next major release. Please install it from the CPAN distribution Perl4::CoreLibs. It is being used at @{[(caller)[1]]}, line @{[(caller)[2]]}.\n"; + ;# 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 @@ -8,41 +18,49 @@ 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 '') { - $rest = shift(@ARGV); - } - eval "\$opt_$first = \$rest;"; - } - else { - eval "\$opt_$first = 1"; - if($rest eq '') { - shift(@ARGV); + ($first,$rest) = ($1,$2); + $pos = index($argumentative,$first); + if($pos >= 0) { + 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 { - $ARGV[0] = "-$rest"; + print STDERR "Unknown option: $first\n"; + ++$errs; + if($rest ne '') { + $ARGV[0] = "-$rest"; + } + else { + shift(@ARGV); + } } - } - } - else { - print STDERR "Unknown option: $first\n"; - ++$errs; - if($rest ne '') { - $ARGV[0] = "-$rest"; - } - else { - shift(@ARGV); - } } - } $errs == 0; }