Getopt::Long::Configure("no_pass_through");
my %opts = ();
GetOptions(\%opts,
'opt1=s',
'opt2=s',
'opt3'
);
test.pl bad_option_without_dash
How do I make getopts flag an error when a bad option is passed without a dash? I was expecting that no_pass_through will take care of this. What am I missing?
Getopt::Long just extracts the options. It's up to you to validate the value of those options and the non-option arguments (which are left in #ARGV).
Specifically, if you want to make sure that only options have been passed, then you can use
#ARGV == 0
or die("usage\n");
What I use:
use Getopt::Long qw( );
my ( $opt_opt1, $opt_opt2, $opt_opt3 );
sub parse_args {
( $opt_opt1, $opt_opt2, $opt_opt3 ) = ();
Getopt::Long::Configure(qw( posix_default ));
Getopt::Long::GetOptions(
'help|h|?' => \&help,
'opt1=s' => \$opt_opt1,
'opt2=s' => \$opt_opt2,
'opt3' => \$opt_opt3,
)
or usage();
# Validate $opt_* here if necessary.
!#ARGV
or usage("Too many arguments.");
return #ARGV;
}
sub main {
# my () = #_; # This program doesn't accept non-option args.
...
}
main(parse_args());
Helpers:
use File::Basename qw( basename );
sub help {
my $prog = basename($0);
print
"Usage:
$prog [options]
$prog --help
Options:
--opt1 FOO
...
--opt2 BAR
...
--opt3
...
";
exit(0);
}
sub usage {
if (#_) {
my ($msg) = #_;
chomp($msg);
say STDERR $msg;
}
my $prog = basename($0);
say STDERR "Try '$prog --help' for more information.";
exit(1);
}
Getopt::Long operates only on options: arguments starting with hyphens. Without passthrough (no_pass_through is the default) it will remove them from #ARGV, leaving any non-option arguments for you to handle. If you expected no non-option arguments, you could determine that options were passed incorrectly if any arguments remain after calling GetOptions.
die "Usage: $0 [--opt1=string] [--opt2=string] [--opt3]\n" if #ARGV;
The return value of GetOptions is also useful, as it will indicate whether any unrecognized or invalid options were found.
GetOptions(...) or die "Usage: $0 ...\n";
Options are denoted with a leading dash (hyphen); arguments are not.
You might find Getopt::Long Argument-callback useful:
A special option 'name' <> can be used to designate a subroutine to handle non-option arguments. When GetOptions() encounters an argument that does not look like an option, it will immediately call this subroutine and passes it one parameter: the argument name.
Related
I'm modifying a perl script in which the command line arguments are parsed like this:
if ($arg eq "-var1") {
$main::variable1 = shift(#arguments)
} elsif ($arg eq "-var2") {
$main::variable2 = shift(#arguments)
} elsif ($arg eq "var3") {
$main::variable3 = shift(#arguments)
} ...
So there is a whole bunch of elsif statements to cover all command-line arguments.
I'm now in a situaton where I want to use the argument '-var2' multiple times.
So my main::variable2 should maybe be an array that contains all values that are passed with "-var2".
I found that with Perl::getopt, this can be easily achieved (Perl Getopt Using Same Option Multiple Times).
However the way that my script parses its command-line arguments is different. So I was wondering if it could be achieved, without having to change the way the arguments are parsed.
That's not your actual code, is it? It won't even compile.
I'd be really surprised if Getopt::Long can't solve your problem and it's really a better idea to use a library rather than writing your own code.
But changing your code to store -var2 options in an array is simple enough.
my ($variable1, #variable2, $variable3);
if ($arg eq "-var1") {
$variable1 = shift(#arguments)
} elsif ($arg eq "-var2") {
push #variable2, shift(#arguments)
} elsif ($arg eq "-var3") {
$variable3 = shift(#arguments)
}
(I've also removed the main:: from your variables and added the, presumably missing, $s. It's really unlikely that you want to be using package variables rather than lexical variables.)
This particular wheel already exists. Please don't try to reinvent it. That just makes it a pain for the people trying to use your script. There's no reason to force people to learn a whole new set of rules in order to execute your program.
use File::Basename qw( basename );
use Getopt::Long qw( );
my $foo;
my #bars;
my $baz;
sub help {
my $prog = basename($0);
print
"Usage:
$prog [options]
$prog --help
Options:
--foo foo
...
--bar bar
May be used multiple times.
...
--baz baz
...
";
exit(0);
}
sub usage {
if (#_) {
my ($msg) = #_;
chomp($msg);
say STDERR $msg;
}
my $prog = basename($0);
say STDERR "Try '$prog --help' for more information.";
exit(1);
}
sub parse_args {
Getopt::Long::Configure(qw( posix_default ));
Getopt::Long::GetOptions(
"help" => \&help,
"foo=s" => \$foo,
"bar=s" => \#bars,
"baz=s" => \$baz,
)
or usage();
!#ARGV
or usage("Too many arguments");
return #ARGV;
}
main(parse_args());
Well, it is good practice to document your core -- you would appreciate it as soon as you return to make changes
NOTE: in Linux it requires perl-doc package to be installed to use --man option in full extent
#!/usr/bin/perl
#
# Description:
# Describe purpose of the program
#
# Parameters:
# Describe parameters purpose
#
# Date: Tue Nov 29 1:18:00 UTC 2019
#
use warnings;
use strict;
use Getopt::Long qw(GetOptions);
use Pod::Usage;
my %opt;
GetOptions(
'input|i=s' => \$opt{input},
'output|o=s' => \$opt{output},
'debug|d' => \$opt{debug},
'help|?' => \$opt{help},
'man' => \$opt{man}
) or pod2usage(2);
pod2usage(1) if $opt{help};
pod2usage(-exitval => 0, -verbose => 2) if $opt{man};
print Dumper(\%opt) if $opt{debug};
__END__
=head1 NAME
program - describe program's functionality
=head1 SYNOPSIS
program.pl [options]
Options:
-i,--input input filename
-o,--output output filename
-d,--debug output debug information
-?,--help brief help message
--man full documentation
=head1 OPTIONS
=over 4
=item B<-i,--input>
Input filename
=item B<-o,--output>
Output filename
=item B<-d,--debug>
Print debug information.
=item B<-?,--help>
Print a brief help message and exits.
=item B<--man>
Prints the manual page and exits.
=back
B<This program> accepts B<several parameters> and operates with B<them> to produce some B<result>
=cut
Using Getopt::Long, I want to capture any failures from GetOptions and, rather than printing them to STDOUT/STDERR, I want to print out a Usage string and exit the script. I tried wrapping the call to GetOptions in a Try::Tiny try/catch block, but it doesn't get caught. I'm not sure what's going on behind the scenes here.
How can I capture a failure in GetOptions, prevent it from printing, and print my own usage statement instead?
It uses warn, so you could use $SIG{__WARN__}. I would say it's better to provide a usage statement in addition to the specific error found by GetOptions.
sub usage {
my $prog = basename($0);
if (my ($msg) = #_) {
chomp($msg);
warn("$msg\n");
}
warn("Try `$prog --help' for more information.\n");
exit(1);
}
sub help {
my $prog = basename($0);
print(<<"__EOS__");
usage: $prog [options] [--] {foo} {bar}
$prog --help
Options:
...
__EOS__
exit(0);
}
sub parse_args {
GetOptions(
'h|?|help' => \&help,
...,
)
or usage();
#ARGV == 2
or usage("Too many arguments.");
}
Here's what I do:
eval {
local $SIG{__WARN__} = sub { die $_[0] };
GetOptions( \%opt, ... );
};
if ( $# ) {
...
}
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)
I'm writing a System::Wrapper module to abstract away from CORE::system and the qx operator. I have a serial method that attempts to connect command1's output to command2's input. I've made some progress using named pipes, but POSIX::mkfifo is not cross-platform.
Here's part of what I have so far (the run method at the bottom basically calls system):
package main;
my $obj1 = System::Wrapper->new(
interpreter => 'perl',
arguments => [-pe => q{''}],
input => ['input.txt'],
description => 'Concatenate input.txt to STDOUT',
);
my $obj2 = System::Wrapper->new(
interpreter => 'perl',
arguments => [-pe => q{'$_ = reverse $_}'}],
description => 'Reverse lines of input input',
output => { '>' => 'output' },
);
$obj1->serial( $obj2 );
package System::Wrapper;
#...
sub serial {
my ($self, #commands) = #_;
eval {
require POSIX; POSIX->import();
require threads;
};
my $tmp_dir = File::Spec->tmpdir();
my $last = $self;
my #threads;
push #commands, $self;
for my $command (#commands) {
croak sprintf
"%s::serial: type of args to serial must be '%s', not '%s'",
ref $self, ref $self, ref $command || $command
unless ref $command eq ref $self;
my $named_pipe = File::Spec->catfile( $tmp_dir, int \$command );
POSIX::mkfifo( $named_pipe, 0777 )
or croak sprintf
"%s::serial: couldn't create named pipe %s: %s",
ref $self, $named_pipe, $!;
$last->output( { '>' => $named_pipe } );
$command->input( $named_pipe );
push #threads, threads->new( sub{ $last->run } );
$last = $command;
}
$_->join for #threads;
}
#...
My specific questions:
Is there an alternative to POSIX::mkfifo that is cross-platform? Win32 named pipes don't work, as you can't open those as regular files, neither do sockets, for the same reasons.
2. The above doesn't quite work; the two threads get spawned correctly, but nothing flows across the pipe. I suppose that might have something to do with pipe deadlocking or output buffering. What throws me off is that when I run those two commands in the actual shell, everything works as expected.
Point 2 is solved; a -p fifo file test was not testing the correct file.
Out of interest, why do you need a FIFO? Couldn't you just set up a regular pipe (e.g. with pipe?) And why use threads when you can use the much more strongly supported fork?
In fact, you could instead use a CPAN module to do most of your work for you. IPC::Run for example:
use IPC::Run qw(run);
run ['perl', '-pe', ''], '<', 'input.txt', '|', ['perl', '-pe', '$_ = reverse $_}'], '>', 'output';
...should work as you expect, on Linux or Windows.
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