root/lang/perl/misc/i18n-emoji/EscapeUTF8.pm

# -------------------------------------------------------------------- #
#   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; ����˥��������פ��줿�ʬ��F-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 ��椫��TF8 �Х��ʥ����������ʸ����# -------------------------------------------------------------------- #
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 ) {
        # �ɥ��⳨ʸ��ift_JISɽ�����Υ�������Ѵ����ʤ�
    } elsif ( $code <= 0x07FF ) {
        # 0x0080��x07FF ��Ѵ�����       $str = pack( "C*" => 0xC0|($code>>6),0x80|($code&0x3F));
    } elsif ( $code <= 0xFFFD ) {
        # 0x0800��xFFFD ��Ѵ�����       $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.
# -------------------------------------------------------------------- #