Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling

by revence27 (Novice)
on Nov 10, 2006 at 08:03 UTC ( #583302=sourcecode: print w/replies, xml ) Need Help??
Category: Miscellaneous
Author/Contact Info Revence 27 See the Pod for more info.
Description: is good to help with managing arguments, in a very object-oriented way. Very extensible, because it uses high-level functions enough.
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;

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;

sub chooseKeys
    my ($self, $keys, $pushNext, $pushNextTo, $notI) = (shift, {}, 0, 
+'', 0);
    foreach my $arg (@{$self->{args}})
            $pushNext = 0;
            push @{$keys->{$pushNextTo}}, $arg->{arg};
            $self->{args}->[$notI]->{seen} = 1;
            $keys->{$arg->{arg}} = [] unless $keys->{$arg->{arg}};
            $pushNextTo   = $arg->{arg};
            $self->{args}->[$notI]->{seen} = 1;
            $pushNext     = 1;
    $self->{keys}       = $keys;
    $self->{keysChosen} = 1;
    $self->chooseArbs if $self->{singlesChosen};

sub chooseSingles
    my ($self, $notI) = (shift, 0);
    my @singles = ();
    foreach my $arg (@{$self->{args}})
            push @singles, $arg->{arg};
            $self->{args}->[$notI]->{seen} = 1;
    $self->{singles}       = \@singles;
    $self->{singlesChosen} = 1;
    $self->chooseArbs if $self->{keysChosen};

sub chooseArbs
    my ($self, $notI) = (shift, 0);
    my @arbs = ();
    foreach my $arg (@{$self->{args}})
            push @arbs, $arg->{arg};
    $self->{arbs} = \@arbs;

sub getArbitraries
    return @{(shift)->{arbs}} if wantarray;

sub getArbs
    return @{(shift)->{arbs}} if wantarray;

sub getSingles
    return @{(shift)->{singles}} if wantarray;

sub getKeys { (shift)->{keys} }


#    POD, now ...



=head1 NAME - Argument-managing module for Perl 5


    #! /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 =
        my $who = shift;
        foreach my $sk (qw(--help -S -E -c -g -pg -pedantic -pedantic-
            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);
    my $isItAKey = 
        my $who = shift;
        foreach my $kk (qw(-o -x))
            return 1 if $kk eq $who;
    my $args = \@ARGV;
    my $a = new Argdom($args);
    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 (@


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.


=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 

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.


=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\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 (
        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

    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 -o -o -
    Hello, World.
    Hello, to you.
    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

=head1 AUTHOR

Revence XXVII <>


No copyright.
No licence.
This module, the ideas, and all the related intellectual property here
+in, I hereby place in the Public Domain.

Replies are listed 'Best First'.
by Hofmator (Curate) on Nov 10, 2006 at 10:47 UTC
    Well, another command-line-parsing-module ... but I must say, I prefer Getopt::Long which is a core module and therefore available everywhere. In addition to that, there are plenty of tests for Getopt::Long, it is more flexible and easier to use (eg. no need to define subs that match the arguments by hand). Apart from that, your module has a couple of problems, eg. it doesn't need Exporter, has a inconsistent interface (why can I say my @singles = $a->getSingles; but not my %keyvals = $a->getKeys), ...

    To underline my point, I have rewritten the script given in your POD using Getopt::Long. The only difference is that '-4Adam;Barbara' is now written as two arguments -4 and 'Adam;Barbara'. Btw, your script as given doesn't compile, it uses croak without use Carp; - I have replaced that with a simple warn.

    use strict; use warnings; use Getopt::Long; my $usage_msg = <<'EOHELP'; greeter is a sample program for --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. -4 X;Y;Z means the greeting should be for X, Y, and Z. Default is ``Wo +rld'' and yourself!. any other args are the greeting. Default is "Hello"./; EOHELP my $xclaim = 0; my $usage = 0; my $greeting = ''; my $forWhom = 'World;to you'; my @outs; GetOptions ("h|help" => \$usage, "xclaim!" => \$xclaim, "4=s" => \$forWhom, "o=s" => \@outs, ) or die $usage_msg; if ($usage) { print $usage_msg; exit; } $greeting .= $_ foreach @ARGV; $greeting = 'Hello' unless $greeting; @outs = qw/-/ unless @outs; my $output = ''; $output .= "$greeting, $_" . ($xclaim ? '!' : '.') . "\n" for (split /;/, $forWhom); foreach my $outfile (@outs) { if ($outfile eq '-') { print $output; } else { open my $outfh, '>', $outfile or warn "Could not open $outfile + for writing: $!"; print $outfh $output; close $outfh; } }

    -- Hofmator

    Code written by Hofmator and posted on PerlMonks is public domain. It is provided as is with no warranties, express or implied, of any kind. Posted code may not have been tested. Use of posted code is at your own risk.

      I put the subs that select the args, because I didn't want to restrict how args should be formatted. The '-4Me;And;You' thing was to show how extensible the module is. Not everybody is writing (for) POSIX syntax arguments. I do much work on Win32, in which case arg keys are supposed to be more like /something. I hope you get my point. Sure, there are many modules, but this is the only one (I have seen -- not like I work at Google, though) that doesn't think for you. I don't want to replace the programmer. You must choose which args go where, and that is why I put the choosers. GetOpt, you'll notice, is simply for one kind of command-line args. Thanks for the code!
      print "Something's gone wrong with my head: $!";

Log In?

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://583302]
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others exploiting the Monastery: (3)
As of 2023-02-01 03:05 GMT
Find Nodes?
    Voting Booth?

    No recent polls found