# -------------------------------------------------------------------- #
#   EscapeUTF8.pm - Escape ab-normal charactors in UTF-8
#   Copyright (C) 2000-2004 Kawasaki Yuusuke <u-suke@kawa.net>
# -------------------------------------------------------------------- #
#   2004/10/24  EntityRef.pm に対応
#   2004/11/07  POD を少し整備しました。EntityRef.pm を外した
# -------------------------------------------------------------------- #
    package EscapeUTF8;
    use strict;
    use vars qw( $VERSION );
    $VERSION = "0.01";
# -------------------------------------------------------------------- #
=head1 NAME

EscapeUTF8.pm - Escape IBM extended Kanji and emoji in Shift_JIS

=head1 SYNOPSIS

    use EscapeUTF8;
    my $text = "";
    EscapeUTF8::escape( \$text, $ENV{HTTP_USER_AGENT} );
    EscapeUTF8::unescape( \$text, $ENV{HTTP_USER_AGENT} );

=head1 DESCRIPTION

	escape( UTF8_STRING, USER_AGENT );

何もしません。（未実装）

	unescape( UTF8_STRING, USER_AGENT );

UTF8_STRING（スカラー文字列へのリファレンス、またはスカラー文字列自体）中の
&#xHHHH; 形式にエスケープされた部分を UTF-8 バイナリに変換します。

=head1 COPYRIGHT

    Copyright 2004 Kawasaki Yusuke <u-suke@kawa.net>
    http://www.kawa.net/

=cut
# -------------------------------------------------------------------- #
#	EntityRef.pm をキャッシュする
# -------------------------------------------------------------------- #
#	my $ENTITYREF;
# -------------------------------------------------------------------- #
#   エスケープ（何もしない）
# -------------------------------------------------------------------- #
sub escape {
    my $src = \$_[0];
    my $ref = ref $$src ? $$src : $src;     # 必ず１レベルのリファレンス

	# nothing to do.

	undef;
}
# -------------------------------------------------------------------- #
#   UTF-8 中の &#ddddd; &#xHHHH; 表記の文字をバイナリ展開する
# -------------------------------------------------------------------- #
sub unescape {
    my $src = \$_[0];
    my $ref = ref $$src ? $$src : $src;     # 必ず１レベルのリファレンス

#   # &euro; 実体参照を &#xHHHH; 形式に変換する
#   if ( defined $EntityRef::VERSION ) {
#       $ENTITYREF ||= new EntityRef();
#       if ( $ENTITYREF ) {
#           $ENTITYREF->entity2hex( $ref );
#       }
#   }

    # &#ddddd; や &#xHHHH; をバイナリに変換する
    $$ref =~ s{
        (\&\#(?:([0-9]{3,5})|x([0-9A-Fa-f]{4}));)
    }{
        my $str = $1;
        my $conv = &one_unescape_utf8( $2||hex($3) );
        $str = $conv if defined $conv;
        $str;
    }gex;
}
# -------------------------------------------------------------------- #
#   Unicode 番号から UTF8 バイナリに変換する（１文字だけ）
# -------------------------------------------------------------------- #
sub one_unescape_utf8 {
    my $code = shift;       # Unicode コード番号
    my $str = undef;
    if ( $code < 0x0080 || $code >= 0xFFFE ) {
        # ASCII 部分・ＢＯＭ・非ＢＭＰは変換しない
    } elsif ( $code >= 0xE000 && $code <= 0xF8FF ) {
        # Unicode 私用領域は変換しない
    } elsif ( $code >= 63647 && $code <= 63996 ) {
        # ドコモ絵文字（Shift_JIS表記時のコード部）は変換しない
    } elsif ( $code <= 0x07FF ) {
        # 0x0080〜0x07FF は変換する
        $str = pack( "C*" => 0xC0|($code>>6),0x80|($code&0x3F));
    } elsif ( $code <= 0xFFFD ) {
        # 0x0800〜0xFFFD は変換する
        $str = pack( "C*" => 0xE0|($code>>12),
                             0x80|(($code>>6)&0x3F),
                             0x80|($code&0x3F));
    }
    $str;
}
# -------------------------------------------------------------------- #
#   メールの MIME ヘッダデコード
# -------------------------------------------------------------------- #
sub mime_decode {
    my $src = \$_[0];
    my $ref = ref $$src ? $$src : $src;     # 必ず１レベルのリファレンス
    &require_mime_base64();                 # MIME::Base64 を読み込む
    $$ref =~ s{
        \=\?UTF-8\?B\?([^\s\?]+)\?\=
    }{
        MIME::Base64::decode_base64($1);
    }iegx;
}
# -------------------------------------------------------------------- #
#   メールの MIME ヘッダエンコード
# -------------------------------------------------------------------- #
sub mime_encode {
    my $src = \$_[0];
    my $ref = ref $$src ? $$src : $src;     # 必ず１レベルのリファレンス
    &require_mime_base64();                 # MIME::Base64 を読み込む
    $$ref =~ s{
        ( \e\$B ((?:[\x21-\x7E][\x21-\x7E])+) \e\(B )
    }{
        "=?UTF-8?B?".MIME::Base64::encode_base64($1, "")."?=";
    }egx;
}
# -------------------------------------------------------------------- #
sub require_mime_base64 {
    if ( ! defined $MIME::Base64::VERSION ) {
        eval 'require "MIME/Base64.pm";';
    }
    if ( ! defined $MIME::Base64::VERSION ) {
        die "MIME::Base64 is required for EscapeUTF8::mime_encode()\n";
    }
}
# -------------------------------------------------------------------- #
;1; # End of the script.
# -------------------------------------------------------------------- #