#!./perl
-# $Id: piconv,v 2.0 2004/05/16 20:55:16 dankogai Exp $
+# $Id: piconv,v 2.2 2006/05/03 18:24:10 dankogai Exp $
#
use 5.8.0;
use strict;
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();
$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;
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";
"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__
=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