Tripletail::CharConv - Tripletail::CharConv documentation

Tripletail documentation Contained in the Tripletail distribution.

Index

Code Index:

NAME

Top

Tripletail::CharConv - 内部クラス

DESCRIPTION

Top

Tripletail によって内部的に使用される。

SEE ALSO

Top

Tripletail

AUTHOR INFORMATION

Top

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/

Tripletail documentation Contained in the Tripletail distribution. 
# -----------------------------------------------------------------------------
# Tripletail::CharConv - 文字コードクラス（内部用）
# -----------------------------------------------------------------------------
package Tripletail::CharConv;
use strict;
use warnings;

# $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;

	local($_);

	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で変換
		Unicode::Japanese->new($str, $fromuj)->conv($touj);
	} elsif($UNICODE_JAPANESE_CODE{$fromuj}) {
		# 片方サポートなのでutf8経由で変換
		$this->_encodeAvailable or die "TL#charconv: the Encode module is unavailable. (Encodeモジュールが使用できません)\n";
		my $utf8 = Unicode::Japanese->new($str, $fromuj)->utf8;
		Encode::find_encoding($to)->encode($utf8);
	} elsif($UNICODE_JAPANESE_CODE{$touj}) {
		# 片方サポートなのでutf8経由で変換
		$this->_encodeAvailable or die "TL#charconv: the Encode module is unavailable. (Encodeモジュールが使用できません)\n";
		my $utf8 = Encode::find_encoding($from)->decode($str);
		Unicode::Japanese->new($str, 'utf8')->conv($touj);
	} else {
		# 両方ともサポート外
		$this->_encodeAvailable or die "TL#charconv: the Encode module is unavailable. (Encodeモジュールが使用できません)\n";
		my $utf8 = Encode::find_encoding($from)->decode($str);
		Encode::find_encoding($to)->encode($utf8);
	}
}

sub _encodeAvailable {
	my $this = shift;

	local($_);

	if(defined($_ = $this->{encode_is_available})) {
		$_;
	} else {
		eval {
			require Encode;
			require Encode::Alias;
			require Encode::Guess;
		};
		$this->{encode_is_available} = $@ ? 0 : 1;
	}
}

sub __new {
	my $class = shift;

	my $this = bless {} => $class;
	$this->{encode_is_available} = undef;

	$this;
}


__END__