X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FSub%2FPrototype%2FUtil.pm;h=efcd9749771bafbedce3173e8970a399da6a3422;hb=a0be79c11310f2a8e4edeca50e9ade6bd95b11d0;hp=a580cc16343103d061e3b8bc8c2a9e81debdb5d9;hpb=1d86cd887b8dbb41650915d7e60dcc077bd2ad35;p=perl%2Fmodules%2FSub-Prototype-Util.git

diff --git a/lib/Sub/Prototype/Util.pm b/lib/Sub/Prototype/Util.pm
index a580cc1..efcd974 100644
--- a/lib/Sub/Prototype/Util.pm
+++ b/lib/Sub/Prototype/Util.pm
@@ -45,25 +45,31 @@ They all handle C<5.10>'s C<_> prototype.
 
 =cut
 
-my %sigils = qw/SCALAR $ ARRAY @ HASH % GLOB * CODE &/;
+my %sigils   = qw/SCALAR $ ARRAY @ HASH % GLOB * CODE &/;
 my %reftypes = reverse %sigils;
 
 sub _check_ref {
- my ($a, $p) = @_;
- my $r;
- if (!defined $a || !defined($r = reftype $a)) { # not defined or plain scalar
-  croak 'Got ' . ((defined $a) ? 'a plain scalar' : 'undef')
-               . ' where a reference was expected';
+ my ($arg, $sigil) = @_;
+
+ my $reftype;
+ if (not defined $arg or not defined($reftype = reftype $arg)) {
+  # not defined or plain scalar
+  my $that = (defined $arg) ? 'a plain scalar' : 'undef';
+  croak "Got $that where a reference was expected";
  }
- croak 'Unexpected ' . $r . ' reference' unless exists $sigils{$r}
-                                            and $p =~ /\Q$sigils{$r}\E/;
- return $r;
+
+ croak "Unexpected $reftype reference" unless exists $sigils{$reftype}
+                                          and $sigil =~ /\Q$sigils{$reftype}\E/;
+
+ $reftype;
 }
 
 sub _clean_msg {
  my ($msg) = @_;
+
  $msg =~ s/(?:\s+called)?\s+at\s+.*$//s;
- return $msg;
+
+ $msg;
 }
 
 =head2 C<flatten $proto, @args>
@@ -76,26 +82,31 @@ It croaks if the arguments can't possibly match the required prototype, e.g. whe
 
 sub flatten {
  my $proto = shift;
+
  return @_ unless defined $proto;
+
  my @args;
  while ($proto =~ /(\\?)(\[[^\]]+\]|[^\];])/g) {
-  my $p = $2;
+  my $sigil = $2;
+
   if ($1) {
-   my $a = shift;
-   my $r = _check_ref $a, $p;
-   push @args, $r eq 'SCALAR'
-               ? $$a
-               : ($r eq 'ARRAY'
-                  ? @$a
-                  : ($r eq 'HASH'
-                     ? %$a
-                     : ($r eq 'GLOB'
-                        ? *$a
-                        : &$a # _check_ref ensures this must be a code ref
+   my $arg     = shift;
+   my $reftype = _check_ref $arg, $sigil;
+
+   push @args, $reftype eq 'SCALAR'
+               ? $$arg
+               : ($reftype eq 'ARRAY'
+                  ? @$arg
+                  : ($reftype eq 'HASH'
+                     ? %$arg
+                     : ($reftype eq 'GLOB'
+                        ? *$arg
+                        : &$arg # _check_ref ensures this must be a code ref
                        )
                     )
                  );
-  } elsif ($p =~ /[\@\%]/) {
+
+  } elsif ($sigil =~ /[\@\%]/) {
    push @args, @_;
    last;
   } else {
@@ -103,6 +114,7 @@ sub flatten {
    push @args, shift;
   }
  }
+
  return @args;
 }