Importing Sub-Prototype-Util-0.04.tar.gz

[perl/modules/Sub-Prototype-Util.git] / lib / Sub / Prototype / Util.pm

diff --git a/lib/Sub/Prototype/Util.pm b/lib/Sub/Prototype/Util.pm
index f090f87be84c8460f2bc030e535d097b1868248e..5c0c04ee99770eeb18bfc44cb5b9e1ea33342f6f 100644 (file)
--- a/lib/Sub/Prototype/Util.pm
+++ b/lib/Sub/Prototype/Util.pm
@@ -8,15 +8,17 @@ use Scalar::Util qw/reftype/;
 
 =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
 
@@ -30,7 +32,7 @@ our $VERSION = '0.01';
 
 =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.
 
@@ -78,7 +80,7 @@ sub flatten {
   } elsif ($p =~ /[\@\%]/) {
    push @args, @_;
    last;
-  } elsif ($p eq '_') {
+  } elsif ($p eq '_' && @_ == 0) {
    push @args, $_;
   } else {
    push @args, shift;
@@ -99,33 +101,35 @@ will call C<push @$a, 1, 2, 3> and so fill the arrayref C<$a> with C<1, 2, 3>. T
 =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 $@;
@@ -134,22 +138,24 @@ sub recall {
 
 =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