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