/IronPython_Main/Runtime/Tests/LinqDlrTests/testenv/perl/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;# Usage:
12;#      do Getopts('a:bc');  # -a takes arg. -b & -c not. Sets opt_* as a
13;#                           #  side effect.
14
15sub 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(\$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
661;