Upgrade to encoding-warnings-0.10

p4raw-id: //depot/perl@28504

3 files changed, 77 insertions, 24 deletions

diff --git a/lib/encoding/warnings.pm b/lib/encoding/warnings.pm
index ba64b12f06..3ff3512cfc 100644
--- a/lib/encoding/warnings.pm
+++ b/lib/encoding/warnings.pm
@@ -1,10 +1,8 @@
-# $File: //member/autrijus/.vimrc $ $Author: autrijus $
-# $Revision: #14 $ $Change: 4137 $ $DateTime: 2003/02/08 11:41:59 $
-
 package encoding::warnings;
-$encoding::warnings::VERSION = '0.05';
+$encoding::warnings::VERSION = '0.10';
 
 use strict;
+use 5.007;
 
 =head1 NAME
 
@@ -12,8 +10,8 @@ encoding::warnings - Warn on implicit encoding conversions
 
 =head1 VERSION
 
-This document describes version 0.05 of encoding::warnings, released
-July 15, 2004.
+This document describes version 0.10 of encoding::warnings, released
+July 7, 2006.
 
 =head1 SYNOPSIS
 
@@ -136,9 +134,10 @@ silencing warnings from this module.  See L<encoding> for more details.
 
 =head1 CAVEATS
 
-This module currently affects the whole script, instead of inside its
-lexical block.  This is expected to be addressed during Perl 5.9 development,
-where the B<encoding> module will also be made lexical.
+For Perl 5.9.4 or later, this module's effect is lexical.
+
+For Perl versions prior to 5.9.4, this module affects the whole script,
+instead of inside its lexical block.
 
 =cut
 
@@ -163,13 +162,21 @@ sub import {
     undef ${^ENCODING};
 
     # Install a warning handler for decode()
-    ${^ENCODING} = bless(
+    my $decoder = bless(
 	[
 	    $ascii,
 	    $latin1,
 	    (($fatal eq 'FATAL') ? 'Carp::croak' : 'Carp::carp'),
 	], $class,
     );
+
+    ${^ENCODING} = $decoder;
+    $^H{$class} = 1;
+}
+
+sub unimport {
+    my $class = shift;
+    $^H{$class} = undef;
 }
 
 # Don't worry about source code literals.
@@ -182,15 +189,24 @@ sub cat_decode {
 sub decode {
     my $self = shift;
 
-    local $@;
-    my $rv = eval { $self->[ASCII]->decode($_[0], Encode::FB_CROAK()) };
-    return $rv unless $@;
+    DO_WARN: {
+        if ($] >= 5.009004) {
+            my $hints = (caller(0))[10];
+            $hints->{ref($self)} or last DO_WARN;
+        }
+
+        local $@;
+        my $rv = eval { $self->[ASCII]->decode($_[0], Encode::FB_CROAK()) };
+        return $rv unless $@;
+
+        require Carp;
+        no strict 'refs';
+        $self->[FATAL]->(
+            "Bytes implicitly upgraded into wide characters as iso-8859-1"
+        );
+
+    }
 
-    require Carp;
-    no strict 'refs';
-    $self->[FATAL]->(
-	"Bytes implicitly upgraded into wide characters as iso-8859-1"
-    );
     return $self->[LATIN1]->decode(@_);
 }
 
@@ -208,11 +224,11 @@ L<open>, L<utf8>, L<encoding>, L<Encode>
 
 =head1 AUTHORS
 
-Autrijus Tang E<lt>autrijus@autrijus.orgE<gt>
+Audrey Tang
 
 =head1 COPYRIGHT
 
-Copyright 2004 by Autrijus Tang E<lt>autrijus@autrijus.orgE<gt>.
+Copyright 2004, 2005, 2006 by Audrey Tang E<lt>cpan@audreyt.orgE<gt>.
 
 This program is free software; you can redistribute it and/or modify it
 under the same terms as Perl itself.
diff --git a/lib/encoding/warnings/t/3-normal.t b/lib/encoding/warnings/t/3-normal.t
index f573a86673..f0e6446a56 100644
--- a/lib/encoding/warnings/t/3-normal.t
+++ b/lib/encoding/warnings/t/3-normal.t
@@ -1,7 +1,3 @@
-#!/usr/bin/perl
-# $File: /member/local/autrijus/encoding-warnings/t/3-normal.t $ $Author: autrijus $
-# $Revision: #3 $ $Change: 1625 $ $DateTime: 2004-03-14T16:50:26.012462Z $
-
 use Test;
 BEGIN { plan tests => 2 }
 
diff --git a/lib/encoding/warnings/t/4-lexical.t b/lib/encoding/warnings/t/4-lexical.t
new file mode 100644
index 0000000000..5031cf37c2
--- /dev/null
+++ b/lib/encoding/warnings/t/4-lexical.t
@@ -0,0 +1,41 @@
+use strict;
+use Test;
+BEGIN { plan tests => 3 }
+
+{
+    use encoding::warnings;
+    ok(encoding::warnings->VERSION);
+
+    if ($] < 5.009004) {
+        ok('skipped');
+        ok('skipped');
+        exit;
+    }
+
+    my ($a, $b, $c, $warned);
+
+    local $SIG{__WARN__} = sub {
+        if ($_[0] =~ /upgraded/) { $warned = 1 }
+    };
+
+    utf8::encode($a = chr(20000));
+    $b = chr(20000);
+    $c = $a . $b;
+    ok($warned);
+}
+
+{
+    my ($a, $b, $c, $warned);
+
+    local $SIG{__WARN__} = sub {
+        if ($_[0] =~ /upgraded/) { $warned = 1 }
+    };
+
+    utf8::encode($a = chr(20000));
+    $b = chr(20000);
+    $c = $a . $b;
+    ok(!$warned);
+}
+
+
+__END__