package Unicode::Japanese;
# $Id: Japanese_stub.pm,v 1.25 2002/06/30 23:20:17 hio Exp $
use strict;
use vars qw($VERSION $PurePerl $xs_loaderror);
$VERSION = '0.09';
sub import
{
my $pkg = shift;
my @na = grep{ !/^PurePerl$/i }@_;
if( @na != @_ )
{
$PurePerl = 1;
}
if( @na )
{
use Carp;
croak("invalid parameter (".join(',',@na).")");
}
}
sub DESTROY
{
}
sub load_xs
{
#print STDERR "load_xs\n";
if( $PurePerl )
{
#print STDERR "PurePerl mode\n";
$xs_loaderror = 'disabled';
return;
}
#print STDERR "XS mode\n";
my $use_xs;
LoadXS:
{
#print STDERR "* * bootstrap...\n";
eval q
{
use strict;
require DynaLoader;
use vars qw(@ISA);
@ISA = qw(DynaLoader);
local($SIG{__DIE__}) = 'DEFAULT';
Unicode::Japanese->bootstrap($VERSION);
};
#print STDERR "* * try done.\n";
#undef @ISA;
if( $@ )
{
#print STDERR "failed.\n";
#print STDERR "$@\n";
$use_xs = 0;
$xs_loaderror = $@;
undef $@;
last LoadXS;
}
#print STDERR "succeeded.\n";
$use_xs = 1;
eval q
{
#print STDERR "over riding _s2u,_u2s\n";
do_memmap();
#print STDERR "memmap done\n";
END{ do_memunmap(); }
#print STDERR "binding xsubs done.\n";
};
if( $@ )
{
#print STDERR "error on last part of load XS.\n";
$xs_loaderror = $@;
CORE::die($@);
}
#print STDERR "done.\n";
}
if( $@ )
{
$xs_loaderror = $@;
CORE::die("Cannot Load Unicode::Japanese either XS nor PurePerl\n$@");
}
if( !$use_xs )
{
#print STDERR "no xs.\n";
eval q
{
sub do_memmap($){}
sub do_memunmap($){}
};
}
$xs_loaderror = '' if( !defined($xs_loaderror) );
#print STDERR "load_xs done.\n";
}
use vars qw($FH $TABLE $HEADLEN $PROGLEN);
sub gensym {
package Unicode::Japanese::Symbol;
no strict;
$genpkg = "Unicode::Japanese::Symbol::";
$genseq = 0;
my $name = "GEN" . $genseq++;
my $ref = \*{$genpkg . $name};
delete $$genpkg{$name};
$ref;
}
sub _init_table {
if(!defined($HEADLEN))
{
$FH = gensym;
my $file = "Unicode/Japanese.pm";
OPEN:
{
foreach my $path (@INC)
{
my $mypath = $path;
$mypath =~ s#/$##;
if (-f "$mypath/$file")
{
open($FH,"$mypath/$file") || CORE::die;
binmode($FH);
last OPEN;
}
}
CORE::die "Can't find Japanese.pm in \@INC\n";
}
local($/) = "\n";
my $line;
while($line = <$FH>)
{
last if($line =~ m/^__DATA__/);
}
$PROGLEN = tell($FH);
read($FH, $HEADLEN, 4)
or die "Can't read table. [$!]\n";
$HEADLEN = unpack('N', $HEADLEN);
read($FH, $TABLE, $HEADLEN)
or die "Can't seek table. [$!]\n";
$TABLE = eval $TABLE;
if($@)
{
die "Internal Error. [$@]\n";
}
if(!defined($TABLE))
{
die "Internal Error.\n";
}
$HEADLEN += 4;
# load xs.
load_xs();
}
}
sub _getFile {
my $this = shift;
my $file = shift;
# print STDERR "_getFile($file, $TABLE->{$file}{offset}, $TABLE->{$file}{length})\n";
seek($FH, $PROGLEN + $HEADLEN + $TABLE->{$file}{offset}, 0)
or die "Can't seek $file. [$!]\n";
my $data;
read($FH, $data, $TABLE->{$file}{length})
or die "Can't read $file. [$!]\n";
$data;
}
sub new
{
my $pkg = shift;
my $this = {};
if( defined($pkg) )
{
bless $this, $pkg;
$this->_init_table;
}else
{
bless $this;
}
if(defined($_[0]))
{
$this->set(@_);
}
$this;
}
use vars qw(%CHARCODE %ESC %RE);
use vars qw(@J2S @S2J @S2E @E2S @U2T %T2U %S2U %U2S);
%CHARCODE = (
UNDEF_EUC => "\xa2\xae",
UNDEF_SJIS => "\x81\xac",
UNDEF_JIS => "\xa2\xf7",
UNDEF_UNICODE => "\x20\x20",
);
%ESC = (
JIS_0208 => "\e\$B",
JIS_0212 => "\e\$(D",
ASC => "\e\(B",
KANA => "\e\(I",
E_JSKY_START => "\e\$",
E_JSKY_END => "\x0f",
);
%RE =
(
ASCII => '[\x00-\x7f]',
EUC_0212 => '\x8f[\xa1-\xfe][\xa1-\xfe]',
EUC_C => '[\xa1-\xfe][\xa1-\xfe]',
EUC_KANA => '\x8e[\xa1-\xdf]',
JIS_0208 => '\e\$\@|\e\$B|\e&\@\e\$B',
JIS_0212 => "\e" . '\$\(D',
JIS_ASC => "\e" . '\([BJ]',
JIS_KANA => "\e" . '\(I',
SJIS_DBCS => '[\x81-\x9f\xe0-\xef\xfa-\xfc][\x40-\x7e\x80-\xfc]',
SJIS_KANA => '[\xa1-\xdf]',
UTF8 => '[\x00-\x7f]|[\xc0-\xdf][\x80-\xbf]|[\xe0-\xef][\x80-\xbf]{2}|[\xf0-\xf7][\x80-\xbf]{3}|[\xf8-\xfb][\x80-\xbf]{4}|[\xfc-\xfd][\x80-\xbf]{5}',
BOM2_BE => '\xfe\xff',
BOM2_LE => '\xff\xfe',
BOM4_BE => '\x00\x00\xfe\xff',
BOM4_LE => '\xff\xfe\x00\x00',
UTF32_BE => '\x00[\x00-\x10][\x00-\xff]{2}',
UTF32_LE => '[\x00-\xff]{2}[\x00-\x10]\x00',
E_IMODE => '\xf8[\x9f-\xfc]|\xf9[\x40-\x49\x72-\x7e\x80-\xb0]',
E_JSKY1 => '[EFG]',
E_JSKY2 => '[\!-z]',
E_DOTI => '\xf0[\x40-\x7e\x80-\xfc]|\xf1[\x40-\x7e\x80-\xd6]|\xf2[\x40-\x7e\x80-\xab\xb0-\xd5\xdf-\xfc]|\xf3[\x40-\x7e\x80-\xfa]|\xf4[\x40-\x4f\x80\x84-\x8a\x8c-\x8e\x90\x94-\x96\x98-\x9c\xa0-\xa4\xa8-\xaf\xb4\xb5\xbc-\xbe\xc4\xc5\xc8\xcc]',
E_JSKY_START => quotemeta($ESC{E_JSKY_START}),
E_JSKY_END => quotemeta($ESC{E_JSKY_END}),
);
$RE{E_JSKY} = $RE{E_JSKY_START}
. $RE{E_JSKY1} . $RE{E_JSKY2} . '+'
. $RE{E_JSKY_END};
use vars qw($s2u_table $u2s_table);
use vars qw($ei2u $ed2u $ej2u $eu2i $eu2d $eu2j);
# encode/decode
use vars qw(%_h2zNum %_z2hNum %_h2zAlpha %_z2hAlpha %_h2zSym %_z2hSym %_h2zKanaK %_z2hKanaK %_h2zKanaD %_z2hKanaD %_hira2kata %_kata2hira);
AUTOLOAD
{
use strict;
use vars qw($AUTOLOAD);
#print STDERR "AUTOLOAD... $AUTOLOAD\n";
my $save = $@;
my @BAK = @_;
my $subname = $AUTOLOAD;
$subname =~ s/^Unicode\:\:Japanese\:\://;
#print "subs..\n",join("\n",keys %$TABLE,'');
# check
if(!defined($TABLE->{$subname}{offset}))
{
if (substr($AUTOLOAD,-9) eq '::DESTROY')
{
{
no strict;
*$AUTOLOAD = sub {};
}
$@ = $save;
@_ = @BAK;
goto &$AUTOLOAD;
}
CORE::die "Undefined subroutine \&$AUTOLOAD called.\n";
}
if($TABLE->{$subname}{offset} == -1)
{
CORE::die "Double loaded \&$AUTOLOAD. It has some error.\n";
}
seek($FH, $PROGLEN + $HEADLEN + $TABLE->{$subname}{offset}, 0)
or die "Can't seek $subname. [$!]\n";
my $sub;
read($FH, $sub, $TABLE->{$subname}{length})
or die "Can't read $subname. [$!]\n";
CORE::eval($sub);
if ($@)
{
CORE::die $@;
}
$DB::sub = $AUTOLOAD; # Now debugger know where we are.
# evaled
$TABLE->{$subname}{offset} = -1;
$@ = $save;
@_ = @BAK;
goto &$AUTOLOAD;
}
1;
=head1 NAME
Unicode::Japanese - Japanese Character Encoding Handler
=head1 SYNOPSIS
use Unicode::Japanese;
# convert utf8 -> sjis
print Unicode::Japanese->new($str)->sjis;
# convert sjis -> utf8
print Unicode::Japanese->new($str,'sjis')->get;
# convert sjis (imode_EMOJI) -> utf8
print Unicode::Japanese->new($str,'sjis-imode')->get;
# convert ZENKAKU (utf8) -> HANKAKU (utf8)
print Unicode::Japanese->new($str)->z2h->get;
=head1 DESCRIPTION
Module for conversion among Japanese character encodings.
=head2 FEATURES
=over 2
=item *
The instance stores internal strings in UTF-8.
=item *
Supports both XS and Non-XS.
Use XS for high performance,
or No-XS for ease to use (only by copying Japanese.pm).
=item *
Supports conversion between ZENKAKU and HANKAKU.
=item *
Safely handles "EMOJI" of the mobile phones (DoCoMo i-mode, ASTEL dot-i
and J-PHONE J-Sky) by mapping them on Unicode Private Use Area.
=item *
Supports conversion of the same image of EMOJI
between different mobile phone's standard mutually.
=item *
Considers Shift_JIS(SJIS) as MS-CP932.
(Shift_JIS on MS-Windows (MS-SJIS/MS-CP932) differ from
generic Shift_JIS encodings.)
=item *
On converting Unicode to SJIS (and EUC-JP/JIS), those encodings that cannot
be converted to SJIS (except "EMOJI") are escaped in "&#dddd;" format.
"EMOJI" on Unicode Private Use Area is going to be '?'.
When converting strings from Unicode to SJIS of mobile phones,
any characters not up to their standard is going to be '?'
=back
=head1 METHODS
=over 4
=item $s = Unicode::Japanese->new($str [, $icode [, $encode]])
Creates a new instance of Unicode::Japanese.
If arguments are specified, passes through to set method.
=item $s->set($str [, $icode [, $encode]])
=over 2
=item $str: string
=item $icode: character encodings, may be omitted (default = 'utf8')
=item $encode: ASCII encoding, may be omitted.
=back
Set a string in the instance.
If '$icode' is omitted, string is considered as UTF-8.
To specify a encodings, choose from the following;
'jis', 'sjis', 'euc', 'utf8',
'ucs2', 'ucs4', 'utf16', 'utf16-ge', 'utf16-le',
'utf32', 'utf32-ge', 'utf32-le', 'ascii', 'binary',
'sjis-imode', 'sjis-doti', 'sjis-jsky'.
'&#dddd' will be converted to "EMOJI", when specified 'sjis-imode'
or 'sjis-doti'.
For auto encoding detection, you MUST specify 'auto'
so as to call getcode() method automatically.
For ASCII encoding, only 'base64' may be specified.
With it, the string will be decoded before storing.
To decode binary, specify 'binary' as the encoding.
=item $str = $s->get
=over 2
=item $str: string (UTF-8)
=back
Gets a string with UTF-8.
=item $code = $s->getcode($str)
=over 2
=item $str: string
=item $code: character encoding name
=back
Detects the character encodings of I<$str>.
Notice: This method detects B<NOT> encoding of the string in the instance
but I<$str>.
Character encodings are distinguished by the following algorithm:
(In case of PurePerl)
=over 4
=item 1
If BOM of UTF-32 is found, the encoding is utf32.
=item 2
If BOM of UTF-16 is found, the encoding is utf16.
=item 3
If it is in proper UTF-32BE, the encoding is utf32-be.
=item 4
If it is in proper UTF-32LE, the encoding is utf32-le.
=item 5
Without NON-ASCII characters, the encoding is ascii.
(control codes except escape sequences has been included in ASCII)
=item 6
If it includes ISO-2022-JP(JIS) escape sequences, the encoding is jis.
=item 7
If it includes "J-PHONE EMOJI", the encoding is sjis-sky.
=item 8
If it is in proper EUC-JP, the encoding is euc.
=item 9
If it is in proper SJIS, the encoding is sjis.
=item 10
If it is in proper SJIS and "EMOJI" of i-mode, the encoding is sjis-imode.
=item 11
If it is in proper SJIS and "EMOJI" of dot-i,the encoding is sjis-doti.
=item 12
If it is in proper UTF-8, the encoding is utf8.
=item 13
If none above is true, the encoding is unknown.
=back
(In case of XS)
=over 4
=item 1
If BOM of UTF-32 is found, the encoding is utf32.
=item 2
If BOM of UTF-16 is found, the encoding is utf16.
=item 3
String is checked by State Transition if it is applicable
for any listed encodings below.
ascii / euc-jp / sjis / jis / utf8 / utf32-be / utf32-le / sjis-jsky /
sjis-imode / sjis-doti
=item 4
The listed order below is applied for a final determination.
utf32-be / utf32-le / ascii / jis / euc-jp / sjis / sjis-jsky / sjis-imode /
sjis-doti / utf8
=item 5
If none above is true, the encoding is unknown.
=back
Regarding the algorithm, pay attention to the following:
=over 2
=item *
UTF-8 is occasionally detected as SJIS.
=item *
Can NOT detect UCS2 automatically.
=item *
Can detect UTF-16 only when the string has BOM.
=item *
Can detect "EMOJI" when it is stored in binary, not in "&#dddd;"
format. (If only stored in "&#dddd;" format, getcode() will
return incorrect result. In that case, "EMOJI" will be crashed.)
=back
Because each of XS and PurePerl has a different algorithm, A result of
the detection would be possibly different. In case that the string is
SJIS with escape characters, it would be considered as SJIS on
PurePerl. However, it can't be detected as S-JIS on XS. This is
because by using Algorithm, the string can't be distinguished between
SJIS and SJIS-Jsky. This exclusion of escape characters on XS from
the detection is suppose to be the same for EUC-JP.
=item $str = $s->conv($ocode, $encode)
=over 2
=item $ocode: output character encoding (Choose from 'jis', 'sjis', 'euc', 'utf8', 'ucs2', 'ucs4', 'utf16', 'binary')
=item $encode: ASCII encoding, may be omitted.
=item $str: string
=back
Gets a string converted to I<$ocode>.
For ASCII encoding, only 'base64' may be specified. With it, the string
encoded in base64 will be returned.
=item $s->tag2bin
Replaces the substrings "&#dddd;" in the string with the binary entity
they mean.
=item $s->z2h
Converts ZENKAKU to HANKAKU.
=item $s->h2z
Converts HANKAKU to ZENKAKU.
=item $s->hira2kata
Converts HIRAGANA to KATAKANA.
=item $s->kata2hira
Converts KATAKANA to HIRAGANA.
=item $str = $s->jis
$str: string (JIS)
Gets the string converted to ISO-2022-JP(JIS).
=item $str = $s->euc
$str: string (EUC-JP)
Gets the string converted to EUC-JP.
=item $str = $s->utf8
$str: string (UTF-8)
Gets the string converted to UTF-8.
=item $str = $s->ucs2
$str: string (UCS2)
Gets the string converted to UCS2.
=item $str = $s->ucs4
$str: string (UCS4)
Gets the string converted to UCS4.
=item $str = $s->utf16
$str: string (UTF-16)
Gets the string converted to UTF-16(big-endian).
BOM is not added.
=item $str = $s->sjis
$str: string (SJIS)
Gets the string converted to Shift_JIS(MS-SJIS/MS-CP932).
=item $str = $s->sjis_imode
$str: string (SJIS/imode_EMOJI)
Gets the string converted to SJIS for i-mode.
=item $str = $s->sjis_doti
$str: string (SJIS/dot-i_EMOJI)
Gets the string converted to SJIS for dot-i.
=item $str = $s->sjis_sky
$str: string (SJIS/J-SKY_EMOJI)
Gets the string converted to SJIS for j-sky.
=item @str = $s->strcut($len)
=over 2
=item $len: number of characters
=item @str: strings
=back
Splits the string by length(I<$len>).
=item $len = $s->strlen
$len: `visual width' of the string
Gets the length of the string. This method has been offered to
substitute for perl build-in length(). ZENKAKU characters are
assumed to have lengths of 2, regardless of the coding being
SJIS or UTF-8.
=item $s->join_csv(@values);
@values: data array
Converts the array to a string in CSV format, then stores into the instance.
In the meantime, adds a newline("\n") at the end of string.
=item @values = $s->split_csv;
@values: data array
Splits the string, accounting it is in CSV format.
Each newline("\n") is removed before split.
=back
=head1 DESCRIPTION OF UNICODE MAPPING
=over 2
=item SJIS
Mapped as MS-CP932. Mapping table in the following URL is used.
ftp://ftp.unicode.org/Public/MAPPINGS/VENDORS/MICSFT/WINDOWS/CP932.TXT
If a character cannot be mapped to SJIS from Unicode,
it will be converted to &#dddd; format.
Also, any unmapped character will be converted into "?" when converting
to SJIS for mobile phones.
=item EUC-JP/JIS
Converted to SJIS and then mapped to Unicode. Any non-SJIS character
in the string will not be mapped correctly.
=item DoCoMo i-mode
Portion of involving "EMOJI" in F800 - F9FF is maapped
to U+0FF800 - U+0FF9FF.
=item ASTEL dot-i
Portion of involving "EMOJI" in F000 - F4FF is mapped
to U+0FF000 - U+0FF4FF.
=item J-PHONE J-SKY
"J-SKY EMOJI" are mapped down as follows: "\e\$"(\x1b\x24) escape
sequences, the first byte, the second byte and "\x0f".
With sequential "EMOJI"s of identical first bytes,
it may be compressed by arranging only the second bytes.
4500 - 47FF is mapped to U+0FFB00 - U+0FFDFF, accounting the first
and the second bytes make one EMOJI character.
Unicode::Japanese will compress "J-SKY_EMOJI" automatically when
the first bytes of a sequence of "EMOJI" are identical.
=back
=head1 PurePerl mode
use Unicode::Japanese qw(PurePerl);
If module was loaded with 'PurePerl' keyword,
it works on Non-XS mode.
=head1 BUGS
=over 2
=item *
EUC-JP, JIS strings cannot be converted correctly when they include
non-SJIS characters because they are converted to SJIS before
being converted to UTF-8.
=item *
Some characters of CP932 not in standard Shift_JIS
(ex; not in Joyo Kanji) will not be detected and converted.
When string include such non-standard Shift_JIS,
they will not detected as SJIS.
Also, getcode() and all convert method will not work correctly.
=item *
When using XS, character encoding detection of EUC-JP and
SJIS(included all EMOJI) strings when they include "\e" will
fail. Also, getcode() and all convert method will not work.
=item *
The Japanese.pm file will collapse if sent via ASCII mode of FTP,
as it has a trailing binary data.
=back
=head1 AUTHOR INFORMATION
Copyright 2001-2002
SANO Taku (SAWATARI Mikage) and YAMASHINA Hio.
All right reserved.
This library is free software; you can redistribute it
and/or modify it under the same terms as Perl itself.
Bug reports and comments to: mikage@cpan.org.
Thank you.
=head1 CREDITS
Thanks very much to:
NAKAYAMA Nao
SUGIURA Tatsuki & Debian JP Project
=cut
__DATA__