From: Vincent Pit Date: Thu, 25 Aug 2011 09:46:31 +0000 (+0200) Subject: Clean up _check_ref() X-Git-Tag: v0.10~7 X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FSub-Prototype-Util.git;a=commitdiff_plain;h=a0be79c11310f2a8e4edeca50e9ade6bd95b11d0 Clean up _check_ref() --- diff --git a/lib/Sub/Prototype/Util.pm b/lib/Sub/Prototype/Util.pm index 93efb1f..efcd974 100644 --- a/lib/Sub/Prototype/Util.pm +++ b/lib/Sub/Prototype/Util.pm @@ -45,19 +45,23 @@ 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 {