From: Steve Peters <steve@fisharerojo.org>
Date: Sat, 8 Jul 2006 01:14:28 +0000 (+0000)
Subject: Upgrade to encoding-warnings-0.10
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6309fe6dc6b6c6b27fa13966a4505c44ca8a8c9b;p=p5sagit%2Fp5-mst-13.2.git

Upgrade to encoding-warnings-0.10

p4raw-id: //depot/perl@28504
---

diff --git a/MANIFEST b/MANIFEST
index 20bbc6f..494daf4 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1614,6 +1614,7 @@ lib/encoding/warnings.pm	warn on implicit encoding conversions
 lib/encoding/warnings/t/1-warning.t	tests for encoding::warnings
 lib/encoding/warnings/t/2-fatal.t	tests for encoding::warnings
 lib/encoding/warnings/t/3-normal.t	tests for encoding::warnings
+lib/encoding/warnings/t/4-lexical.t	tests for encoding::warnings
 lib/English.pm			Readable aliases for short variables
 lib/English.t			See if English works
 lib/Env.pm			Map environment into ordinary variables
diff --git a/lib/encoding/warnings.pm b/lib/encoding/warnings.pm
index ba64b12..3ff3512 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 f573a86..f0e6446 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 0000000..5031cf3
--- /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__