1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
|
#!/usr/bin/perl -w
# Example program for the Getopt::Tabular package. See Getopt/Tabular.pod
# for detailed explanation of How Things Work.
#
# originally by Greg Ward 1995/07/06 - 1995/07/09 (for ParseArgs package)
# adapted to Getopt::Tabular 1996/11/10
use Getopt::Tabular qw/GetOptions SetError/;
# Data needed for parsing command line options
@Ints = (0, 0); # you don't really need to supply pre-defined
$Float = 0; # values -- I just do it here to avoid
$String = ""; # "Identifier used only once" warnings
@UStrings = ();
$Flag = 0;
@Foo = ();
$help = <<"EOH";
This is a pretty useless program. All it does is demonstrate my
Getopt::Tabular package.
EOH
$usage = <<"EOH";
Usage: $0 [options]
EOH
# Here's the important bit: the option table. The *first* element of each
# entry is the option name, which can be whatever you like; the *second*
# element is the option type, which must be one of string, integer, float,
# constant, boolean, copy, arrayconst, hashconst, call, or eval.
&Getopt::Tabular::AddPatternType
("upperstring", "[A-Z]+",
["string of uppercase letters", "strings of uppercase letters"]);
@opt_table = (["-int", "integer", 2, \@Ints, "two integers",
"i1 i2"],
["-float", "float", 1, \$Float, "a floating-point number" ],
["-string", "string", 1, \$String, "a string" ],
["-ustring","upperstring",3,\@UStrings,
"an uppercase string (example of a user-defined pattern type)"],
["-flag", "boolean", 0, \$Flag, "a boolean flag" ],
["-foo", "call", 0, \&get_foo, "do nothing important"],
["-show", "eval", 0, 'print "Ints = @Ints\n";',
"print the current values of -int option"]
);
# Here's an example subroutine used by the "-foo" option -- note that
# it modifies the list referenced by its second argument, which is perfectly
# legal; this modification propagates back up to change @ARGV after
# &GetOptions is finished.
sub get_foo
{
my ($arg, $args) = @_;
my $next;
print "Hello, you have used the $arg option\n";
unless (@$args)
{
&SetError ("bad_foo", "no arguments found for $arg option");
return 0;
}
while ($next = shift @$args)
{
last if $next =~ /^-/;
push (@Foo, $next);
print "Got $next from \@\$args\n";
}
if (defined $next) # not the last option?
{
print "Putting $next back on \@\$args\n";
unshift (@$args, $next);
}
1;
}
# Here's where we actually do real work -- set the two help messages
# (the summary of options is generated automatically) and then parse
# those arguments.
&Getopt::Tabular::SetHelp ($help, $usage);
#&GetOptions (\@opt_table, \@ARGV) || exit 1;
if (! &GetOptions (\@opt_table, \@ARGV, \@newARGV))
{
die "GetOptions returned error status; reason: $Getopt::Tabular::ErrorClass\n";
}
print <<"END";
Values after parsing:
\$Ints = @Ints
\$Float = $Float
\$String = $String
\@UStrings = @UStrings
\$Flag = $Flag
\@Foo = @Foo
END
print " Original arguments: @ARGV\n";
print "Remaining arguments: @newARGV\n";
|
