CPAN RT 34182 (Locale::Maketext) - Don't unnecessarily localize $@.

Do it in scope only so die messages fall through when desired. Previously, there was test code to make sure $@ was not modified when maketext is called, but if the caller wraps maketext in an eval, then it's going to be modified anyways to '' at the least. If the caller does not wrap a maketext call in an eval and maketext dies, then hiding the $@ simply confuses the person debugging as to what went wrong. We do however backup/restore $@ so that it does not break any code that looks might use $@ after a successful call to maketext. eval {...} $lm->maketext($@); do_something_else($@); In the above example, $@ would be the same when passed to do_something_else
Perl · Oct 5, 2010 · 9961f4d · 9961f4d
1 parent afa7457
commit 9961f4d
Show file tree

Hide file tree

Showing 4 changed files with 78 additions and 38 deletions.
diff --git a/dist/Locale-Maketext/ChangeLog b/dist/Locale-Maketext/ChangeLog
@@ -6,6 +6,9 @@ Revision history for Perl suite Locale::Maketext
     Fix for CPAN RT #40727: infinite loop in
     Locale::Maketext::Guts::_compile() when working with tainted values
 
+    Fix for CPAN RT #34182: Don't localize $@. 
+    ->maketext calls will now backup and restore $@ so that die messages are not supressed.
+
 2010−06−22
     * Release 1.15 (included in perl 5.13.3; not released separately)
 

diff --git a/dist/Locale-Maketext/lib/Locale/Maketext.pm b/dist/Locale-Maketext/lib/Locale/Maketext.pm
@@ -160,12 +160,11 @@ sub failure_handler_auto {
     # If we make it here, there was an exception thrown in the
     #  call to $value, and so scream:
     if($@) {
-        my $err = $@;
         # pretty up the error message
-        $err =~ s{\s+at\s+\(eval\s+\d+\)\s+line\s+(\d+)\.?\n?}
+        $@ =~ s{\s+at\s+\(eval\s+\d+\)\s+line\s+(\d+)\.?\n?}
                  {\n in bracket code [compiled line $1],}s;
         #$err =~ s/\n?$/\n/s;
-        Carp::croak "Error in maketexting \"$phrase\":\n$err as used";
+        Carp::croak "Error in maketexting \"$phrase\":\n$@ as used";
         # Rather unexpected, but suppose that the sub tried calling
         # a method that didn't exist.
     }
@@ -195,9 +194,9 @@ sub maketext {
     my($handle, $phrase) = splice(@_,0,2);
     Carp::confess('No handle/phrase') unless (defined($handle) && defined($phrase));
 
-
-    # Don't interefere with $@ in case that's being interpolated into the msg.
-    local $@;
+    # backup $@ in case it it's still being used in the calling code.
+    # If no failures, we'll re-set it back to what it was later.
+    my $at = $@;
 
     # Look up the value:
 
@@ -248,10 +247,12 @@ sub maketext {
             DEBUG and warn "WARNING0: maketext fails looking for <$phrase>\n";
             my $fail;
             if(ref($fail = $handle->{'fail'}) eq 'CODE') { # it's a sub reference
+                $@ = $at; # Put $@ back in case we altered it along the way.
                 return &{$fail}($handle, $phrase, @_);
                 # If it ever returns, it should return a good value.
             }
             else { # It's a method name
+                $@ = $at; # Put $@ back in case we altered it along the way.
                 return $handle->$fail($phrase, @_);
                 # If it ever returns, it should return a good value.
             }
@@ -262,8 +263,14 @@ sub maketext {
         }
     }
 
-    return $$value if ref($value) eq 'SCALAR';
-    return $value unless ref($value) eq 'CODE';
+    if(ref($value) eq 'SCALAR'){
+        $@ = $at; # Put $@ back in case we altered it along the way.
+        return $$value ;
+    }
+    if(ref($value) ne 'CODE'){
+        $@ = $at; # Put $@ back in case we altered it along the way.
+        return $value ;
+    }
 
     {
         local $SIG{'__DIE__'};
@@ -272,18 +279,19 @@ sub maketext {
     # If we make it here, there was an exception thrown in the
     #  call to $value, and so scream:
     if ($@) {
-        my $err = $@;
         # pretty up the error message
-        $err =~ s{\s+at\s+\(eval\s+\d+\)\s+line\s+(\d+)\.?\n?}
+        $@ =~ s{\s+at\s+\(eval\s+\d+\)\s+line\s+(\d+)\.?\n?}
                  {\n in bracket code [compiled line $1],}s;
         #$err =~ s/\n?$/\n/s;
-        Carp::croak "Error in maketexting \"$phrase\":\n$err as used";
+        Carp::croak "Error in maketexting \"$phrase\":\n$@ as used";
         # Rather unexpected, but suppose that the sub tried calling
         # a method that didn't exist.
     }
     else {
+        $@ = $at; # Put $@ back in case we altered it along the way.
         return $value;
     }
+    $@ = $at; # Put $@ back in case we altered it along the way.
 }
 
 ###########################################################################
@@ -434,10 +442,11 @@ sub _try_use {   # Basically a wrapper around "require Modulename"
     }
 
     DEBUG and warn " About to use $module ...\n";
-    {
-        local $SIG{'__DIE__'};
-        eval "require $module"; # used to be "use $module", but no point in that.
-    }
+
+    local $SIG{'__DIE__'};
+    local $@;
+    eval "require $module"; # used to be "use $module", but no point in that.
+
     if($@) {
         DEBUG and warn "Error using $module \: $@\n";
         return $tried{$module} = 0;

diff --git a/dist/Locale-Maketext/t/30_eval_dollar_at.t b/dist/Locale-Maketext/t/30_eval_dollar_at.t
@@ -0,0 +1,51 @@
+use strict;
+use warnings;
+
+{
+    package TEST;
+    use base 'Locale::Maketext';
+}
+
+{
+    package TEST::en;
+    use base 'TEST';
+    our %Lexicon = (
+        _AUTO => 1,
+    );
+}
+
+package main;
+use strict;
+use warnings;
+use Test::More tests => 10;
+
+my $lh = TEST->get_handle('en');
+$@ = "foo";
+is($lh->maketext("This works fine"), "This works fine", "straight forward _AUTO string test");
+is($@, "foo", q{$@ isn't altered during calls to maketext});
+
+my $err = eval {
+   $lh->maketext('this is ] an error');
+};
+is($err, undef, "no return from eval");
+like("$@", qr/Unbalanced\s'\]',\sin/ms, '$@ shows that ] was unbalanced');  
+
+# _try_use doesn't pollute $@
+$@ = 'foo2';
+is(Locale::Maketext::_try_use("This::module::does::not::exist"), 0, "0 return if module is missing when _try_use is called");
+is($@, 'foo2', '$@ is unmodified by a failed _try_use');
+
+# _try_use doesn't pollute $@ for valid call
+$@ = '';
+is(Locale::Maketext::_try_use("Locale::Maketext::Guts"), 1, "1 return using valid module Locale::Maketext::Guts");
+is($@, '', '$@ is clean after failed _try_use');
+
+# failure_handler_auto handles $@ locally.
+{
+    $@ = '';
+    my $err = '';
+    $lh->{failure_lex}->{"foo_fail"} = sub {die("fail message");};
+    $err = eval {$lh->failure_handler_auto("foo_fail")};
+    is($err, undef, "die event calling failure_handler on bad code");
+    like($@, qr/^Error in maketexting "foo_fail":/ms, "\$@ is re-written as expected.");
+}
diff --git a/dist/Locale-Maketext/t/30_local.t b/dist/Locale-Maketext/t/30_local.t