ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/cvsroot/staticperl/perl/lib/getopts.pl
Revision: 1.1
Committed: Thu Jun 30 14:27:09 2005 UTC (21 years, 4 months ago) by root
Content type: text/plain
Branch: MAIN
CVS Tags: PERL-5-8-7, HEAD
Branch point for: PERL
Log Message:
*** empty log message ***

File Contents

# User Rev Content
1 root 1.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     ;# Usage:
12     ;# do Getopts('a:bc'); # -a takes arg. -b & -c not. Sets opt_* as a
13     ;# # side effect.
14    
15     sub Getopts {
16     local($argumentative) = @_;
17     local(@args,$_,$first,$rest);
18     local($errs) = 0;
19     local($[) = 0;
20    
21     @args = split( / */, $argumentative );
22     while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
23     ($first,$rest) = ($1,$2);
24     $pos = index($argumentative,$first);
25     if($pos >= $[) {
26     if($args[$pos+1] eq ':') {
27     shift(@ARGV);
28     if($rest eq '') {
29     ++$errs unless(@ARGV);
30     $rest = shift(@ARGV);
31     }
32     eval "
33     push(\@opt_$first, \$rest);
34     if (!defined \$opt_$first or \$opt_$first eq '') {
35     \$opt_$first = \$rest;
36     }
37     else {
38     \$opt_$first .= ' ' . \$rest;
39     }
40     ";
41     }
42     else {
43     eval "\$opt_$first = 1";
44     if($rest eq '') {
45     shift(@ARGV);
46     }
47     else {
48     $ARGV[0] = "-$rest";
49     }
50     }
51     }
52     else {
53     print STDERR "Unknown option: $first\n";
54     ++$errs;
55     if($rest ne '') {
56     $ARGV[0] = "-$rest";
57     }
58     else {
59     shift(@ARGV);
60     }
61     }
62     }
63     $errs == 0;
64     }
65    
66     1;