X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FSub%2FPrototype%2FUtil.pm;h=1bace59e0416137415ef486b8dc8da44324eeb82;hb=fc524c3e7d5c883b8a51b8986a2968c0f10ab5ea;hp=6bf77901c8a042635d0d89c858b22419b6ed3a35;hpb=ea95d5eb42f17626bfca0f26e58a7d6c28e74d47;p=perl%2Fmodules%2FSub-Prototype-Util.git diff --git a/lib/Sub/Prototype/Util.pm b/lib/Sub/Prototype/Util.pm index 6bf7790..1bace59 100644 --- a/lib/Sub/Prototype/Util.pm +++ b/lib/Sub/Prototype/Util.pm @@ -14,13 +14,13 @@ Sub::Prototype::Util - Prototype-related utility routines. =head1 VERSION -Version 0.09 +Version 0.10 =cut use vars qw<$VERSION>; -$VERSION = '0.09'; +$VERSION = '0.10'; =head1 SYNOPSIS @@ -132,7 +132,7 @@ In this case, C<$name> must be a hash reference that holds exactly one key / val my $push = wrap { 'CORE::push' => '\@$' }; # only pushes 1 arg -Others arguments are seen as key / value pairs that are meant to tune the code generated by L. +The remaining arguments C<%opts> are treated as key / value pairs that are meant to tune the code generated by L. Valid keys are : =over 4 @@ -293,18 +293,36 @@ If you plan to recall several times, consider using L instead. =cut -sub recall { - my $name = shift; +sub recall; - my ($wrap, $err); - { - local $@; - $wrap = eval { wrap $name }; - $err = $@; - } - croak _clean_msg $err if $err; +BEGIN { + my $safe_wrap = sub { + my $name = shift; + + my ($wrap, $err); + { + local $@; + $wrap = eval { wrap $name }; + $err = $@; + } - goto $wrap; + $wrap, $err; + }; + + if ("$]" == 5.008) { + # goto tends to crash a lot on perl 5.8.0 + *recall = sub { + my ($wrap, $err) = $safe_wrap->(shift); + croak _clean_msg $err if $err; + $wrap->(@_) + } + } else { + *recall = sub { + my ($wrap, $err) = $safe_wrap->(shift); + croak _clean_msg $err if $err; + goto $wrap; + } + } } =head1 EXPORT