ext/Encode/bin/piconv

   1 #!./perl
   2 # $Id: piconv,v 2.2 2006/05/03 18:24:10 dankogai Exp $
   3 #
   4 use 5.8.0;
   5 use strict;
   6 use Encode ;
   7 use Encode::Alias;
   8 my %Scheme =  map {$_ => 1} qw(from_to decode_encode perlio);
   9
  10 use File::Basename;
  11 my $name = basename($0);
  12
  13 use Getopt::Long qw(:config no_ignore_case);
  14
  15 my %Opt;
  16
  17 help()
  18     unless
  19       GetOptions(\%Opt,
  20          'from|f=s',
  21          'to|t=s',
  22          'list|l',
  23          'string|s=s',
  24          'check|C=i',
  25          'c',
  26          'perlqq|p',
  27          'htmlcref',
  28          'xmlcref',
  29          'debug|D',
  30          'scheme|S=s',
  31          'resolve|r=s',
  32          'help',
  33          );
  34
  35 $Opt{help} and help();
  36 $Opt{list} and list_encodings();
  37 my $locale = $ENV{LC_CTYPE} || $ENV{LC_ALL} || $ENV{LANG};
  38 defined $Opt{resolve} and resolve_encoding($Opt{resolve});
  39 $Opt{from} || $Opt{to} || help();
  40 my $from = $Opt{from} || $locale or help("from_encoding unspecified");
  41 my $to   = $Opt{to}   || $locale or help("to_encoding unspecified");
  42 $Opt{string} and Encode::from_to($Opt{string}, $from, $to) and print $Opt{string} and exit;
  43 my $scheme = exists $Scheme{$Opt{Scheme}} ? $Opt{Scheme} :  'from_to';
  44 $Opt{check} ||= $Opt{c};
  45 $Opt{perlqq}   and $Opt{check} = Encode::PERLQQ;
  46 $Opt{htmlcref} and $Opt{check} = Encode::HTMLCREF;
  47 $Opt{xmlcref}  and $Opt{check} = Encode::XMLCREF;
  48
  49 if ($Opt{debug}){
  50     my $cfrom = Encode->getEncoding($from)->name;
  51     my $cto   = Encode->getEncoding($to)->name;
  52     print <<"EOT";
  53 Scheme: $scheme
  54 From:   $from => $cfrom
  55 To:     $to => $cto
  56 EOT
  57 }
  58
  59 # we do not use <> (or ARGV) for the sake of binmode()
  60 @ARGV or push @ARGV, \*STDIN;
  61
  62 unless ( $scheme eq 'perlio' ) {
  63     binmode STDOUT;
  64     for my $argv (@ARGV) {
  65         my $ifh = ref $argv ? $argv : undef;
  66         $ifh or open $ifh, "<", $argv or next;
  67         binmode $ifh;
  68         if ( $scheme eq 'from_to' ) {    # default
  69             while (<$ifh>) {
  70                 Encode::from_to( $_, $from, $to, $Opt{check} );
  71                 print;
  72             }
  73         }
  74         elsif ( $scheme eq 'decode_encode' ) {    # step-by-step
  75             while (<$ifh>) {
  76                 my $decoded = decode( $from, $_, $Opt{check} );
  77                 my $encoded = encode( $to, $decoded );
  78                 print $encoded;
  79             }
  80         }
  81         else {                                    # won't reach
  82             die "$name: unknown scheme: $scheme";
  83         }
  84     }
  85 }
  86 else {
  87
  88     # NI-S favorite
  89     binmode STDOUT => "raw:encoding($to)";
  90     for my $argv (@ARGV) {
  91         my $ifh = ref $argv ? $argv : undef;
  92         $ifh or open $ifh, "<", $argv or next;
  93         binmode $ifh => "raw:encoding($from)";
  94         print while (<$ifh>);
  95     }
  96 }
  97
  98 sub list_encodings {
  99     print join( "\n", Encode->encodings(":all") ), "\n";
 100     exit 0;
 101 }
 102
 103 sub resolve_encoding {
 104     if ( my $alias = Encode::resolve_alias( $_[0] ) ) {
 105         print $alias, "\n";
 106         exit 0;
 107     }
 108     else {
 109         warn "$name: $_[0] is not known to Encode\n";
 110         exit 1;
 111     }
 112 }
 113
 114 sub help {
 115     my $message = shift;
 116     $message and print STDERR "$name error: $message\n";
 117     print STDERR <<"EOT";
 118 $name [-f from_encoding] [-t to_encoding] [-s string] [files...]
 119 $name -l
 120 $name -r encoding_alias
 121   -l,--list
 122      lists all available encodings
 123   -r,--resolve encoding_alias
 124     resolve encoding to its (Encode) canonical name
 125   -f,--from from_encoding
 126      when omitted, the current locale will be used
 127   -t,--to to_encoding
 128      when omitted, the current locale will be used
 129   -s,--string string
 130      "string" will be the input instead of STDIN or files
 131 The following are mainly of interest to Encode hackers:
 132   -D,--debug          show debug information
 133   -C N | -c           check the validity of the input
 134   -S,--scheme scheme  use the scheme for conversion
 135 Those are handy when you can only see ascii characters:
 136   -p,--perlqq
 137   --htmlcref
 138   --xmlcref
 139 EOT
 140     exit;
 141 }
 142
 143 __END__
 144
 145 =head1 NAME
 146
 147 piconv -- iconv(1), reinvented in perl
 148
 149 =head1 SYNOPSIS
 150
 151   piconv [-f from_encoding] [-t to_encoding] [-s string] [files...]
 152   piconv -l
 153   piconv [-C N|-c|-p]
 154   piconv -S scheme ...
 155   piconv -r encoding
 156   piconv -D ...
 157   piconv -h
 158
 159 =head1 DESCRIPTION
 160
 161 B<piconv> is perl version of B<iconv>, a character encoding converter
 162 widely available for various Unixen today.  This script was primarily
 163 a technology demonstrator for Perl 5.8.0, but you can use piconv in the
 164 place of iconv for virtually any case.
 165
 166 piconv converts the character encoding of either STDIN or files
 167 specified in the argument and prints out to STDOUT.
 168
 169 Here is the list of options.  Each option can be in short format (-f)
 170 or long (--from).
 171
 172 =over 4
 173
 174 =item -f,--from from_encoding
 175
 176 Specifies the encoding you are converting from.  Unlike B<iconv>,
 177 this option can be omitted.  In such cases, the current locale is used.
 178
 179 =item -t,--to to_encoding
 180
 181 Specifies the encoding you are converting to.  Unlike B<iconv>,
 182 this option can be omitted.  In such cases, the current locale is used.
 183
 184 Therefore, when both -f and -t are omitted, B<piconv> just acts
 185 like B<cat>.
 186
 187 =item -s,--string I<string>
 188
 189 uses I<string> instead of file for the source of text.
 190
 191 =item -l,--list
 192
 193 Lists all available encodings, one per line, in case-insensitive
 194 order.  Note that only the canonical names are listed; many aliases
 195 exist.  For example, the names are case-insensitive, and many standard
 196 and common aliases work, such as "latin1" for "ISO-8859-1", or "ibm850"
 197 instead of "cp850", or "winlatin1" for "cp1252".  See L<Encode::Supported>
 198 for a full discussion.
 199
 200 =item -C,--check I<N>
 201
 202 Check the validity of the stream if I<N> = 1.  When I<N> = -1, something
 203 interesting happens when it encounters an invalid character.
 204
 205 =item -c
 206
 207 Same as C<-C 1>.
 208
 209 =item -p,--perlqq
 210
 211 =item --htmlcref
 212
 213 =item --xmlcref
 214
 215 Applies PERLQQ, HTMLCREF, XMLCREF, respectively.  Try
 216
 217   piconv -f utf8 -t ascii --perlqq
 218
 219 To see what it does.
 220
 221 =item -h,--help
 222
 223 Show usage.
 224
 225 =item -D,--debug
 226
 227 Invokes debugging mode.  Primarily for Encode hackers.
 228
 229 =item -S,--scheme scheme
 230
 231 Selects which scheme is to be used for conversion.  Available schemes
 232 are as follows:
 233
 234 =over 4
 235
 236 =item from_to
 237
 238 Uses Encode::from_to for conversion.  This is the default.
 239
 240 =item decode_encode
 241
 242 Input strings are decode()d then encode()d.  A straight two-step
 243 implementation.
 244
 245 =item perlio
 246
 247 The new perlIO layer is used.  NI-S' favorite.
 248
 249 =back
 250
 251 Like the I<-D> option, this is also for Encode hackers.
 252
 253 =back
 254
 255 =head1 SEE ALSO
 256
 257 L<iconv/1>
 258 L<locale/3>
 259 L<Encode>
 260 L<Encode::Supported>
 261 L<Encode::Alias>
 262 L<PerlIO>
 263
 264 =cut