From: David Mitchell Date: Fri, 10 Jul 2009 13:33:57 +0000 (+0100) Subject: Encode 2.34 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1a1e8f7d433e70884ebe2651b04785ff7f5161ad;p=p5sagit%2Fp5-mst-13.2.git Encode 2.34 --- diff --git a/MANIFEST b/MANIFEST index a31755f..f115e84 100644 --- 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 diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 6df22bf..697aa4f 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -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, diff --git a/ext/Encode/Changes b/ext/Encode/Changes index 5c68f48..03c4ef8 100644 --- a/ext/Encode/Changes +++ b/ext/Encode/Changes @@ -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 diff --git a/ext/Encode/Encode.pm b/ext/Encode/Encode.pm index c6ba72f..307e241 100644 --- a/ext/Encode/Encode.pm +++ b/ext/Encode/Encode.pm @@ -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 ); diff --git a/ext/Encode/Makefile.PL b/ext/Encode/Makefile.PL index 5b8f832..2db8802 100644 --- a/ext/Encode/Makefile.PL +++ b/ext/Encode/Makefile.PL @@ -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', diff --git a/ext/Encode/bin/piconv b/ext/Encode/bin/piconv index 840bf3e..9fdebd1 100644 --- a/ext/Encode/bin/piconv +++ b/ext/Encode/bin/piconv @@ -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 -L +L +L L L L diff --git a/ext/Encode/t/piconv.t b/ext/Encode/t/piconv.t new file mode 100644 index 0000000..898d18f --- /dev/null +++ b/ext/Encode/t/piconv.t @@ -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 ); +}