package kcode;
use strict;
#---------------------------------------------------------------------
# CGI用文字コード判定ライブラリ
#   スクリプトおよびHTML入力フォームの文字コード判定
#   Copyright(C) 2003 MORIYAMA Masayuki (森山 将之)
#
# 再配布について
#   このライブラリを利用したアプリケーションを書かれた場合には、この
#   ライブラリそのものを添付していただいて構いません。
#   改造版の再配布については、ファイル名を変更して配布するようにして
#   ください。
#
# 無保証
#   このプログラムを使用することにより生じた損害については、作者はい
#   かなる理由においても責任を負いません。使用される方の責任において
#   お使いください。 
#---------------------------------------------------------------------
#  2003/04/12 Version 1.0
#---------------------------------------------------------------------

our $version = '1.0';

my %charset = (
		'jis'        =>'ISO-2022-JP',
		'iso-2022-jp'=>'ISO-2022-JP',
		'sjis'       =>'Shift_JIS',
		'shift_jis'  =>'Shift_JIS',
		'shift-jis'  =>'Shift_JIS',
		'shiftjis'   =>'Shift_JIS',
		'euc'        =>'EUC-JP',
		'eucjp'      =>'EUC-JP',
		'ujis'       =>'EUC-JP',
		'utf8'       =>'UTF-8',
		'utf-8'      =>'UTF-8'
	);
my %jcode = (
		'iso-2022-jp'  =>'jis',
		'iso-2022-jp-1'=>'jis',
		'iso-2022-jp-3'=>'jis',
		'shift_jis'    =>'sjis',
		'euc-jp'       =>'euc',
		'utf-8'        =>'utf8'
	);

# POSTされた生データから "kcode" の値取り出し.
#     入力フォームに次の行を追加しておく
#     <input type="hidden" name="kcode" value="あ">

sub value {
	my ($rbuff) = @_;
	my $kcode;
	$$rbuff =~ /(^|^.*&)kcode=([^&]*)/i;
	$kcode = $2;
	$kcode =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/geo;
	$kcode;
}

# 'あ' の値により文字コードを判定する.
#     'jis', 'sjis', 'euc', 'utf8', undef のいずれかを返す
#
#     使い方
#       # スクリプトの文字コードを調べる
#       $pcode = &kcode'getcode('あ');
#
#       # POSTデータの文字コードを調べる (value() 参照)
#       if ($ENV{'REQUEST_METHOD'} eq "POST") {
#           read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
#           $icode = &kcode'getcode(&kcode'value(*buffer));
#       }

sub getcode {
	my ($kcode) = @_;
	my ($code, $charset);

	if    ($kcode =~ /\e\$[\@B]/)     { $code = 'jis';  }
	elsif ($kcode eq "\x82\xA0")      { $code = 'sjis'; }
	elsif ($kcode eq "\xA4\xA2")      { $code = 'euc';  }
	elsif ($kcode eq "\xE3\x81\x82")  { $code = 'utf8'; }
	else {
		if ($] >= 5.008) {
			if ($kcode eq "\x{3042}") { $code = 'utf8'; }
			else                      { $code = undef;  }
		}
		else                          { $code = undef;  }
	}
	wantarray ? (&to_charset($code), $code) : $code;
}

# jcode名 から charset名への変換

sub to_charset {
	my ($code) = @_;
	$code = lc($code);
	$charset{$code};
}

# charset名 から jcode名への変換

sub to_jcode {
	my ($charset) = @_;
	$charset = lc($charset);
	$jcode{$charset};
}
1;