PerlArg.pm

I've been meaning to standardize how I parse arguments in my scripts for some time, but I've finally gotten around to it. This module follows conventions similar to most Unix tools in parsing its arguments, except -afoo to set a=foo isn't supported. I doubt it'll be missed, since a space in there is nothing:

PerlArg.pm

package PerlArg;
use strict;
use warnings;
use utf8;
my $VERSION = '0';
sub new {
my $class = shift;
my %args = @_;
my $self = {Long => {}, LongSynoms => {}, ShortSynoms => {}, Anon => []};
($self->{Long} = $args{Long}) if(defined $args{Long});
($self->{LongSynoms} = $args{LongSynoms}) if(defined $args{LongSynoms});
($self->{ShortSynoms} = $args{ShortSynoms}) if(defined $args{ShortSynoms});
bless($self, $class);
return $self;
}
sub addLong {
my $self = shift;
my $var = shift;
my $value = '';
($value = shift) if(scalar @ARGV);
$self->{Long}->{$var} = $value;
}
sub addSynom {
my $self = shift;
my ($syn, $equiv) = @_;
$self->{Synoms}->{$syn} = $equiv;
}
sub getValue {
my $self = shift;
my $var = shift;
return $self->{Long}->{$var};
}
sub getNames {
my $self = shift;
return keys %{$self->{Long}}
}
sub getAnonymous {
my $self = shift;
my $i = shift;
return ${$self->{Anon}}[$i];
}
sub getAnonymousAll {
my $self = shift;
return @{$self->{Anon}};
}
sub getAnonymousLength {
my $self = shift;
return scalar @{$self->{Anon}};
}
sub parseArgs {
my $self = shift;
my @args = @_;
my $arg = undef;
my $opts = 1;
while(scalar @args) {
$arg = shift @args;
if($opts and $arg eq '--') {
$opts = 0;
}
elsif($opts and $arg =~ /^--([^=]+)=(.*)$/) {
if(defined $self->{Long}->{$1}) {
$self->{Long}->{$1} = $2;
}
else {
die "Unknown argument: $1\n";
}
}
elsif($opts and $arg =~ /^--([^=]+)$/) {
if(defined $self->{LongSynoms}->{$1}) {
my $name = $1;
my $equiv = $self->{LongSynoms}->{$name};
if($equiv =~ /^([^=]+)=(.*)$/) {
if(defined $self->{Long}->{$1}) {
$self->{Long}->{$1} = $2;
}
else {
die "Unknown argument equivalent: $name -> $1\n";
}
}
elsif(!scalar @args) {
die "Needs a value: $name\n";
}
elsif(defined $self->{Long}->{$equiv}) {
my $value = shift @args;
$self->{Long}->{$equiv} = $value;
}
else {
die "Unknown argument equivalent: $name -> $1\n";
}
}
else {
die "Unknown argument: $1\n";
}
}
elsif($opts and $arg =~ /^-([^=]+)$/) {
my $len = length $1;
for(my $i = 0; $i < $len; $i++) {
my $a = substr($1, $i, 1);
if(defined $self->{ShortSynoms}->{$a}) {
my $equiv = $self->{ShortSynoms}->{$a};
if($equiv =~ /^([^=]+)=(.*)$/) {
if(defined $self->{Long}->{$1}) {
$self->{Long}->{$1} = $2;
}
else {
die "Unknown argument equivalent: $a -> $1\n";
}
}
elsif(!scalar @args or $i < $len - 1) {
die "Needs a value: $a\n";
}
elsif(defined $self->{Long}->{$equiv}) {
my $value = shift @args;
$self->{Long}->{$equiv} = $value;
}
else {
die "Unknown argument equivalent: $a -> $1\n";
}
}
else {
die "Unknown argument: $a\n";
}
}
}
else {
push(@{$self->{Anon}}, $arg);
}
}
}
1;
__END__

Here's a simple application of it:

perlargtest.pl

#!/usr/bin/perl -w
use strict;
use warnings;
use utf8;
use PerlArg;

my $pars = PerlArg->new(
Long => {cow => 'say', foo => 'bar'},
LongSynoms => {'no-cow' => 'cow=no', cow => 'cow'},
ShortSynoms => {'y' => 'foo=yay!', 'k' => 'foo'}
);
$pars->parseArgs(@ARGV);
my @names = $pars->getNames;
print "$_: " . $pars->getValue($_) . "\n" foreach(@names);
print "ANON\n";
print "\t$_\n" foreach($pars->getAnonymousAll);% perl perlargtest.pl --foo=333 --no-cow -yk 300 -- --cow=say 100 200 300
cow: no
foo: 300
ANON
--cow=say
100
200
300

This module is going to be used to improve my new Postgres-based JDIC search client.