Actually submit previous change.

[p5sagit/p5-mst-13.2.git] / ext / Encode / bin / piconv

diff --git a/ext/Encode/bin/piconv b/ext/Encode/bin/piconv
index 06dea1f..0a2f6f9 100644 (file)
--- a/ext/Encode/bin/piconv
+++ b/ext/Encode/bin/piconv
@@ -1,5 +1,5 @@
 #!./perl
-# $Id: piconv,v 1.27 2003/06/18 09:29:02 dankogai Exp $
+# $Id: piconv,v 2.2 2006/05/03 18:24:10 dankogai Exp $
 #
 use 5.8.0;
 use strict;
@@ -17,18 +17,20 @@ my %Opt;
 help()
     unless
       GetOptions(\%Opt,
-                'from|f=s',
-                'to|t=s',
-                'list|l',
-                'string|s=s',
-                'check|C=i',
-                'c',
-                'perlqq|p',
-                'debug|D',
-                'scheme|S=s',
-                'resolve|r=s',
-                'help',
-                );
+         'from|f=s',
+         'to|t=s',
+         'list|l',
+         'string|s=s',
+         'check|C=i',
+         'c',
+         'perlqq|p',
+         'htmlcref',
+         'xmlcref',
+         'debug|D',
+         'scheme|S=s',
+         'resolve|r=s',
+         'help',
+         );
 
 $Opt{help} and help();
 $Opt{list} and list_encodings();
@@ -40,7 +42,9 @@ 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';
 $Opt{check} ||= $Opt{c};
-$Opt{perlqq} and $Opt{check} = Encode::FB_PERLQQ;
+$Opt{perlqq}   and $Opt{check} = Encode::PERLQQ;
+$Opt{htmlcref} and $Opt{check} = Encode::HTMLCREF;
+$Opt{xmlcref}  and $Opt{check} = Encode::XMLCREF;
 
 if ($Opt{debug}){
     my $cfrom = Encode->getEncoding($from)->name;
@@ -52,43 +56,62 @@ To:     $to => $cto
 EOT
 }
 
-# default
-if     ($scheme eq 'from_to'){ 
-    while(<>){
-       Encode::from_to($_, $from, $to, $Opt{check}); print;
-    };
-# step-by-step
-}elsif ($scheme eq 'decode_encode'){
-   while(<>){
-       my $decoded = decode($from, $_, $Opt{check});
-       my $encoded = encode($to, $decoded);
-       print $encoded;
-    };
-# NI-S favorite
-}elsif ($scheme eq 'perlio'){ 
-    binmode(STDIN,  ":encoding($from)");
-    binmode(STDOUT, ":encoding($to)");
-    while(<>){ print; }
-} else { # won't reach
-    die "$name: unknown scheme: $scheme";
+# we do not use <> (or ARGV) for the sake of binmode()
+@ARGV or push @ARGV, \*STDIN;
+
+unless ( $scheme eq 'perlio' ) {
+    binmode STDOUT;
+    for my $argv (@ARGV) {
+        my $ifh = ref $argv ? $argv : undef;
+        $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;
+            }
+        }
+        elsif ( $scheme eq 'decode_encode' ) {    # step-by-step
+            while (<$ifh>) {
+                my $decoded = decode( $from, $_, $Opt{check} );
+                my $encoded = encode( $to, $decoded );
+                print $encoded;
+            }
+        }
+        else {                                    # won't reach
+            die "$name: unknown scheme: $scheme";
+        }
+    }
+}
+else {
+
+    # NI-S favorite
+    binmode STDOUT => "raw:encoding($to)";
+    for my $argv (@ARGV) {
+        my $ifh = ref $argv ? $argv : undef;
+        $ifh or open $ifh, "<", $argv or next;
+        binmode $ifh => "raw:encoding($from)";
+        print while (<$ifh>);
+    }
 }
 
-sub list_encodings{
-    print join("\n", Encode->encodings(":all")), "\n";
+sub list_encodings {
+    print join( "\n", Encode->encodings(":all") ), "\n";
     exit 0;
 }
 
 sub resolve_encoding {
-    if (my $alias = Encode::resolve_alias($_[0])) {
-       print $alias, "\n";
-       exit 0;
-    } else {
-       warn "$name: $_[0] is not known to Encode\n";
-       exit 1;
+    if ( my $alias = Encode::resolve_alias( $_[0] ) ) {
+        print $alias, "\n";
+        exit 0;
+    }
+    else {
+        warn "$name: $_[0] is not known to Encode\n";
+        exit 1;
     }
 }
 
-sub help{
+sub help {
     my $message = shift;
     $message and print STDERR "$name error: $message\n";
     print STDERR <<"EOT";
@@ -107,10 +130,14 @@ $name -r encoding_alias
      "string" will be the input instead of STDIN or files
 The following are mainly of interest to Encode hackers:
   -D,--debug          show debug information
-  -C N | -c | -p      check the validity of the input
+  -C N | -c           check the validity of the input
   -S,--scheme scheme  use the scheme for conversion
+Those are handy when you can only see ascii characters:
+  -p,--perlqq
+  --htmlcref
+  --xmlcref
 EOT
-  exit;
+    exit;
 }
 
 __END__
@@ -181,7 +208,15 @@ Same as C<-C 1>.
 
 =item -p,--perlqq
 
-Same as C<-C -1>.
+=item --htmlcref
+
+=item --xmlcref
+
+Applies PERLQQ, HTMLCREF, XMLCREF, respectively.  Try
+
+  piconv -f utf8 -t ascii --perlqq
+
+To see what it does.
 
 =item -h,--help