package Argdom;
use 5.006;
require Exporter;
use Carp;
@ISA = qw(Exporter);
@EXPORT = qw(new new setKeyChooser setSingleChooser chooseKeys chooseS
+ingles chooseArbs getArbitraries getArbs getSingles getKeys that that
+);
@EXPORT_OK = qw(ref ref);
our $VERSION = '1.0';
use warnings;
use strict;
{package Arg;
my $pos = 0;
sub new
{
my ($self, $arg, $r) = (shift, shift, {});
$r->{arg} = $arg;
$r->{pos} = $pos++;
bless $r, $self;
}
}
{sub new
{
my ($self, $args, $r) = (shift, shift, {});
my @argobjs = ();
croak 'Argument to Argdom constructor must be an array reference (
+usually \@ARGV)' unless ref $args eq 'ARRAY';
$r->{kc} = undef;
$r->{sc} = undef;
push @argobjs, new Arg($_) foreach (@{$args});
$r->{args} = \@argobjs;
bless $r, $self;
}
sub setKeyChooser
{
my ($self, $chooser) = (shift, shift);
croak 'Argument to Argdom::setKeyChooser must be a code reference'
+ unless ref $chooser eq 'CODE';
$self->{kc} = $chooser;
$self->chooseKeys;
$self;
}
sub setSingleChooser
{
my ($self, $chooser) = (shift, shift);
croak 'Argument to Argdom::setSingleChooser must be a code referen
+ce' unless ref $chooser eq 'CODE';
$self->{sc} = $chooser;
$self->chooseSingles;
$self;
}
sub chooseKeys
{
my ($self, $keys, $pushNext, $pushNextTo, $notI) = (shift, {}, 0,
+'', 0);
foreach my $arg (@{$self->{args}})
{
if($pushNext)
{
$pushNext = 0;
push @{$keys->{$pushNextTo}}, $arg->{arg};
$self->{args}->[$notI]->{seen} = 1;
next;
}
if($self->{kc}->($arg->{arg}))
{
$keys->{$arg->{arg}} = [] unless $keys->{$arg->{arg}};
$pushNextTo = $arg->{arg};
$self->{args}->[$notI]->{seen} = 1;
$pushNext = 1;
}
}
continue
{
++$notI;
}
$self->{keys} = $keys;
$self->{keysChosen} = 1;
$self->chooseArbs if $self->{singlesChosen};
$notI;
}
sub chooseSingles
{
my ($self, $notI) = (shift, 0);
my @singles = ();
foreach my $arg (@{$self->{args}})
{
if($self->{sc}->($arg->{arg}))
{
push @singles, $arg->{arg};
$self->{args}->[$notI]->{seen} = 1;
}
}
continue
{
++$notI;
}
$self->{singles} = \@singles;
$self->{singlesChosen} = 1;
$self->chooseArbs if $self->{keysChosen};
$notI;
}
sub chooseArbs
{
my ($self, $notI) = (shift, 0);
my @arbs = ();
foreach my $arg (@{$self->{args}})
{
unless($arg->{seen})
{
push @arbs, $arg->{arg};
++$notI;
}
}
$self->{arbs} = \@arbs;
$notI;
}
sub getArbitraries
{
return @{(shift)->{arbs}} if wantarray;
(shift)->{arbs};
}
sub getArbs
{
return @{(shift)->{arbs}} if wantarray;
(shift)->{arbs};
}
sub getSingles
{
return @{(shift)->{singles}} if wantarray;
(shift)->{singles};
}
sub getKeys { (shift)->{keys} }
}
1;
# POD, now ...
__DATA__
=pod
=head1 NAME
Argdom.pm - Argument-managing module for Perl 5
=head1 SYNOPSIS
#! /usr/bin/perl
use Argdom;
use warnings;
use strict;
# This will result in a script that takes some of the commonly-
+used GCC commands, and tell you what it deems them as:
my $isItSingle =
sub
{
my $who = shift;
foreach my $sk (qw(--help -S -E -c -g -pg -pedantic -pedantic-
+errors))
{
return 1 if $sk eq $who;
}
foreach my $sk (qw(-std= -O -W -I -L -D -U -f -m))
{
return 1 if substr($who, 0, length $sk) eq $sk and (length
+ $who > length $sk);
}
0;
};
my $isItAKey =
sub
{
my $who = shift;
foreach my $kk (qw(-o -x))
{
return 1 if $kk eq $who;
}
0;
};
my $args = \@ARGV;
my $a = new Argdom($args);
$a->setKeyChooser($isItAKey);
$a->setSingleChooser($isItSingle);
my @s = @{$a->getSingles};
my %k = %{$a->getKeys};
print "\n";
print $_, " was passed as a single argument.\n" foreach (@s);
print "\n";
foreach my $k1 (keys %k)
{
printf "The values passed for the %s switch are:\n", $k1;
print "\t", $_, "\n" foreach (@{$k{$k1}});
}
print $_, " was passed as an ``arbitrary'' argument.\n" foreach (@
+{$a->getArbs});
=head1 DESCRIPTION
Argdom helps you manage arguments (usually C<@ARGV>). The name is take
+n from B<Arg>uments + B<DOM> (I like to think of it as C<@ARGV>'s Doc
+ument Object Model).
The whole idea is to separate arguments into three groups: key-value a
+rguments (the paired ones, like C<-o outputfile -x language>), single
+ arguments (like C<-pedantic -DSOME_MACRO_DEFINITION>), and the ``arb
+itrary'' arguments (the ones that are not paired and do not give the
+program a directive, like the input file for perl). Using this module
+ is I<very> easy.
In the end, anyway, your code decides which argument to treat as what,
+ and more about what happens is below.
=head1 USAGE
=head2 Initialisation
The Argdom cunstructor takes only one argument E<#8212> the reference
+to the argument array.
my $a = new Argdom(\@ARGV); # Will suffice
From then on, you may not have to worry yourself with C<@ARGV> (except
+ to work around the weakness noted L<here|/"Order-of-Passing is Garbl
+ed Across Argument Types">, if the work-around trick explained L<here
+|/"Work-around"> is not used).
=head2 Choosers-n-Pickers
You've got to attach two references to predicate subs to the object. T
+hey are used to determine which class an arg belongs to.
=head3 C<setKeyChooser>
C<setKeyChooser> is used to attach a reference to a sub that, when fed
+ with an argument, should return true if that argument is expected, b
+y the script, as the key part of a key-value pair of args.
Example: your script (called `greeter') requires args, and one of them
+ is `-o' to denote the file into which the output should be written.
C<greeter -o outfile>
You would set the key chooser (C<Argdom::setKeyChooser>'s arg) to be a
+ reference to a sub that returns true when given the string `-o'. Thi
+s will make object's internal logic associate the other argument, C<o
+utfile> with C<-o>, and return C<outfile> the next time you ask for t
+he vakues of the key C<-o>.
That is used I<comme ci>:
$a->setKeyChooser(sub { $_[0] eq '-o' } );
=over 4
=item Note:
If an argument is deemed a key in a key-value pair, the next argument
+is, automatically, deemed as it's value, and it is not passed to any
+predicates for classification. It is just pushed against the key, as
+its value.
=back
=head3 C<setSingleChooser>
The same applies to C<setSingleChooser>, except that the sub ref set b
+y C<setSingleChooser> should return true if the argument is a single
+key.
Example: greeter takes an argument `-xclaim', to tell it whether it sh
+ould put an exclamation mark at the end of the output string. As in:
C<greeter -xclaim>
That's not a paired argument (because it doesn't take an arg after the
+ `-xclaim' as additional data), and, if your code deems it as a singl
+e argument, all the other args passed after it (even immediately afte
+r) are not related to it. So, C<greeter -xclaim someother> doesn't ma
+ke C<someother> a value of the key C<-xclaim>.
$a->setSingleChooser(sub { ($_[0] eq '-xclaim') or (substr($_[0],
+0, 2) eq '-4') } );
That is used I<comme E<ccedil>a>.
You may have noticed that the sub ref also returns true for a string p
+assed to it that starts with `-4'. That's to display another thing yo
+u could do. You may want to classify some args that are not pre-known
+ E<#8212> they are single args, but they are not definite. Like C<gre
+eter '-4Somebody;World;Nurse'>. You only return true if it matches th
+e beginning bit, for example.
=head3 How The Arbitrary Arguments Are Chosen
When both C<setSingleChooser> and C<setKeyChooser> have been set, the
+object automatically calls the method to set the arbitrary arguments.
Remember, the arbitrary args are those that, simply-put, are neither d
+enoted as singles or keys. Also, when you set the choosers, the choos
+ing is done there and then, with your set choosers.
=head2 Working With The Arguments
After the object has worked with the arguments, you can get them back,
+ classified and (where applicable) linked with other args with which
+they correspond.
Example:
=head3 C<getSingles>
my @singles = @{$a->getSingles};
my @singles = $a->getSingles;
C<Argdom::getSingles> returns a reference to an array containing the s
+ingle keys, in the order in which they were passed in.
So, C<join(', ', @singles) eq '-xclaim, -4Somebody;World;Nurse'> for t
+he invocation: C<greeter -xclaim '-4Somebody;World;Nurse'>. If called
+ in list context, it returns a list of the items, not a reference to
+that list; as in the second line of code, above.
=head3 C<getKeys>
my %keyvals = %{$a->getKeys};
C<Argdom::keyVals> returns a reference to a hash containing all the ke
+y-value args, with the keys having an array ref of the respective val
+ues. This enables you to get many values on the same key arg. Like,
C<greeter -o outfile1 -xclaim -o outfile2 -o ->
would make C<getKeys> return a hash ref like this:
C<{'-o' =E<gt> ['outfile', 'outfile2', '-']}>.
=head3 C<getArbs> or C<getArbitraries>
my @arbs = @{$a->getArbs};
my @arbs = $a->getArbs;
C<Argdom::getArbitraries> is a synonym for C<Argdom::getArbs>, which r
+eturns a ref of an array containing all the arbitrary args, in their
+order. If called in a list context, it returns the array itself, not
+its reference; as in the second line of code, above.
This enables the program to take args in just any order, since there i
+s no such things as the-last-arg-is-the-this-and-that. You just insis
+t on proper denoting of arguments (say, directives having `-' at the
+start and keys always having their values attached), and use the same
+ criterion in the choosers, and you have the args as you want them.
The invocation C<greeter -o outfile "Some Text"> would cause C<getArbs
+> to return C<['Some Text']>, since that's the only arbitrary argumen
+t there.
=head2 Example: C<greeter>
=head3 Source Code
#! /usr/bin/perl
use warnings;
use strict;
use Argdom;
my $a = new Argdom(\@ARGV);
$a->setSingleChooser(sub { $_[0] eq '-xclaim' or substr($_[0], 0,
+2) eq '-4' } );
$a->setKeyChooser(sub { $_[0] eq '-o' } );
my @arbs = $a->getArbs;
my @sings = $a->getSingles;
my ($greeting, $x, $forWhom, $outs) = ('', 0, '-4World;to you', ['
+-']);
# --help and -h can only be in @arbs, since they are never iden
+tified as keys or singles
foreach (@arbs)
{
if($_ eq '-h' or $_ eq '--help')
{
my $hlp =
qq/--help | -h displays this help message and quits.
-o outfile is the file to which the output is written. Can be many
+, as in -o f1 -o f2 -o f3. `-' means the STDOUT (default).
-xclaim means the output should be exclamatory.
-4X;Y;Z means the greeting should be for X, Y, and Z. Default is `
+`World'' and yourself!.
any other args are the greeting. Default is "Hello"./;
printf "\ngreeter is a sample program for Argdom.pm.\n%s\n
+\n", $hlp;
exit 0;
}
$greeting .= $_;
}
$greeting = 'Hello' unless $greeting;
foreach (@sings)
{
$x = 1 if $_ eq '-xclaim';
$forWhom = $_ if substr($_, 0, 2) eq '-4'
}
my @toWhom = ();
my $ls = substr $forWhom, 2;
@toWhom = split /;/, $ls;
$outs = $a->getKeys->{'-o'} if $a->getKeys->{'-o'};
foreach my $outfile (@{$outs})
{
my $string = '';
$string .= "$greeting, $_" . ($x ? '!' : '.') . "\n" foreach (
+@toWhom);
print $string if $outfile eq '-';
unless($outfile eq '-')
{
open(OUTHANDLE), '>', $outfile or croak "Could not open $o
+utfile for writing: $!";
print OUTHANDLE $string;
close OUTHANDLE;
}
}
=head3 Sample Runs
greeter
Hello, World.
Hello, to you.
greeter -xclaim
Hello, World!
Hello, to you!
greeter '-4Me;You;World;Nurse' -xclaim 'How on Earth are you doing
+'
How on Earth are you doing, Me!
How on Earth are you doing, You!
How on Earth are you doing, World!
How on Earth are you doing, Nurse!
greeter -xclaim '-4Captain;Skipper;Sir Hal;Lord Cumbrae' 'Aye, aye
+'
Aye, aye, Captain!
Aye, aye, Skipper!
Aye, aye, Sir Hal!
Aye, aye, Lord Cumbrae!
(Eh, I see you've been reading some Wilbur Smith, too, eh?)
greeter -xclaim '-4you blank-minded nincompoop' 'Git da frig outta
+ ' here
Git da frig outta here, you blank-minded nincompoop!
(It doesn't always have to be formal. It's why we put the args, in
+ the first place.)
greeter -o 1.gr -o 2.gr -o -
Hello, World.
Hello, to you.
cat 1.gr 2.gr
Hello, World.
Hello, to you.
Hello, World.
Hello, to you.
C<greeter --help> and C<greeter -h> give you help.
=head1 BUGS
Because missing features are bugs ...
=head2 Order-of-Passing is Garbled Across Argument Types
While the order in which the arguments has been passed is preserved, t
+he module does not ease the job of finding out which args came before
+ which, if they are not of the same kind.
This is a problem, when how you treat some arguments depends on the po
+sition of other arguments of a different kind.
=head3 Work-around
To work around this, you can keep track of the arguments consciously,
+via the sub referred to by the argument to C<setSingleChooser>, since
+ it gets every argument passed to it.
=head2 Private Members not Denoted
The coding convention of private members beginning with a double under
+line (C<__>) is not obeyed here. I wasn't too sure what was supposed
+to be ``hidden'' and what wasn't.
=head3 Work-around
Do not use methods and stuff that are not documented here, because thi
+s is all that has been explained, either by documentation or by conve
+ntion.
=head1 AUTHOR
Revence XXVII <revence27@praize.com>
=head1 COPYRIGHT
No copyright.
No licence.
This module, the ideas, and all the related intellectual property here
+in, I hereby place in the Public Domain.
=cut
|
