I've been reading up on dispatch tables and I get the general idea of how they work, but I'm having some trouble taking what I see online and applying the concept to some code I originally wrote as an ugly mess of if-elsif-else statements.
I have options parsing configured by using GetOpt::Long, and in turn, those options set a value in the %OPTIONS hash, depending on the option used.
Taking the below code as an example... (UPDATED WITH MORE DETAIL)
use 5.008008;
use strict;
use warnings;
use File::Basename qw(basename);
use Getopt::Long qw(HelpMessage VersionMessage :config posix_default require_order no_ignore_case auto_version auto_help);
my $EMPTY => q{};
sub usage
{
my $PROG = basename($0);
print {*STDERR} $_ for #_;
print {*STDERR} "Try $PROG --help for more information.\n";
exit(1);
}
sub process_args
{
my %OPTIONS;
$OPTIONS{host} = $EMPTY;
$OPTIONS{bash} = 0;
$OPTIONS{nic} = 0;
$OPTIONS{nicName} = $EMPTY;
$OPTIONS{console} = 0;
$OPTIONS{virtual} = 0;
$OPTIONS{cmdb} = 0;
$OPTIONS{policyid} = 0;
$OPTIONS{showcompliant} = 0;
$OPTIONS{backup} = 0;
$OPTIONS{backuphistory} = 0;
$OPTIONS{page} = $EMPTY;
GetOptions
(
'host|h=s' => \$OPTIONS{host} ,
'use-bash-script' => \$OPTIONS{bash} ,
'remote-console|r!' => \$OPTIONS{console} ,
'virtual-console|v!' => \$OPTIONS{virtual} ,
'nic|n!' => \$OPTIONS{nic} ,
'nic-name|m=s' => \$OPTIONS{nicName} ,
'cmdb|d!' => \$OPTIONS{cmdb} ,
'policy|p=i' => \$OPTIONS{policyid} ,
'show-compliant|c!' => \$OPTIONS{showcompliant} ,
'backup|b!' => \$OPTIONS{backup} ,
'backup-history|s!' => \$OPTIONS{backuphistory} ,
'page|g=s' => \$OPTIONS{page} ,
'help' => sub { HelpMessage(-exitval => 0, -verbose ->1) },
'version' => sub { VersionMessage() },
) or usage;
if ($OPTIONS{host} eq $EMPTY)
{
print {*STDERR} "ERROR: Must specify a host with -h flag\n";
HelpMessage;
}
sanity_check_options(\%OPTIONS);
# Parse anything else on the command line and throw usage
for (#ARGV)
{
warn "Unknown argument: $_\n";
HelpMessage;
}
return {%OPTIONS};
}
sub sanity_check_options
{
my $OPTIONS = shift;
if (($OPTIONS->{console}) and ($OPTIONS->{virtual}))
{
print "ERROR: Cannot use flags -r and -v together\n";
HelpMessage;
}
elsif (($OPTIONS->{console}) and ($OPTIONS->{cmdb}))
{
print "ERROR: Cannot use flags -r and -d together\n";
HelpMessage;
}
elsif (($OPTIONS->{console}) and ($OPTIONS->{backup}))
{
print "ERROR: Cannot use flags -r and -b together\n";
HelpMessage;
}
elsif (($OPTIONS->{console}) and ($OPTIONS->{nic}))
{
print "ERROR: Cannot use flags -r and -n together\n";
HelpMessage;
}
if (($OPTIONS->{virtual}) and ($OPTIONS->{backup}))
{
print "ERROR: Cannot use flags -v and -b together\n";
HelpMessage;
}
elsif (($OPTIONS->{virtual}) and ($OPTIONS->{cmdb}))
{
print "ERROR: Cannot use flags -v and -d together\n";
HelpMessage;
}
elsif (($OPTIONS->{virtual}) and ($OPTIONS->{nic}))
{
print "ERROR: Cannot use flags -v and -n together\n";
HelpMessage;
}
if (($OPTIONS->{backup}) and ($OPTIONS->{cmdb}))
{
print "ERROR: Cannot use flags -b and -d together\n";
HelpMessage;
}
elsif (($OPTIONS->{backup}) and ($OPTIONS->{nic}))
{
print "ERROR: Cannot use flags -b and -n together\n";
HelpMessage;
}
if (($OPTIONS->{nic}) and ($OPTIONS->{cmdb}))
{
print "ERROR: Cannot use flags -n and -d together\n";
HelpMessage;
}
if (($OPTIONS->{policyid} != 0) and not ($OPTIONS->{cmdb}))
{
print "ERROR: Cannot use flag -p without also specifying -d\n";
HelpMessage;
}
if (($OPTIONS->{showcompliant}) and not ($OPTIONS->{cmdb}))
{
print "ERROR: Cannot use flag -c without also specifying -d\n";
HelpMessage;
}
if (($OPTIONS->{backuphistory}) and not ($OPTIONS->{backup}))
{
print "ERROR: Cannot use flag -s without also specifying -b\n";
HelpMessage;
}
if (($OPTIONS->{nicName}) and not ($OPTIONS->{nic}))
{
print "ERROR: Cannot use flag -m without also specifying -n\n";
HelpMessage;
}
return %{$OPTIONS};
}
I'd like to turn the above code into a dispatch table, but can't figure out how to do it.
Any help is appreciated.
I am not sure how a dispatch table would help since you need to go through pair-wise combinations of specific possibilities, and thus cannot trigger a suitable action by one lookup.
Here is another way to organize it
use List::MoreUtils 'firstval';
sub sanity_check_options
{
my ($OPTIONS, $opt_excl) = #_;
# Check each of 'opt_excl' against all other for ConFLict
my #excl = sort keys %$opt_excl;
while (my $eo = shift #excl)
{
if (my $cfl = firstval { $OPTIONS->{$eo} and $OPTIONS->{$_} } #excl)
{
say "Can't use -$opt_excl->{$eo} and -$opt_excl->{$cfl} together";
HelpMessage();
last;
}
}
# Go through specific checks on
# policyid, showcompliant, backuphistory, and nicName
...
return 1; # or some measure of whether there were errors
}
# Mutually exclusive options
my %opt_excl = (
console => 'r', virtual => 'v', cmdb => 'c', backup => 'b', nic => 'n'
);
sanity_check_options(\%OPTIONS, \%opt_excl);
This checks all options listed in %opt_excl against each other for conflict, removing the segments of elsif involving the (five) options that are mutually exclusive. It uses List::MoreUtils::firstval.
The few other specific invocations are best checked one by one.
There is no use of returning $OPTIONS since it is passed as reference so any changes apply to the original structure (while it's not meant to be changed either). Perhaps you can keep track of whether there were errors and return that if it can be used in the caller, or just return 1.
This addresses the long elsif chain as asked, and doesn't go into the rest of code. Here is one comment though: There is no need for {%OPTIONS}, which copies the hash in order to create an anonymous one; just use return \%OPTIONS;
Comment on possible multiple conflicting options
This answer as it stands does not print all conflicting options that have been used if there are more than two, as raised by ikegami in comments; it does catch any conflicts so that the run is aborted.
The code is readily adjusted for this. Instead of the code in the if block either
set a flag as a conflict is detected and break out of the loop, then print the list of those that must not be used with each other (values %opt_excl) or point at the following usage message
collect the conflicts as they are observed; print them after the loop
or, see a different approach in ikegami's answer
However, one is expected to know of allowed invocations of a program and any listing of conflicts is a courtesy to the forgetful user (or a debugging aid); a usage message is printed as well anyway.
Given the number of conflicting options the usage message should have a prominent note on this. Also consider that so many conflicting options may indicate a design flaw.
Finally, this code fully relies on the fact that this processing goes once per run and operates with a handful of options; thus it is not concerned with efficiency and freely uses ancillary data structures.
You can use a dispatch table if there are a lot of options. I would build that table programmatically. It might not be the best option here, but it works and the configuration is more readable than your elsif construct.
use strict;
use warnings;
use Ref::Util::XS 'is_arrayref'; # or Ref::Util
sub create_key {
my $input = shift;
# this would come from somewhere else, probably the Getopt config
my #opts = qw( host bash nic nicName console virtual cmdb
policyid showcompliant backup backuphistory page );
# this is to cover the configuration with easier syntax
$input = { map { $_ => 1 } #{$input} }
if is_arrayref($input);
# options are always prefilled with false values
return join q{}, map { $input->{$_} ? 1 : 0 }
sort #opts;
}
my %forbidden_combinations = (
map { create_key( $_->[0] ) => $_->[1] } (
[ [qw( console virtual )] => q{Cannot use flags -r and -v together} ],
[ [qw( console cmdb )] => q{Cannot use flags -r and -d together} ],
[ [qw( console backup )] => q{Cannot use flags -r and -b together} ],
[ [qw( console nic )] => q{Cannot use flags -r and -n together} ],
)
);
p %forbidden_combinations; # from Data::Printer
The output of the p function is the dispatch table.
{
00101 "Cannot use flags -r and -v together",
00110 "Cannot use flags -r and -n together",
01100 "Cannot use flags -r and -d together",
10100 "Cannot use flags -r and -b together"
}
As you can see, we've sorted all the options ascii-betically to use them as keys. That way, you could in theory build all kinds of combinations like exclusive options.
Let's take a look at the configuration itself.
my %forbidden_combinations = (
map { create_key( $_->[0] ) => $_->[1] } (
[ [qw( console virtual )] => q{Cannot use flags -r and -v together} ],
# ...
)
);
We use a list of array references. Each entry is on one line and contains two pieces of information. Using the fat comma => makes it easy to read. The first part, which is much like a key in a hash, is the combination. It's a list of fields that should not occur together. The second element in the array ref is the error message. I've removed all the recurring elements, like the newline, to make it easier to change how and where the error can be displayed.
The map around this list of combination configuration runs the options through our create_key function, which translates it to a simple bitmap-style string. We assign all of it to a hash of that map and the error message.
Inside create_key, we check if it was called with an array reference as its argument. If that's the case, the call was for building the table, and we convert it to a hash reference so we have a proper map to look stuff up in. We know that the %OPTIONS always contains all the keys that exist, and that those are pre-filled with values that all evaluate to false. We can harness that convert the truthiness of those values to 1 or 0, which then builds our key.
We will see in a moment why that is useful.
Now how do we use this?
sub HelpMessage { exit; }; # as a placeholder
# set up OPTIONS
my %OPTIONS = (
host => q{},
bash => 0,
nic => 0,
nicName => q{},
console => 0,
virtual => 0,
cmdb => 0,
policyid => 0,
showcompliant => 0,
backup => 0,
backuphistory => 0,
page => q{},
);
# read options with Getopt::Long ...
$OPTIONS{console} = $OPTIONS{virtual} = 1;
# ... and check for wrong invocations
if ( exists $forbidden_combinations{ my $key = create_key($OPTIONS) } ) {
warn "ERROR: $forbidden_combinations{$key}\n";
HelpMessage;
}
All we need to do now is get the $OPTIONS hash reference from Getopt::Long, and pass it through our create_key function to turn it into the map string. Then we can simply see if that key exists in our %forbidden_combinations dispatch table and show the corresponding error message.
Advantages of this approach
If you want to add more parameters, all you need to do is include them in #opts. In a full implementation that would probably be auto-generated from the config for the Getopt call. The keys will change under the hood, but since that is abstracted away you don't have to care.
Furthermore, this is easy to read. The create_key aside, the actual dispatch table syntax is quite concise and even has documentary character.
Disadvantages of this approach
There is a lot of programmatic generation going on for just a single call. It's certainly not the most efficient way to do it.
To take this further, you can write functions that auto-generate entries for certain scenarios.
I suggest you take a look at the second chapter in Mark Jason Dominus' excellent book Higher-Order Perl, which is available for free as a PDF.
You shouldn't be using elsif here because multiple condition could be true. And since multiple conditions could be true, a dispatch table can't be used. Your code can still be simplified greatly.
my #errors;
push #errors, "ERROR: Host must be provided\n"
if !defined($OPTIONS{host});
my #conflicting =
map { my ($opt, $flag) = #$_; $OPTIONS->{$opt} ? $flag : () }
[ 'console', '-r' ],
[ 'virtual', '-v' ],
[ 'cmdb', '-d' ],
[ 'backup', '-b' ],
[ 'nic', '-n' ];
push #errors, "ERROR: Can only use one the following flags at a time: #conflicting\n"
if #conflicting > 1;
push #errors, "ERROR: Can't use flag -p without also specifying -d\n"
if defined($OPTIONS->{policyid}) && !$OPTIONS->{cmdb};
push #errors, "ERROR: Can't use flag -c without also specifying -d\n"
if $OPTIONS->{showcompliant} && !$OPTIONS->{cmdb};
push #errors, "ERROR: Can't use flag -s without also specifying -b\n"
if $OPTIONS->{backuphistory} && !$OPTIONS->{backup};
push #errors, "ERROR: Can't use flag -m without also specifying -n\n"
if defined($OPTIONS->{nicName}) && !$OPTIONS->{nic};
push #errors, "ERROR: Incorrect number of arguments\n"
if #ARGV;
usage(#errors) if #errors;
Note that the above fixes numerous errors in your code.
Help vs Usage Error
--help should provide the requested help to STDOUT, and shouldn't result in an error exit code.
Usage errors should be printed to STDERR, and should result in an error exit code.
Calling HelpMessage indifferently in both situations is therefore incorrect.
Create the following sub named usage to use (without arguments) when GetOptions returns false, and with an error message when some other usage error occurs:
use File::Basename qw( basename );
sub usage {
my $prog = basename($0);
print STDERR $_ for #_;
print STDERR "Try '$prog --help' for more information.\n";
exit(1);
}
Keep using HelpMessage in response to --help, but the defaults for the arguments are not appropriate for --help. You should use the following:
'help' => sub { HelpMessage( -exitval => 0, -verbose => 1 ) },
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
I've written a very simple script to delete symlinks in a directory, then create new ones linking to files in another directory (files modified within 10 days).
The script worked pretty good, but I thought I'd start showing some output, more specifically only when a $debug (or $quiet) argument is given. This has been giving me some grief, and I don't understand why I'm struggling with this seemingly easy task.
I'm thinking it is because the 'if($debug)' is used within the short circuit of the find sub. Without any conditional logic, it works fine (as seen in the 2nd find func).
Any thoughts at all will be very much appreciated, thanks.
ERROR:
syntax error at symlinksUpdater.pl line 25,
near "if" syntax error at symlinksUpdater.pl line 26, near "}"
Execution of symlinksUpdater.pl aborted due to compilation errors.
CODE:
#!/usr/bin/perl
use Getopt::Long;
use File::Find;
use Cwd;
my $symDir = getcwd();
my $archiveDir;
my $clearDynamic = 1;
my $debug= '';
my $dryRun ='';
GetOptions ("dynamicDir|s=s" => \$symDir,
"archiveDir|a=s" => \$archiveDir,
"clear|c!" => \$clearDynamic,
"debug|d!" => \$debug,
"dryRun!" => \$dryRun
);
print "DEBUG MODE\n" if $debug;
if ($clearDynamic) {
find(sub {
-l &&
unlink &&
if($debug) {print "DELETE: $_";} #LINE 25
}, "$symDir"); }
find(sub {
-f &&
int(-M _) < 10 &&
symlink($File::Find::name, $symDir."/".$_) &&
print "$symDir/$_ -> $File::Find::name";
#(printf("\n%s/%s -> %s", $symDir, $_, $File::Find::name) if (defined $debug);
}, "$archiveDir");
The operand of && must be an expression, not a statement. Anyway, all you need is
find(sub {
-l && unlink && $debug && print("DELETE: $_");
}, $symDir);
But I find the following far more readable:
find(sub {
if (-l) {
if (unlink) {
print("DELETE: $_") if $debug;
}
}
}, $symDir);
It also allows for easy error handling (else { warn ... }).
Try wrapping the if statement in a do block like this:
if ($clearDynamic) {
find(
sub {
-l &&
unlink &&
do { if($debug) {print "DELETE: $_";} } #LINE 25
}, "$symDir"
);
}
A prefix if block with curly braces can't stand alone as a statement the way other constructs can. You could also use a postfix if like this:
... unlink && (print "DELETE: $_" if $debug)
The parentheses clarify that the print should only happen if $debug is true rather than that the entire string of && conditions is contingent on $debug.
perldoc perlsyn explains "Compound Statements" (e.g.: if {...}) and "Statement Modifiers" (e.g.: ... if EXPR). I didn't find anything in that document which explicitly says that a compound statement can't be used as an expression, I just know from experience that it can't.
I am translating a shell script to a Perl script that uses Getopt::Long, and I want to keep compatibility with the case below where, if the only argument to the script is a single file, that file is used as a config file, whereas the usual is to get parameters into GetoptLong.
if [[ $# -eq 1 && -f $1 ]];
then
echo "Using config file $1"
[...]
else
if [ $# -lt 2 ]; then usage "INCORRECT NUMBER OF PARAMETERS"; fi
while getopts ":a:b:c:d:ef" opt;
do
[...]
One option is to maintain the if/else in the Perl script like so:
if (1 == #ARGV && -f $ARGV[0]) {
# use this config file
config_file_method($ARGV[0]);
} else {
# use GetOptions
GetOptions(
'a|foo:s' => \$foo,
'b|bar:s' => \bar,
[...]
);
}
But I wonder if this special case could be included in the GetOptions
function with some magic:
GetOptions(
'if only one element in #ARGV' => 'call config_file_method($ARGV[0])',
'a|foo:s' => \$foo,
'b|bar:s' => \bar,
[...]
);
Any ideas?
I don't see anything in the Getopt::Long documentation which supports what you are looking for.
The approach I would take is to let GetOptions process #ARGV. If anything is still in #ARGV, then you can assume it is the config file. Then there is no need for the -f check because the config_file_method sub will do an open/die check anyway.
GetOptions(
'a|foo:s' => \$foo,
'b|bar:s' => \$bar,
);
config_file_method($ARGV[0]) if #ARGV;
I'm pretty sure that it's not possible. If you was passing the config_file as an option instead of an argument you could do something like that:
GetOptions(
'c|config_file' => sub { config_file_method($ARGV[0]) if 1 == scalar #ARGV } ,
'a|foo:s' => \$foo,
'b|bar:s' => \bar,
[...]
);
There is no such option in Getopt::Long.
And as you've demonstrated, there's absolutely no need for one. (It didn't save you any work, yet it added complexity by inventing a new sublanguage.)
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.
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.