Changeset 34359

Timestamp:

07/08/09 22:40:07 (4 years ago)

Author:

dankogai

Message:

VERSION 2.34

Location:

lang/perl/Encode/trunk

Files:

• Changes (modified) (1 diff)
• Encode.pm (modified) (1 diff)
• MANIFEST (modified) (1 diff)
• Makefile.PL (modified) (1 diff)
• bin/piconv (modified) (6 diffs)
• t/piconv.t (added)

lang/perl/Encode/trunk/Changes

@@ -1 +1 @@
 # 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

lang/perl/Encode/trunk/Encode.pm

@@ -1 +1 @@
 #
-# $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 ();

lang/perl/Encode/trunk/MANIFEST

@@ -95 +95 @@
 t/mime_header_iso2022jp.t  test script
 t/perlio.t      test script
+t/piconv.t      test script
 t/rt.pl         even more test script
 t/unibench.pl   benchmark script

lang/perl/Encode/trunk/Makefile.PL

@@ -1 +1 @@
 #
-# $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;

lang/perl/Encode/trunk/bin/piconv

@@ -1 +1 @@
 #!./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;
@@ -41 +41 @@
 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;
@@ -57 +69 @@
 }
 
+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;
@@ -62 +76 @@
 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";
         }
@@ -90 +121 @@
     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)";
@@ -258 +290 @@
 =head1 SEE ALSO
 
-L<iconv/1>
-L<locale/3>
+L<iconv(1)>
+L<locale(3)>
 L<Encode>
 L<Encode::Supported>