X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FSub%2FPrototype%2FUtil.pm;h=5c0c04ee99770eeb18bfc44cb5b9e1ea33342f6f;hb=refs%2Ftags%2Fv0.04;hp=661d03d71cb1354f1c13f28a15f6e08c71fa2e37;hpb=5e934b02978f8e2a411e8aba352fc6465c0e3aba;p=perl%2Fmodules%2FSub-Prototype-Util.git

diff --git a/lib/Sub/Prototype/Util.pm b/lib/Sub/Prototype/Util.pm
index 661d03d..5c0c04e 100644
--- a/lib/Sub/Prototype/Util.pm
+++ b/lib/Sub/Prototype/Util.pm
@@ -12,11 +12,13 @@ Sub::Prototype::Util - Prototype-related utility routines.
 
 =head1 VERSION
 
-Version 0.02
+Version 0.04
 
 =cut
 
-our $VERSION = '0.02';
+use vars qw/$VERSION/;
+
+$VERSION = '0.04';
 
 =head1 SYNOPSIS
 
@@ -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 $@;
@@ -140,11 +144,13 @@ The functions L</flatten> and L</recall> are only exported on request, either by
 
 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