perl - use command-line argument multiple times - perl

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

Related

Getopts to flag bad options without dash

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.

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)

Unknown options in perl Getopt::Long

How can you recognize unknown options using Getopt::Long ?
I tried '<>', but it did not work as expected..Consider:
use Modern::Perl;
use Getopt::Long;
my $help='';
GetOptions ('help' => \$help,'<>' => \&usage);
usage() if $help;
usage() if #ARGV != 1;
my $fn=pop;
say "FileName: $fn";
sub usage {
say "Unknown option: #_" if ( #_ );
say "Usage: $0 <filename>";
say " $0 --help";
say "";
exit
}
I would like to print Unknown option only if there is an unrecognized option ( in this case, anything other then --help) . But now it thinks the filename is an unrecognized option..
Call your usage function if GetOptions fails. Getopt::Long will print Unknown option for you (to STDERR):
use Modern::Perl;
use Getopt::Long;
my $help='';
GetOptions ('help' => \$help) or usage();
usage() if $help;
usage() if #ARGV != 1;
my $fn=pop;
say "FileName: $fn";
sub usage {
say "Usage: $0 <filename>";
say " $0 --help";
say "";
exit
}
Start using pod documentation as the core modules Getopt::Long and Pod::Usage work very well together. Can get the behavior you want without having to create helper methods to accomplish it:
Here's an example script:
#!/usr/bin/perl
use File::Basename qw(basename);
use Getopt::Long qw(GetOptions);
use Pod::Usage qw(pod2usage);
use Readonly;
use version;
use strict;
use warnings;
Readonly my $VERSION => qv('0.0.1');
Readonly my $EXE => basename($0);
GetOptions(
'version' => \my $version,
'usage' => \my $usage,
'help|?' => \my $help,
'man' => \my $man,
) or pod2usage(-verbose => 0);
pod2usage(-verbose => 0) if $usage;
pod2usage(-verbose => 1) if $help;
pod2usage(-verbose => 2) if $man;
if ($version) {
print "$EXE v$VERSION\n";
exit;
}
## Check for File
pod2usage("$EXE: No filename specified.\n") unless #ARGV;
my $file = $ARGV[0];
pod2usage("$EXE: $file is a directory.\n") if -d $file;
pod2usage("$EXE: $file is not writable.\n") if !-w $file;
#....
print "Hello World\n";
#....
1;
__END__
=head1 NAME
hello.pl - Mirrors a script using pod
=head1 SYNOPSIS
./hello.pl [FILE]
=head1 OPTIONS
=over 4
=item --version
Print the version information
=item --usage
Print the usage line of this summary
=item --help
Print this summary.
=item --man
Print the complete manpage
=back
=head1 DESCRIPTION
Sometimes a programmer just enjoys a bit of documentation.
They can't help themselves, it makes them feel accomplished.
=head1 AUTHOR
Written by A Simple Coder
Output:
>perl hello.pl --test
Unknown option: test
Usage:
./hello.pl [FILE]

Controlling arguments in perl with Getopt::Long

I am trying to use Getopt::Long add command line arguments to my script (seen below). The problem I am running into is related to multiple commands that do different things. For example I have an option flag that sets the configuration file to use with the script the option is -c [config_path] and I also have -h for help.
The problem I am running into is I need to have a condition that states whether or not the config option has been used AND a config file has been specified. I tried counting the options in #ARGV but found if -h and -c are specifed it causes the script to move on the to the subroutine load_config anyway. Because as seen in the code below when 2 arguments are found in #ARGV it fires the subroutine.
In what way could I fix this? At least in my head specifying -h and -c at the same time sorta contradicts each other. Is there a way to make it so only "informational commands" like help cannot be executed with "operational commands" like -c? Heck is there a way where I get a list of the commands that have been passed? I tried printing the contents of #ARGV but nothing was in it even though I had specified command arguments.
#!/usr/bin/perl
use strict;
use warnings;
use Getopt::Long;
use Term::ANSIColor;
use XML::Simple;
use Net::Ping;
use Net::OpenSSH;
use Data::Dumper;
# Create a new hash to copy XML::Simple configuration file data into
my %config_file;
# Clear the screen and diplay version information
system ("clear");
print "Solignis's Backup script v0.8 for ESX\\ESX(i) 4.0+\n";
print "Type -h or --help for options\n\n";
# Create a new XML::Simple object
my $xml_obj = XML::Simple->new();
# Create a new Net::Ping object
my $ping_obj = Net::Ping->new();
my $config_file;
my $argcnt = $#ARGV + 1;
GetOptions('h|help' => \&help,
'c|config=s' => \$config_file
);
if ($argcnt == 0) {
print "You must supply a config to be used\n";
} elsif ($argcnt == 2) {
if (! -e $config_file) {
print color 'red';
print "Configuration file not found!\n";
print color 'reset';
print "\n";
die "Script Halted\n";
} else {
load_config();
}
}
sub load_config {
print color 'green';
print "$config_file loaded\n";
print color 'reset';
my $xml_file = $xml_obj->XMLin("$config_file",
SuppressEmpty => 1);
foreach my $key (keys %$xml_file) {
$config_file{$key} = $xml_file->{$key};
}
print Dumper (\%config_file);
}
sub help {
print "Usage: backup.pl -c [config file]\n";
}
#ARGV is altered by GetOptions, that is why it seems empty. Rather than counting arguments, just directly check if $config_file is defined.
BTW, IMO there is no need to try to exclude -c from being used with -h. Normally a "help" just prints the help text and exits without taking any other action, check that first and it shouldn't matter whether -c is supplied or not.
Something like
my $help;
my $config_file;
GetOptions('h|help' => \$help,
'c|config=s' => \$config_file
);
if ( defined $help ) {
help();
} elsif ( defined $config_file ) {
...;
} else {
die "No arguments!";
}
You might also want to check out Getopt::Euclid which presents some expanded ways to provide options and a cool way of using the programs documentation as the spec for the command-line arguments.
You can always set a default value for the options eg my $help = 0; my $config_file = ""; and then test for those values.

How can I pipe two Perl CORE::system commands in a cross-platform way?

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.