Getopt::Long and anonymous subroutine - perl

I've written the following code:
my $version = sub {
print "$PROGNAME $VERSION - $AUTHOR\n";
exit 0;
};
my $usage = sub {
print "Usage: proll <options>\n";
print "Available options:\n";
print " -h, --help Print this help and exit.\n";
print " --version Print version.\n";
print " XdY Launch X dice with Y faces.\n";
exit 0;
};
my $ret = GetOptions ( "version" => \$version,
"h|help" => \$usage );
But also if I call the script with --version or --help it doesn't call the subroutine. Where am I wrong?
And if I change the code as follows, it always call the first subroutine also without any command line parameter:
my $ret = GetOptions ( "version" => &$version,
"h|help" => &$usage );

\$version is a reference to $version, where $version is a reference to an anonymous subroutine; so, \$version is a reference to a reference to a subroutine. That's too much indirection. You just need a single level of reference-ness:
my $ret = GetOptions ( "version" => $version,
"h|help" => $usage );

Related

GetOptions Check Option Values

I am updating an existing Perl script that uses GetOptions from Getopt::Long. I want to add an option that takes a string as its parameter and can only have one of 3 values: small, medium, or large. Is there any way to make Perl throw an error or kill the script if any other string value is specified? So far I have:
my $value = 'small';
GetOptions('size=s' => \$value);
You could use a subroutine to handle the processing of that option.
User-defined subroutines to handle options
my $size = 'small'; # default
GetOptions('size=s' => \&size);
print "$size\n";
sub size {
my %sizes = (
small => 1,
medium => 1,
large => 1
);
if (! exists $sizes{$_[1]}) {
# die "$_[1] is not a valid size\n";
# Changing it to use an exit statement works as expected
print "$_[1] is not a valid size\n";
exit;
}
$size = $_[1];
}
I put the sizes into a hash, but you could use an array and grep as toolic showed.
One way is to use grep to check if the value is legal:
use warnings;
use strict;
use Getopt::Long;
my $value = 'small';
GetOptions('size=s' => \$value);
my #legals = qw(small medium large);
die "Error: must specify one of #legals" unless grep { $_ eq $value } #legals;
print "$value\n";
It's just one of a few checks you need to perform after GetOptions returned.
You need to check if GetOptions succeeded.
You may need to check the value provided for each optional argument.
You may need to check the number of arguments in #ARGV.
You may need to check the arguments in #ARGV.
Here's how I perform those checks:
use Getopt::Long qw( );
my %sizes = map { $_ => 1 } qw( small medium large );
my $opt_size;
sub parse_args {
Getopt::Long::Configure(qw( :posix_default ));
$opt_size = undef;
Getopt::Long::GetOptions(
'help|h|?' => \&exit_with_usage,
'size=s' => \$opt_size,
)
or exit_bad_usage();
exit_bad_usage("Invalid size.\n")
if defined($size) && !$sizes{$size};
exit_bad_usage("Invalid number of arguments.\n")
if #ARGV;
}
Here's how I handle failures:
use File::Basename qw( basename );
sub exit_with_usage {
my $prog = basename($0);
print("usage: $prog [options]\n");
print(" $prog --help\n");
print("\n");
print("Options:");
print(" --size {small|medium|large}\n");
print(" Controls the size of ...\n"
exit(0);
}
sub exit_bad_usage {
my $prog = basename($0);
warn(#_) if #_;
die("Use $prog --help for help\n");
exit(1);
}
This might be overkill, but also take a look Getopt::Again, which implements validation through its process configuration value per command line argument.
use strict;
use warnings;
use Getopt::Again;
opt_add my_opt => (
type => 'string',
default => 'small',
process => qr/^(?:small|medium|large)$/,
description => "My option ...",
);
my (%opts, #args) = opt_parse(#ARGV);
An alternative to Getopt::Long is Getopt::Declare which has built in pattern support, but is slightly more verbose:
use strict;
use warnings;
use feature qw/say/;
use Getopt::Declare;
my $args = Getopt::Declare->new(
join "\n",
'[strict]',
"-size <s:/small|medium|large/>\t small, medium, or large [required]"
) or exit(1);
say $args->{-size};
Test runs:
[hmcmillen]$ perl test.pl -size small
small
[hmcmillen]$ perl test.pl -size medium
medium
[hmcmillen]$ perl test.pl -size large
large
[hmcmillen]$ perl test.pl -size extra-large
Error: incorrect specification of '-size' parameter
Error: required parameter -size not found.
Error: unrecognizable argument ('extra-large')
(try 'test.pl -help' for more information)

parse all arguments and store to hash

How can i parse all the arbitrary arguments to a hash without specifying the argument names inside my perl script.
Running command with below argument should give hash like below.
-arg1=first --arg2=second -arg3 -arg4=2.0013 -arg5=100
{
'arg2' => 'second',
'arg1' => 'first',
'arg4' => '2.0013',
'arg3' => 1,
'arg5' => 100
};
This can be achieved using Getopt::Long as below
GetOptions(\%hash,
"arg1=s",
"arg2=s",
"arg3",
"arg4=f",
"arg5=i");
However, my argument list is too long and i don't want to specify argument names in GetOptions.
So a call to GetOptions with only hash as a parameter should figure out what arguments are (and their type integer/string/floats/lone arguments) and just create a hash.
There are a lot of Getopt modules. The following are some that will just slurp everything into a hash like you desire:
Getopt::Mini
Getopt::Whatever
Getopt::Casual
I personally would never do something like this though, and have no real world experience with any of these modules. I'd always aim to validate every script for both error checking and as a means to self-document what the script is doing and uses.
Try this:
#!/usr/bin/perl
use warnings;
use strict;
use Data::Dumper;
sub getOptions {
my (%opts, #args);
while (#_) {
my $opt = shift;
if ($opt =~ /^-/) {
if ($opt =~ /-+([^=]+)(?:=(.+))?/) {
$opts{$1} = $2 ? $2 : 1;
}
}
else {
push #args, $opt;
}
}
return (\%opts, \#args);
}
my ($opts, $args) = getOptions(#ARGV);
print Dumper($opts, $args);
Testing:
$ perl t.pl -arg1=first --arg2=second -arg3 -arg4=2.0013 -arg5=100 datafile
$VAR1 = {
'arg2' => 'second',
'arg1' => 'first',
'arg4' => '2.0013',
'arg3' => 1,
'arg5' => '100'
};
$VAR2 = [
'datafile'
];
This will work as expected for your example,
my %hash = map { s/^-+//; /=/ ? split(/=/, $_, 2) : ($_ =>1) } #ARGV;

Perl Getopt::Long Assigning variable then going to subroutine

I have the following piece of code
my $use = "Use: " . basename($0) . " [options]";
my $version = "Version: 0.1 \n";
my $variableA;
my $variableB;
GetOptions(
'a=s' => \$variableA,
'help' => sub { print $use; exit 0 },
'version' => sub { print $version; exit 0 },
'b' => sub { \$variableB, &this_subroutine; goto NOWGOHERE; },
);
die "Incorrect use. \n" unless (defined $variableA || defined $variableB);
sub this_subroutine {
print "$variableB\n";
}
NOWGOHERE: print "HELLO I'M NOW HERE\n";
What I am trying to do is set $variableB and then do the &this_subroutine and the goto NOWGOHERE but I can only get it to do one or the other, not both, using either 'b=s' => \$variableB, or sub { &this_subroutine; goto NOWGOHERE;0 },
When trying to do both I cannot seem to print the $variableB, is there something obvious I am missing or doing wrong syntactically?
Using 'b=s' => \$variableB, sub { &this_subroutine; goto NOWGOHERE; }, does not seem to work either?
your help is much appreciated, many thanks
$variableB will never have a value because you never assign to it.
'a=s' => \$variableA,
gives $variableA a value because, when Getopt::Long is given a scalar ref, it assigns the option's value to that scalar.
On the other hand,
'b' => sub { \$variableB, &this_subroutine; goto NOWGOHERE; },
gives Getopt::Long a code reference, which it can't assign the option value to.
Based on the docs, it appears that it passes the option name and option value to the coderef as parameters, in which case
'b=s' => sub { $variableB = $_[1]; this_subroutine(); goto NOWGOHERE; },
should probably do what you want.

File::Find::Rule::LibMagic: Is it ok to keep options with undefined values?

Is it OK to keep options with undefined values (in this case 'maxdepth')?
#!/usr/bin/env perl
use warnings;
use 5.012;
use File::Find::Rule::LibMagic qw(find);
use Getopt::Long qw(GetOptions);
my $max_depth;
GetOptions ( 'max-depth=i' => \$max_depth );
my $dir = shift;
my #dbs = find( file => magic => 'SQLite*', maxdepth => $max_depth, in => $dir );
say for #dbs;
Or should I write it like this:
if ( defined $max_depth ) {
#dbs = find( file => magic => 'SQLite*', maxdepth => $max_depth, in => $dir );
} else {
#dbs = find( file => magic => 'SQLite*', in => $dir );
}
There should be no problem in having maxdepth set to undef by using a variable with undef as its value. Every variable in Perl starts out with the undef value.
More Details
File::Find::Rule::LibMagic extends File::Find::Rule. The find function in File::Find::Rule starts with:
sub find {
my $object = __PACKAGE__->new();
The new functions returns:
bless {
rules => [],
subs => {},
iterator => [],
extras => {},
maxdepth => undef,
mindepth => undef,
}, $class;
Note that maxdepth by default is set to undef.
OK? It probably won't confuse File::Find::Rule
$ perl -MFile::Find::Rule -le " print for File::Find::Rule->maxdepth(undef)->in( q/tope/ ) "
tope
tope/a
tope/b
tope/c
tope/c/0
tope/c/1
tope/c/2
$ perl -MFile::Find::Rule -le " print for File::Find::Rule->maxdepth(1)->in( q/tope/ ) "
tope
tope/a
tope/b
tope/c
$ perl -MFile::Find::Rule -le " print for File::Find::Rule->maxdepth(-1)->in( q/tope/ ) "
tope
$ perl -MFile::Find::Rule -le " print for File::Find::Rule->maxdepth(2)->in( q/tope/ ) "
tope
tope/a
tope/b
tope/c
tope/c/0
tope/c/1
tope/c/2
$ pmvers File::Find::Rule
0.33

Perl Getopt::Long Related Question - Mutually Exclusive Command-Line Arguments

I have the following code in my perl script:
my $directory;
my #files;
my $help;
my $man;
my $verbose;
undef $directory;
undef #files;
undef $help;
undef $man;
undef $verbose;
GetOptions(
"dir=s" => \$directory, # optional variable with default value (false)
"files=s" => \#files, # optional variable that allows comma-separated
# list of file names as well as multiple
# occurrenceces of this option.
"help|?" => \$help, # optional variable with default value (false)
"man" => \$man, # optional variable with default value (false)
"verbose" => \$verbose # optional variable with default value (false)
);
if (#files) {
#files = split(/,/,join(',', #files));
}
What is the best way to handle mutually exclusive command line arguments? In my script I only want the user to enter only the "--dir" or "--files" command line argument but not both. Is there anyway to configure Getopt to do this?
Thanks.
I don't think there is a way in Getopt::Long to do that, but it is easy enough to implement on your own (I am assuming there is a usage function that returns a string that tells the user how to call the program):
die usage() if defined $directory and #files;
Why not just this:
if ($directory && #files) {
die "dir and files options are mutually exclusive\n";
}
You can simply check for the existence of values in both variables.
if(#files && defined $directory) {
print STDERR "You must use either --dir or --files, but not both.\n";
exit 1;
}
Or, if you would like to simply ignore any options specified after the first --dir or --files, you can point both at a function.
#!/usr/bin/perl
use Getopt::Long;
my $directory;
my #files;
my $mode;
my $help;
my $man;
my $verbose;
GetOptions(
"dir=s" => \&entries, # optional variable with default value (false)
"files=s" => \&entries, # optional variable that allows comma-separated
# list of file names as well as multiple
# occurrences of this option.
"help|?" => \$help, # optional variable with default value (false)
"man" => \$man, # optional variable with default value (false)
"verbose" => \$verbose # optional variable with default value (false)
);
sub entries {
my($option, $value) = #_;
if(defined $mode && $mode ne $option) {
print STDERR "Ignoring \"--$option $value\" because --$mode already specified...\n";
}
else {
$mode = $option unless(defined $mode);
if($mode eq "dir") {
$directory = $value;
}
elsif($mode eq "files") {
push #files, split(/,/, $value);
}
}
return;
}
print "Working on directory $directory...\n" if($mode eq "dir");
print "Working on files:\n" . join("\n", #files) . "\n" if($mode eq "files");
You can do this with Getopt::Long::Descriptive. It's a bit different from Getopt::Long, but if you're printing a usage summary, it helps to reduce duplication by doing all that for you.
Here, I've added a hidden option called source, so $opt->source which will contain the value dir or files depending on which option was given, and it will enforce the one_of constraint for you. The values given will be in $opt->dir or $opt->files, whichever one was given.
my ( $opt, $usage ) = describe_options(
'%c %o',
[ "source" => hidden => {
'one_of' => [
[ "dir=s" => "Directory" ],
[ "files=s#" => "FilesComma-separated list of files" ],
]
} ],
[ "man" => "..." ], # optional variable with default value (false)
[ "verbose" => "Provide more output" ], # optional variable with default value (false)
[],
[ 'help|?' => "Print usage message and exit" ],
);
print( $usage->text ), exit if ( $opt->help );
if ($opt->files) {
#files = split(/,/,join(',', #{$opt->files}));
}
The main difference for the rest of your script is that all the options are contained as methods of the $opt variable, rather than each one having its own variable like with Getopt::Long.
use strict;
use warnings;
use Getopt::Long;
my($directory,#files,$help,$man,$verbose);
GetOptions(
'dir=s' => sub {
my($sub_name,$str) = #_;
$directory = $str;
die "Specify only --dir or --files" if #files;
},
# optional variable that allows comma-separated
# list of file names as well as multiple
# occurrences of this option.
'files=s' => sub {
my($sub_name,$str) = #_;
my #s = split ',', $str;
push #files, #s;
die "Specify only --dir or --files" if $directory;
},
"help|?" => \$help,
"man" => \$man,
"verbose" => \$verbose,
);
use Pod::Usage;
pod2usage(1) if $help;
pod2usage(-exitstatus => 0, -verbose => 2) if $man;
=head1 NAME
sample - Using Getopt::Long and Pod::Usage
=head1 SYNOPSIS
sample [options] [file ...]
Options:
-help brief help message
-man full documentation
=head1 OPTIONS
=over 8
=item B
Print a brief help message and exits.
=item B
Prints the manual page and exits.
=back
=head1 DESCRIPTION
B will read the given input file(s) and do something
useful with the contents thereof.
=cut