package Argdom;
use 5.006;
require Exporter;
use Carp;

@ISA = qw(Exporter);
@EXPORT = qw(new new setKeyChooser setSingleChooser chooseKeys chooseSingles 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 reference' 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 taken from B<Arg>uments + B<DOM> (I like to think of it as C<@ARGV>'s Document Object Model).

The whole idea is to separate arguments into three groups: key-value arguments (the paired ones, like C<-o outputfile -x language>), single arguments (like C<-pedantic -DSOME_MACRO_DEFINITION>), and the ``arbitrary'' 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 Garbled 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. They 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, by 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'. This will make object's internal logic associate the other argument, C<outfile> with C<-o>, and return C<outfile> the next time you ask for the 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 by C<setSingleChooser> should return true if the argument is a single key.

Example: greeter takes an argument `-xclaim', to tell it whether it should 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 single argument, all the other args passed after it (even immediately after) are not related to it. So, C<greeter -xclaim someother> doesn't make 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 passed to it that starts with `-4'. That's to display another thing you 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<greeter '-4Somebody;World;Nurse'>. You only return true if it matches the 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 denoted as singles or keys. Also, when you set the choosers, the choosing 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 single keys, in the order in which they were passed in.
So, C<join(', ', @singles) eq '-xclaim, -4Somebody;World;Nurse'> for the 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 key-value args, with the keys having an array ref of the respective values. 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 returns 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 is no such things as the-last-arg-is-the-this-and-that. You just insist 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 argument 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 identified 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 $outfile 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, the 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 position 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 underline (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 this is all that has been explained, either by documentation or by convention.

=head1 AUTHOR

Revence XXVII <revence27@praize.com>

=head1 COPYRIGHT

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

=cut