package NAB::Utils::NP;

use strict;
use Data::Dumper;
use CGI::Util qw/ rearrange /;

our $Q;
our $VERSION = "1.00";

sub new {
  my $class = shift;
  if (!defined $Q) {
     $Q = { ALIAS => caller(0) };
        bless($Q, $class);
  }
  return $Q;
}

sub named_param {
  my($self, $seq, @p) = self_or_default(@_);
  my($s, @r) = self_or_default(@p);
  return rearrange($seq, @r);
}

sub self_or_default {
  my $class = $Q;
  if (defined $_[0] &&
   (! ref $_[0] && ($_[0] eq ref $class || $_[0] eq $Q->{ALIAS}))) {
    return @_;
  }

  return @_ if (ref $_[0] eq ref $class || ref $_[0] eq $Q->{ALIAS});

  unless (defined($_[0]) &&
         (ref($_[0]) eq $class || UNIVERSAL::isa($_[0], $class)))
  {
    unshift(@_,$Q);
  }

  return wantarray ? @_ : $Q;
}

1;

##</code><code>##

__END__

=pod

=head1	NAME

NAB::Utils::NP - Named Parameter Handling

=head1	SYNOPSIS

use NAB::Utils::NP;

$np = NAB::Utils::NP->new(__PACKAGE__);

sub test
{
    my($option1,$option2,$option3) =
       $np->named_param( [qw/ OPTION1 OPTION2 OPTION3 /], @_);
    ...
}

test( -option1=>'a', -option3=>'c' );

__PACKAGE__->test( -option1=>'a', -option3=>'c' );

=cut


##</code><code>##

use strict;
use warnings;
use NAB::Utils::NP;

my $np = NAB::Utils::NP->new;

test( -option1=>undef, -option3=>'c' );
test( 'a', 'b', 'c' );
__PACKAGE__->test( -option1=>'a', -option3=>'c' );
__PACKAGE__->test( 'a', 'b', 'c' );

sub test
{
    my($option1,$option2,$option3) =
        $np->named_param( [qw/ OPTION1 OPTION2 OPTION3 /], @_);

    print <<OPTIONS
\$option1=$option1
\$option2=$option2
\$option3=$option3

OPTIONS
;

}

##</code><code>##

$option1=
$option2=
$option3=c

$option1=a
$option2=b
$option3=c

$option1=a
$option2=
$option3=c

$option1=a
$option2=b
$option3=c