Time::Local in blead has diverged from CPAN. Update the version number to a dev release
[perl.git] / lib / getopts.pl
1 ;# getopts.pl - a better getopt.pl
2 #
3 # This library is no longer being maintained, and is included for backward
4 # compatibility with Perl 4 programs which may require it.
5 #
6 # In particular, this should not be used as an example of modern Perl
7 # programming techniques.
8 #
9 # Suggested alternatives: Getopt::Long  or  Getopt::Std
10
11 warn( "The 'getopts.pl' legacy library is deprecated and will be"
12       . " removed in the next major release of perl. Please use the"
13       . " Getopt::Long or Getopt::Std module instead." );
14
15 ;# Usage:
16 ;#      do Getopts('a:bc');  # -a takes arg. -b & -c not. Sets opt_* as a
17 ;#                           #  side effect.
18
19 sub Getopts {
20     local($argumentative) = @_;
21     local(@args,$_,$first,$rest);
22     local($errs) = 0;
23     local($[) = 0;
24
25     @args = split( / */, $argumentative );
26     while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
27                 ($first,$rest) = ($1,$2);
28                 $pos = index($argumentative,$first);
29                 if($pos >= $[) {
30                         if($args[$pos+1] eq ':') {
31                                 shift(@ARGV);
32                                 if($rest eq '') {
33                                         ++$errs unless(@ARGV);
34                                         $rest = shift(@ARGV);
35                                 }
36                                 eval "
37                                 push(\@opt_$first, \$rest);
38                                 if (!defined \$opt_$first or \$opt_$first eq '') {
39                                         \$opt_$first = \$rest;
40                                 }
41                                 else {
42                                         \$opt_$first .= ' ' . \$rest;
43                                 }
44                                 ";
45                         }
46                         else {
47                                 eval "\$opt_$first = 1";
48                                 if($rest eq '') {
49                                         shift(@ARGV);
50                                 }
51                                 else {
52                                         $ARGV[0] = "-$rest";
53                                 }
54                         }
55                 }
56                 else {
57                         print STDERR "Unknown option: $first\n";
58                         ++$errs;
59                         if($rest ne '') {
60                                 $ARGV[0] = "-$rest";
61                         }
62                         else {
63                                 shift(@ARGV);
64                         }
65                 }
66         }
67     $errs == 0;
68 }
69
70 1;