File Coverage

blib/lib/Smart/Args/TypeTiny.pm

Criterion	Covered	Total	%
statement	70	71	98.5
branch	23	28	82.1
condition	4	7	57.1
subroutine	8	8	100.0
pod	2	2	100.0
total	107	116	92.2

package Smart::Args::TypeTiny;
use strict;
use warnings;
our $VERSION = "0.11";
use Carp ();
use PadWalker qw/var_name/;

use Exporter 'import';
our @EXPORT = qw/args args_pos/;

$Carp::CarpInternal{+__PACKAGE__}++;

use Smart::Args::TypeTiny::Check qw/check_rule/;

my %is_invocant = map { ($_ => 1) } qw($self $class);

sub args {
    {
        package DB;
        # call of caller in DB package sets @DB::args,
        # which requires list context, but we don't need return values
        () = CORE::caller(1);
    }

    if (@_) {
        my $name = var_name(1, \$_[0]) || '';
        if ($is_invocant{$name}) { # seems instance/class method call
            $name =~ s/^\$//;
            $_[0] = shift @DB::args;
            if (defined $_[1]) { # has rule?
                $_[0] = check_rule($_[1], $_[0], 1, $name);
                shift;
            }
            shift;
        }
    }

    my $args = (@DB::args == 1 && ref $DB::args[0] eq 'HASH')
            ? +{ %{$DB::args[0]} } # must be hash
            : +{ @DB::args };      # must be key-value list
    my $kv = {};

    # args my $var => RULE
    #         ~~~~    ~~~~
    #         undef   defined

    for (my $i = 0; $i < @_; $i++) {
        (my $name = var_name(1, \$_[$i]))
            or Carp::croak('Usage: args my $var => RULE, ...');
        $name =~ s/^\$//;

        # with rule (my $foo => RULE, ...)
        if (defined $_[$i+1]) {
            $_[$i] = $kv->{$name} = check_rule($_[$i+1], $args->{$name}, exists $args->{$name}, $name);
            delete $args->{$name};
            $i++;
        }
        # without rule (my $foo, my $bar, ...)
        else {
            unless (exists $args->{$name}) {
                Carp::confess("Required parameter '$name' not passed");
            }
            $_[$i] = $kv->{$name} = delete $args->{$name};
        }
    }

    for my $name (sort keys %$args) {
        Carp::confess("Unexpected parameter '$name' passed");
    }

    return $kv;
}

sub args_pos {
    {
        package DB;
        # call of caller in DB package sets @DB::args,
        # which requires list context, but we don't need return values
        () = CORE::caller(1);
    }

    if (@_) {
        my $name = var_name(1, \$_[0]) || '';
        if ($is_invocant{$name}) { # seems instance/class method call
            $name =~ s/^\$//;
            $_[0] = shift @DB::args;
            if (defined $_[1]) { # has rule?
                $_[0] = check_rule($_[1], $_[0], 1, $name);
                shift;
            }
            shift;
        }
    }

    my $args = [@DB::args];
    my $kv = {};

    # args my $var => RULE
    #         ~~~~    ~~~~
    #         undef   defined

    for (my $i = 0; $i < @_; $i++) {
        (my $name = var_name(1, \$_[$i]))
            or Carp::croak('Usage: args_pos my $var => RULE, ...');
        $name =~ s/^\$//;

        # with rule (my $foo => RULE, ...)
        if (defined $_[$i+1]) {
            $_[$i] = $kv->{$name} = check_rule($_[$i+1], $args->[0], @$args > 0, $name);
            shift @$args;
            $i++;
        }
        # without rule (my $foo, my $bar, ...)
        else {
            unless (@$args > 0) {
                Carp::confess("Required parameter '$name' not passed");
            }
            $_[$i] = $kv->{$name} = shift @$args;
        }
    }

    if (@$args) {
        Carp::confess('Too many parameters passed');
    }

    return $kv;
}

1;
__END__