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

4 files changed, 78 insertions, 38 deletions

diff --git a/dist/Locale-Maketext/ChangeLog b/dist/Locale-Maketext/ChangeLog
index 16891a1fb4..a8af6589eb 100644
--- 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
index 5479a60d2a..71d358824d 100644
--- 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
new file mode 100644
index 0000000000..523365de67
--- /dev/null
+++ 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
deleted file mode 100644
index 23fa2ac551..0000000000
--- a/dist/Locale-Maketext/t/30_local.t
+++ /dev/null
@@ -1,23 +0,0 @@
-#!/usr/bin/perl -Tw
-
-use strict;
-
-use Test::More tests => 3;
-use Locale::Maketext;
-
-# declare a class...
-{
-  package Woozle;
-  our @ISA = ('Locale::Maketext');
-  our %Lexicon = (
-    _AUTO => 1
-  );
-  keys %Lexicon; # dodges the 'used only once' warning
-}
-
-my $lh = Woozle->new();
-isa_ok($lh, 'Woozle');
-
-$@ = 'foo';
-is($lh->maketext('Eval error: [_1]', $@), 'Eval error: foo', "Make sure \$@ is localized when passed to maketext");
-is($@, 'foo', "\$@ wasn't modified during call");