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
'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,
# 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
#
-# $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 );
#
-# $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;
$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",
SUFFIX => 'gz',
DIST_DEFAULT => 'all tardist',
},
- @man,
INC => '-I' . File::Spec->catfile( '.', 'Encode' ),
PMLIBDIRS => \@pmlibdirs,
INSTALLDIRS => 'perl',
#!./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;
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;
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";
}
}
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>);
=head1 SEE ALSO
-L<iconv/1>
-L<locale/3>
+L<iconv(1)>
+L<locale(3)>
L<Encode>
L<Encode::Supported>
L<Encode::Alias>
--- /dev/null
+#
+# $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 );
+}
projects / p5sagit/p5-mst-13.2.git / commitdiff