view release on metacpan or  search on metacpan

bin/piconv  view on Meta::CPAN

	    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;
$Opt{htmlcref} and $Opt{check} = Encode::HTMLCREF;
$Opt{xmlcref}  and $Opt{check} = Encode::XMLCREF;

my $efrom = Encode->getEncoding($from) || die "Unknown encoding '$from'";
my $eto   = Encode->getEncoding($to)   || die "Unknown encoding '$to'";

my $cfrom = $efrom->name;
my $cto   = $eto->name;

if ($Opt{debug}){
    print <<"EOT";
Scheme: $scheme
From:   $from => $cfrom
To:     $to => $cto
EOT
}

my %use_bom =
  map { $_ => 1 } qw/UTF-16 UTF-16BE UTF-16LE UTF-32 UTF-32BE UTF-32LE/;

# we do not use <> (or ARGV) for the sake of binmode()
@ARGV or push @ARGV, \*STDIN;

unless ( $scheme eq 'perlio' ) {
    binmode STDOUT;
    my $need2slurp = $use_bom{ $eto } || $use_bom{ $efrom };
    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
	    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
	    if ($need2slurp){
		local $/;
		$_ = <$ifh>;
                my $decoded = decode( $from, $_, $Opt{check} );
                my $encoded = encode( $to, $decoded );
                print $encoded;
	    }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";
        }
    }
}
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 warn "Can't open $argv: $!" and next;
        $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";
    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;
    }
}

sub help {
    my $message = shift;
    $message and print STDERR "$name error: $message\n";
    print STDERR <<"EOT";
$name [-f from_encoding] [-t to_encoding]
      [-p|--perlqq|--htmlcref|--xmlcref] [-C N|-c] [-D] [-S scheme]
      [-s string|file...]
$name -l
$name -r encoding_alias
$name -h
Common options:
  -l,--list
     lists all available encodings
  -r,--resolve encoding_alias
    resolve encoding to its (Encode) canonical name
  -f,--from from_encoding  
     when omitted, the current locale will be used
  -t,--to to_encoding    
     when omitted, the current locale will be used
  -s,--string string         
     "string" will be the input instead of STDIN or files
The following are mainly of interest to Encode hackers: