/usr/share/doc/libgetopt-tabular-perl/examples/demo is in libgetopt-tabular-perl 0.3-2.
This file is owned by root:root, with mode 0o755.
The actual contents of the file can be viewed below.
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";
|