File Coverage

blib/lib/Attribute/Curried.pm

Criterion	Covered	Total	%
statement	32	36	88.8
branch	6	10	60.0
condition	1	3	33.3
subroutine	8	8	100.0
pod	0	1	0.0
total	47	58	81.0

package Attribute::Curried;

use 5.006;
use strict;
use Attribute::Handlers;

our $VERSION = '0.02';


sub UNIVERSAL::Curry :ATTR(CODE) {
    my ($package, $symbol, $code, $name, $n) = @_;
    $n = $n->[0] if ref $n;
    local($^W) = 0;
    no strict 'refs';
    my $subname = $package . '::' . *{$symbol}{NAME};

    if ($symbol eq 'ANON') {
 	return;
    }
    unless (defined($n) && $n > 1) {
	warn "Usage: \"sub $subname :Curry(ARGS)\", ARGS > 1";
	return;
    }
    undef *{$subname};	# to quiet warnings about prototypes
    *{$subname} = _curry($n, $code);
}

sub _curry {
    my ($n, $func, @args) = @_;
    return sub {
	my $narg = @_ + @args;
	if ($narg > $n) {
 	    die "$narg args to curried function (expects $n).";
	} elsif ($narg < $n) {
 	    return _curry($n, $func, @args, @_);
	} else {
 	    return &$func(@args, @_);
	}
    }
}

1;
__END__