=head1 NAME
-Sub::Prototype::Util - Prototypes-related utility routines.
+Sub::Prototype::Util - Prototype-related utility routines.
=head1 VERSION
-Version 0.01
+Version 0.04
=cut
-our $VERSION = '0.01';
+use vars qw/$VERSION/;
+
+$VERSION = '0.04';
=head1 SYNOPSIS
=head1 DESCRIPTION
-Prototypes are evil, but sometimes you just have to bear with them, especially when messing with core functions. This module provides several utilities aimed at faciliting "overloading" of prototyped functions.
+Prototypes are evil, but sometimes you just have to bear with them, especially when messing with core functions. This module provides several utilities aimed at facilitating "overloading" of prototyped functions.
They all handle C<5.10>'s C<_> prototype.
} elsif ($p =~ /[\@\%]/) {
push @args, @_;
last;
- } elsif ($p eq '_') {
+ } elsif ($p eq '_' && @_ == 0) {
push @args, $_;
} else {
push @args, shift;
=cut
sub recall {
- my ($name, @a) = @_;
+ my $name = shift;
croak 'Wrong subroutine name' unless $name;
$name =~ s/^\s+//;
$name =~ s/[\s\$\@\%\*\&;].*//;
my $proto = prototype $name;
my @args;
+ my @cr;
if (defined $proto) {
my $i = 0;
while ($proto =~ /(\\?)(\[[^\]]+\]|[^\];])/g) {
my $p = $2;
if ($1) {
- my $r = _check_ref $a[$i], $p;
- push @args, join '', $sigils{$r}, '{$a[', $i, ']}';
+ my $r = _check_ref $_[$i], $p;
+ push @args, join '', $sigils{$r}, '{$_[', $i, ']}';
} elsif ($p =~ /[\@\%]/) {
- push @args, join '', '@a[', $i, '..', (@a - 1), ']';
+ push @args, join '', '@_[', $i, '..', (@_ - 1), ']';
last;
} elsif ($p =~ /\&/) {
- push @args, 'sub{&{$a[' . $i . ']}}';
- } elsif ($p eq '_') {
+ push @cr, $_[$i];
+ push @args, 'sub{&{$cr[' . $#cr . ']}}';
+ } elsif ($p eq '_' && $i >= @_) {
push @args, '$_';
} else {
- push @args, '$a[' . $i . ']';
+ push @args, '$_[' . $i . ']';
}
++$i;
}
} else {
- @args = map '$a[' . $_ . ']', 0 .. @a - 1;
+ @args = map '$_[' . $_ . ']', 0 .. @_ - 1;
}
my @ret = eval $name . '(' . join(',', @args) . ');';
croak $@ if $@;
=head1 EXPORT
-The functions L</flatten> and L</recall> are only exported on request, either by providing their name or by the C<':consts'> and C<':all'> tags.
+The functions L</flatten> and L</recall> are only exported on request, either by providing their name or by the C<':funcs'> and C<':all'> tags.
=cut
use base qw/Exporter/;
-our @EXPORT = ();
-our %EXPORT_TAGS = (
+use vars qw/@EXPORT @EXPORT_OK %EXPORT_TAGS/;
+
+@EXPORT = ();
+%EXPORT_TAGS = (
'funcs' => [ qw/flatten recall/ ]
);
-our @EXPORT_OK = map { @$_ } values %EXPORT_TAGS;
+@EXPORT_OK = map { @$_ } values %EXPORT_TAGS;
$EXPORT_TAGS{'all'} = [ @EXPORT_OK ];
=head1 DEPENDENCIES
-L<Carp> (core module since perl 5), L<Scalar::Util> (since 5.7.3).
+L<Carp>, L<Exporter> (core modules since perl 5), L<Scalar::Util> (since 5.7.3).
=head1 AUTHOR