X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FSub-Prototype-Util.git;a=blobdiff_plain;f=lib%2FSub%2FPrototype%2FUtil.pm;h=20525ece0971b354170d655b1ce89b344100467c;hp=d549a1cc992e8ea86ceac04a35f89d11a7207098;hb=92b328c090598b186ee6dd5168ca4b5047a834c9;hpb=06a00e8349c4f0c7b7388af0dbfcd562721e8d43 diff --git a/lib/Sub/Prototype/Util.pm b/lib/Sub/Prototype/Util.pm index d549a1c..20525ec 100644 --- a/lib/Sub/Prototype/Util.pm +++ b/lib/Sub/Prototype/Util.pm @@ -57,6 +57,12 @@ sub _check_ref { return $r; } +sub _clean_msg { + my ($msg) = @_; + $msg =~ s/(?:\s+called)?\s+at\s+.*$//s; + return $msg; +} + =head2 C Flattens the array C<@args> according to the prototype C<$proto>. When C<@args> is what C<@_> is after calling a subroutine with prototype C<$proto>, C returns the list of what C<@_> would have been if there were no prototype. @@ -223,7 +229,7 @@ sub wrap { $call = 'sub ' . $call if $opts{sub}; if ($opts{compile}) { $call = eval $call; - croak $@ if $@; + croak _clean_msg $@ if $@; } return $call; } @@ -242,7 +248,7 @@ If you plan to recall several times, consider using L instead. sub recall { my $wrap = eval { wrap shift }; - croak $@ if $@; + croak _clean_msg $@ if $@; return $wrap->(@_); }