# ----------------------------------------------------------------------------- # Tripletail::CharConv - æ–‡å—コードクラス(内部用) # ----------------------------------------------------------------------------- package Tripletail::CharConv; use strict; use warnings; BEGIN { # Workaround for Encode < 2.26. See t/old-encode-pm.t local $SIG{__DIE__} = 'DEFAULT'; require Encode; } use Encode::Alias; use Unicode::Japanese (); # $TL->charconv('æ–‡å—列', 'utf8', 'sjis'); our $INSTANCE; our %MAP_ENCODE_TO_UNIJP = ( 'UTF-8' => 'utf8', 'ISO-2022-JP' => 'jis', 'Shift_JIS' => 'sjis', 'CP932' => 'sjis', 'EUC-JP' => 'euc', 'UCS-2' => 'ucs2', 'UTF-32' => 'ucs4', 'UTF-16' => 'utf16', 'UTF-32' => 'utf32', 'UTF-16BE' => 'utf16-be', 'UTF-16LE' => 'utf16-le', 'UTF-32BE' => 'utf32-be', 'UTF-32LE' => 'utf32-le', ); our %UNICODE_JAPANESE_CODE; our @UNICODE_JAPANESE_CODE = qw( auto utf8 ucs2 ucs4 utf16-be utf16-le utf16 utf32-be utf32-le utf32 jis euc euc-jp sjis cp932 sjis-imode sjis-imode1 sjis-imode2 sjis-doti sjis-doti1 sjis-jsky sjis-jsky1 sjis-jsky2 jis-jsky jis-jsky1 jis-jsky2 utf8-jsky utf8-jsky1 utf8-jsky2 jis-au jis-au1 jis-au2 sjis-au sjis-au1 sjis-au2 sjis-icon-au sjis-icon-au1 sjis-icon-au2 euc-icon-au euc-icon-au1 euc-icon-au2 jis-icon-au jis-icon-au1 jis-icon-au2 utf8-icon-au utf8-icon-au1 utf8-icon-au2 ascii binary ); 1; sub _getInstance { my $class = shift; if (!$INSTANCE) { $INSTANCE = $class->__new(@_); foreach my $code (@UNICODE_JAPANESE_CODE) { $UNICODE_JAPANESE_CODE{$code} = 1; } } $INSTANCE; } sub _charconv { my $this = shift; my $str = shift; my $from = shift; my $to = shift; if (!defined $str) { die "TL#charconv: arg[1] is not defined. (第1å¼•æ•°ãŒæŒ‡å®šã•れã¦ã„ã¾ã›ã‚“)\n"; } elsif (ref $str) { die "TL#charconv: arg[1] is a reference. [$str] (第1引数ãŒãƒªãƒ•ァレンスã§ã™)\n"; } if (!defined $from) { $from = 'auto'; } elsif (ref $from) { die "TL#charconv: arg[2] is a reference. [$from] (第2引数ãŒãƒªãƒ•ァレンスã§ã™)\n"; } if (!defined $to) { $to = 'UTF-8'; } elsif (ref $to) { die "TL#charconv: arg[3] is a reference. [$to] (第3引数ãŒãƒªãƒ•ァレンスã§ã™)\n"; } my $fromuj = $MAP_ENCODE_TO_UNIJP{$from} ? $MAP_ENCODE_TO_UNIJP{$from} : $from; my $touj = $MAP_ENCODE_TO_UNIJP{$to } ? $MAP_ENCODE_TO_UNIJP{$to } : $to; if ($UNICODE_JAPANESE_CODE{$fromuj} and $UNICODE_JAPANESE_CODE{$touj}) { # 両方ã¨ã‚‚UniJPã®ã‚µãƒãƒ¼ãƒˆå†…ãªã‚‰UniJPã§å¤‰æ› return Unicode::Japanese->new($str, $fromuj)->conv($touj); } elsif ($UNICODE_JAPANESE_CODE{$fromuj}) { # 片方サãƒãƒ¼ãƒˆãªã®ã§utf8経由ã§å¤‰æ› my $utf8 = Unicode::Japanese->new($str, $fromuj)->utf8; return Encode::find_encoding($to)->encode($utf8); } elsif ($UNICODE_JAPANESE_CODE{$touj}) { # 片方サãƒãƒ¼ãƒˆãªã®ã§utf8経由ã§å¤‰æ› my $utf8 = Encode::find_encoding($from)->decode($str); return Unicode::Japanese->new($str, 'utf8')->conv($touj); } else { # 両方ã¨ã‚‚サãƒãƒ¼ãƒˆå¤– my $utf8 = Encode::find_encoding($from)->decode($str); return Encode::find_encoding($to)->encode($utf8); } } sub __new { my $class = shift; my $this = bless {} => $class; return $this; } __END__ =encoding utf-8 =for stopwords YMIRLINK =head1 NAME Tripletail::CharConv - 内部クラス =head1 DESCRIPTION L<Tripletail> ã«ã‚ˆã£ã¦å†…部的ã«ä½¿ç”¨ã•れる。 =head1 SEE ALSO L<Tripletail> =head1 AUTHOR INFORMATION =over 4 Copyright 2006 YMIRLINK Inc. This framework is free software; you can redistribute it and/or modify it under the same terms as Perl itself ã“ã®ãƒ•レームワークã¯ãƒ•リーソフトウェアã§ã™ã€‚ã‚ãªãŸã¯ Perl ã¨åŒã˜ãƒ©ã‚¤ã‚»ãƒ³ã‚¹ã® å…ƒã§å†é…布åŠã³å¤‰æ›´ã‚’行ã†ã“ã¨ãŒå‡ºæ¥ã¾ã™ã€‚ Address bug reports and comments to: tl@tripletail.jp HP : http://tripletail.jp/ =back =cut