#!/usr/bin/perl -w
my
$PROGNAME
=
"map"
;
my
$VERSION
=
"1.21"
;
my
$DATE
=
"2000-Jun-26"
;
my
%opt
= ();
my
$defaultCsId
=
"ISO-8859-1"
;
main: {
$|=1;
undef
$/;
GetOptions ( \
%opt
,
"from=s"
,
"help"
,
"list"
,
"to=s"
);
usage()
if
$opt
{
"help"
};
my
$error
= 0;
if
(
$opt
{
"list"
} ) {
$error
= list_csids ( );
}
else
{
if
( !
$opt
{
"to"
} && !
$opt
{
"from"
} ) {
usage ( );
}
$opt
{
"from"
} ||=
$defaultCsId
;
$opt
{
"to"
} ||=
$defaultCsId
;
$error
= handle_stream ( );
}
exit
$error
;
}
sub
handle_stream {
undef
$/;
my
$input
= <STDIN>;
my
(
$unicode
,
$output
,
$csid
);
$csid
=
$opt
{
"from"
};
if
(
$csid
=~ /^unicode$/i) {
$unicode
=
$input
;
}
else
{
my
$MapFrom
= new Unicode::Map (
$csid
);
if
( !
$MapFrom
) {
print
"Error! Mapping \"$csid\" not available!\n"
;
return
0;
}
$unicode
=
$MapFrom
-> to_unicode (
$input
);
}
undef
$input
;
$csid
=
$opt
{
"to"
};
if
(
$csid
=~ /^unicode$/i ) {
$output
=
$unicode
;
}
else
{
my
$MapTo
= new Unicode::Map (
$csid
);
if
( !
$MapTo
) {
print
"Error! Mapping \"$csid\" not available!\n"
;
return
0;
}
$output
=
$MapTo
-> from_unicode (
$unicode
);
}
undef
$unicode
;
print
STDOUT
$output
;
1}
sub
list_csids {
return
0
unless
my
$Map
= new Unicode::Map ( );
my
(
@alias
,
$last
,
$s
);
my
$i
=1;
print
"Defined character sets:\n"
;
for
(
$Map
->ids()) {
$s
=
sprintf
"%02d: $_"
,
$i
++;
if
(
@alias
=
sort
{
$a
cmp
$b
}
$Map
->alias(
$_
)) {
$last
=
pop
(
@alias
);
$s
.=
" ("
;
$s
.=
join
(
", "
,
@alias
);
$s
.=
", "
if
$#alias
>=0;
$s
.=
"$last)"
;
}
print
"$s\n"
;
}
print
"Done.\n"
;
1}
sub
usage {
_print_usage (
"$PROGNAME V$VERSION ($DATE) - recode from and to Unicode\n"
.
"usage: $PROGNAME {--option [arg]} [--from cset] || [--to cset] file(s)"
,
[
"from s Encoding of input files (default \"$defaultCsId\")"
,
"list Lists available character sets and their alias names."
,
"to s Encoding of output files (default \"$defaultCsId\")"
,
]
);
exit
0;
}
sub
_print_usage {
my
(
$header
,
$bodylistR
,
$footer
) =
@_
;
print
"$header\n"
if
$header
;
print
map
" --$_\n"
,
sort
{
lc
(
$a
) cmp
lc
(
$b
) }
@$bodylistR
;
print
"$footer\n"
if
$footer
;
}