Friday, April 18, 2008

Improved PerlArg.pm

I can't believe I forgot something so important: the --help option. In this updated version of PerlArg.pm, I've added a built-in mechanism for that:

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 => [], Help => ''};
($self->{Long} = $args{Long}) if(defined $args{Long});
($self->{LongSynoms} = $args{LongSynoms}) if(defined $args{LongSynoms});
($self->{ShortSynoms} = $args{ShortSynoms}) if(defined $args{ShortSynoms});
($self->{Help} = $args{Help} and $self->{LongSynoms}->{help} = 'Help') if(defined $args{Help});
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($equiv eq 'Help') {
print $self->{Help};
exit 0;
}
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;

In order to activate this, one must put a Help => "help-text....\n" or something similar into the arguments to ->new().

No comments: