This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Encode 2.34
authorDavid Mitchell <davem@iabyn.com>
Fri, 10 Jul 2009 13:33:57 +0000 (14:33 +0100)
committerDavid Mitchell <davem@iabyn.com>
Fri, 10 Jul 2009 13:33:57 +0000 (14:33 +0100)
MANIFEST
Porting/Maintainers.pl
ext/Encode/Changes
ext/Encode/Encode.pm
ext/Encode/Makefile.PL
ext/Encode/bin/piconv
ext/Encode/t/piconv.t [new file with mode: 0644]

index a31755f..f115e84 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -565,6 +565,7 @@ ext/Encode/t/mime-header.t  test script
 ext/Encode/t/mime-name.t       test script
 ext/Encode/t/Mod_EUCJP.pm      module that t/enc_module.enc uses
 ext/Encode/t/perlio.t          test script
+ext/Encode/t/piconv.t          test script
 ext/Encode/t/rt.pl             test script
 ext/Encode/t/unibench.pl       benchmark script
 ext/Encode/t/Unicode.t         test script
index 6df22bf..697aa4f 100755 (executable)
@@ -577,7 +577,7 @@ package Maintainers;
     'Encode' =>
        {
        'MAINTAINER'    => 'dankogai',
-       'DISTRIBUTION'  => 'DANKOGAI/Encode-2.33.tar.gz',
+       'DISTRIBUTION'  => 'DANKOGAI/Encode-2.34.tar.gz',
        'FILES'         => q[ext/Encode],
        'CPAN'          => 1,
        'UPSTREAM'      => undef,
index 5c68f48..03c4ef8 100644 (file)
@@ -1,12 +1,23 @@
 # Revision history for Perl extension Encode.
 #
-# $Id: Changes,v 2.33 2009/03/25 07:55:57 dankogai Exp dankogai $
-#
-$Revision: 2.33 $ $Date: 2009/03/25 07:55:57 $
+# $Id: Changes,v 2.34 2009/07/08 13:34:15 dankogai Exp $
+$Revision: 2.34 $ $Date: 2009/07/08 13:34:15 $
+! bin/piconv
+  duplicate-BOM problem now fixed.
+  Message-Id: <10ECB9B7-006E-4570-9EB6-51C49F04ADCF@dan.co.jp>
+! bin/piconv
++ t/piconv.t
+  patches and tests by SREZIC
+  Message-Id: <4A5366DA.8050801@iconmobile.com>
+! Makefile.PL
+  man* removed on behalf of blead
+  Message-Id: <20090326135219.GU18164@plum.flirble.org>
+
+2.33 2009/03/25 07:55:57
 ! lib/Encode/MIME/Header.pm
   Decontaminated $& which sneaked in on 2.31.
-  <67FC9F3A39C746DA95AAB6BB01539099@robmhp>
-  <693254b90903242352x2dc26ba6p5e68deb871fa88ae@mail.gmail.com>
+  Message-Id: <67FC9F3A39C746DA95AAB6BB01539099@robmhp>
+  Message-Id: <693254b90903242352x2dc26ba6p5e68deb871fa88ae@mail.gmail.com>
   http://coderepos.org/share/changeset/31542
 
 2.32 2009/03/07 07:32:37
index c6ba72f..307e241 100644 (file)
@@ -1,10 +1,10 @@
 #
-# $Id: Encode.pm,v 2.33 2009/03/25 07:53:19 dankogai Exp $
+# $Id: Encode.pm,v 2.34 2009/07/08 13:34:59 dankogai Exp $
 #
 package Encode;
 use strict;
 use warnings;
-our $VERSION = sprintf "%d.%02d", q$Revision: 2.33 $ =~ /(\d+)/g;
+our $VERSION = sprintf "%d.%02d", q$Revision: 2.34 $ =~ /(\d+)/g;
 sub DEBUG () { 0 }
 use XSLoader ();
 XSLoader::load( __PACKAGE__, $VERSION );
index 5b8f832..2db8802 100644 (file)
@@ -1,5 +1,5 @@
 #
-# $Id: Makefile.PL,v 2.7 2008/07/01 20:56:17 dankogai Exp $
+# $Id: Makefile.PL,v 2.8 2009/07/08 13:34:15 dankogai Exp $
 #
 use 5.007003;
 use strict;
@@ -31,8 +31,6 @@ my @pmlibdirs = qw(lib Encode);
 
 $ARGV{MORE_SCRIPTS} and push @exe_files, @more_exe_files;
 $ARGV{INSTALL_UCM}   and push @pmlibdirs, "ucm";
-my @man =  ();
-@man = ( MAN1PODS => {}, MAN3PODS => {} ) if $ENV{PERL_CORE};
 
 WriteMakefile(
     NAME         => "Encode",
@@ -44,7 +42,6 @@ WriteMakefile(
         SUFFIX       => 'gz',
         DIST_DEFAULT => 'all tardist',
     },
-    @man,
     INC         => '-I' . File::Spec->catfile( '.', 'Encode' ),
     PMLIBDIRS   => \@pmlibdirs,
     INSTALLDIRS => 'perl',
index 840bf3e..9fdebd1 100644 (file)
@@ -1,5 +1,5 @@
 #!./perl
-# $Id: piconv,v 2.3 2007/04/06 12:53:41 dankogai Exp $
+# $Id: piconv,v 2.4 2009/07/08 13:34:15 dankogai Exp $
 #
 use 5.8.0;
 use strict;
@@ -40,7 +40,19 @@ $Opt{from} || $Opt{to} || help();
 my $from = $Opt{from} || $locale or help("from_encoding unspecified");
 my $to   = $Opt{to}   || $locale or help("to_encoding unspecified");
 $Opt{string} and Encode::from_to($Opt{string}, $from, $to) and print $Opt{string} and exit;
-my $scheme = exists $Scheme{$Opt{scheme}} ? $Opt{scheme} :  'from_to';
+my $scheme = do {
+    if (defined $Opt{scheme}) {
+       if (!exists $Scheme{$Opt{scheme}}) {
+           warn "Unknown scheme '$Opt{scheme}', fallback to 'from_to'.\n";
+           'from_to';
+       } else {
+           $Opt{scheme};
+       }
+    } else {
+       'from_to';
+    }
+};
+
 $Opt{check} ||= $Opt{c};
 $Opt{perlqq}   and $Opt{check} = Encode::PERLQQ;
 $Opt{htmlcref} and $Opt{check} = Encode::HTMLCREF;
@@ -56,29 +68,48 @@ To:     $to => $cto
 EOT
 }
 
+my %use_bom = map { $_ => 1 } qw/UTF-16 UTF-32/;
+
 # we do not use <> (or ARGV) for the sake of binmode()
 @ARGV or push @ARGV, \*STDIN;
 
 unless ( $scheme eq 'perlio' ) {
     binmode STDOUT;
+    my $need2slurp = $use_bom{ find_encoding($to)->name };
     for my $argv (@ARGV) {
         my $ifh = ref $argv ? $argv : undef;
+       $ifh or open $ifh, "<", $argv or warn "Can't open $argv: $!" and next;
         $ifh or open $ifh, "<", $argv or next;
         binmode $ifh;
         if ( $scheme eq 'from_to' ) {    # default
-            while (<$ifh>) {
-                Encode::from_to( $_, $from, $to, $Opt{check} );
-                print;
-            }
+           if ($need2slurp){
+               local $/;
+               $_ = <$ifh>;
+               Encode::from_to( $_, $from, $to, $Opt{check} );
+               print;
+           }else{
+               while (<$ifh>) {
+                   Encode::from_to( $_, $from, $to, $Opt{check} );
+                   print;
+               }
+           }
         }
         elsif ( $scheme eq 'decode_encode' ) {    # step-by-step
-            while (<$ifh>) {
+           if ($need2slurp){
+               local $/;
+               $_ = <$ifh>;
                 my $decoded = decode( $from, $_, $Opt{check} );
                 my $encoded = encode( $to, $decoded );
                 print $encoded;
-            }
-        }
-        else {                                    # won't reach
+           }else{
+               while (<$ifh>) {
+                   my $decoded = decode( $from, $_, $Opt{check} );
+                   my $encoded = encode( $to, $decoded );
+                   print $encoded;
+               }
+           }
+       }
+       else {                                    # won't reach
             die "$name: unknown scheme: $scheme";
         }
     }
@@ -89,6 +120,7 @@ else {
     binmode STDOUT => "raw:encoding($to)";
     for my $argv (@ARGV) {
         my $ifh = ref $argv ? $argv : undef;
+       $ifh or open $ifh, "<", $argv or warn "Can't open $argv: $!" and next;
         $ifh or open $ifh, "<", $argv or next;
         binmode $ifh => "raw:encoding($from)";
         print while (<$ifh>);
@@ -257,8 +289,8 @@ Like the I<-D> option, this is also for Encode hackers.
 
 =head1 SEE ALSO
 
-L<iconv/1>
-L<locale/3>
+L<iconv(1)>
+L<locale(3)>
 L<Encode>
 L<Encode::Supported>
 L<Encode::Alias>
diff --git a/ext/Encode/t/piconv.t b/ext/Encode/t/piconv.t
new file mode 100644 (file)
index 0000000..898d18f
--- /dev/null
@@ -0,0 +1,77 @@
+#
+# $Id: piconv.t,v 0.1 2009/07/08 12:34:21 dankogai Exp $
+#
+
+BEGIN {
+    if ( $ENV{'PERL_CORE'} ) {
+        print "1..0 # Skip: Don't know how to test this within perl's core\n";
+        exit 0;
+    }
+}
+
+use strict;
+use FindBin;
+use File::Spec;
+use IPC::Open3 qw(open3);
+use IO::Select;
+use Test::More;
+
+sub run_cmd (;$$);
+
+my $blib =
+  File::Spec->rel2abs(
+    File::Spec->catfile( $FindBin::RealBin, File::Spec->updir, 'blib' ) );
+my $script = "$blib/script/piconv";
+my @base_cmd = ( $^X, "-Mblib=$blib", $script );
+
+plan tests => 5;
+
+{
+    my ( $st, $out, $err ) = run_cmd;
+    is( $st, 0, 'status for usage call' );
+    is( $out, undef );
+    like( $err, qr{^piconv}, 'usage' );
+}
+
+{
+    my($st, $out, $err) = run_cmd [qw(-S foobar -f utf-8 -t ascii), $script];
+    like($err, qr{unknown scheme.*fallback}i, 'warning for unknown scheme');
+}
+
+{
+    my ( $st, $out, $err ) = run_cmd [qw(-f utf-8 -t ascii ./non-existing/file)];
+    like( $err, qr{can't open}i );
+}
+
+sub run_cmd (;$$) {
+    my ( $args, $in ) = @_;
+    $in ||= '';
+    my ( $out, $err );
+    my ( $in_fh, $out_fh, $err_fh );
+    use Symbol 'gensym';
+    $err_fh =
+      gensym;    # sigh... otherwise stderr gets just to $out_fh, not to $err_fh
+    my $pid = open3( $in_fh, $out_fh, $err_fh, @base_cmd, @$args )
+      or die "Can't run @base_cmd @$args: $!";
+    print $in_fh $in;
+    my $sel = IO::Select->new( $out_fh, $err_fh );
+
+    while ( my @ready = $sel->can_read ) {
+        for my $fh (@ready) {
+            if ( eof($fh) ) {
+                $sel->remove($fh);
+                last if !$sel->handles;
+            }
+            elsif ( $out_fh == $fh ) {
+                my $line = <$fh>;
+                $out .= $line;
+            }
+            elsif ( $err_fh == $fh ) {
+                my $line = <$fh>;
+                $err .= $line;
+            }
+        }
+    }
+    my $st = $?;
+    ( $st, $out, $err );
+}