# -------------------------------------------------------------------- #
#   EntityRef.pm - Dereference Entity
#   Copyright (C) 2000-2004 Kawasaki Yuusuke <u-suke@kawa.net>
# -------------------------------------------------------------------- #
#   2004/10/22  さいしょ
#   2004/11/07  POD を少し整備しました
# -------------------------------------------------------------------- #
    package EntityRef;
    use strict;
    use vars qw( $VERSION $DEBUG );
    $VERSION = "0.01";
# -------------------------------------------------------------------- #
=head1 NAME

EntityRef.pm - Dereference Entity

=head1 SYNOPSIS

    use EntityRef;
    my $text = "EURO &euro; ALPHA &Alpha; COPY &copy;\n";
    my $er = new EntityRef();
    $er->entity2hex( \$text );
    print $text, "\n";

=head1 DESCRIPTION

=head2 new()

    HTML/XML 用の実体参照の定義マップファイルを読み込みます。
    デフォルトでは HTMLlat1.ent、HTMLspecial.ent、HTMLsymbol.ent の
    ３つの標準定義マップファイルを読み込みます。
    これらのファイルは EntityRef.pm と同じディレクトリに設置してください。
    new() の第１引数で定義マップファイルを指定することも可能です。

        my $er = new EntityRef( "EmojiDoCoMo.ent" );

    ドコモ絵文字用の実体参照の定義マップファイルのみを読み込みます。

=head2 entity2hex()

    実体参照表記を、Unicodeコード番号表記(16進数)に変換します。

    HTMLspecial &euro;  ->  &#x20AC;    -- euro sign, U+20AC NEW
    HTMLsymbol  &Alpha; ->  &#x0391;    -- greek capital letter alpha, U+0391
    HTMLlat1    &copy;  ->  &#x00A9;    -- copyright sign, U+00A9 ISOnum

=head2 .ent

    実体参照の定義マップファイルは、下記の形式となります。

    <!ENTITY 参照名 CDATA "&#コード;" -- コメント -->

    コメントが複数行に渡っても構いません。
    参照名は大文字・小文字を区別しています。
    文字コードは10進数または16進数の Unicode で指定してください。
    複数文字に渡る実体参照は展開できません。（1文字のみ展開します）
    また、文字コード番号が 128以下の文字は展開しません。

=head1 SEE ALSO

Extensible Markup Language (XML) 1.0
http://www.w3.org/TR/REC-xml

    4.1 Character and Entity References

    [66]  CharRef  ::=  '&#' [0-9]+ ';'  
                        | '&#x' [0-9a-fA-F]+ ';'
    [67]  Reference  ::=  EntityRef | CharRef 
    [68]  EntityRef  ::=  '&' Name ';'

    If the character reference begins with "&#x", the digits and letters 
    up to the terminating ; provide a hexadecimal representation of the 
    character's code point in ISO/IEC 10646. If it begins just with "&#", 
    the digits up to the terminating ; provide a decimal representation 
    of the character's code point.

http://www.w3.org/TR/html401/HTMLlat1.ent       -- Latin-1 entities 
http://www.w3.org/TR/html401/HTMLsymbol.ent     -- Symbol entities 
http://www.w3.org/TR/html401/HTMLspecial.ent    -- Special entities 

=head1 COPYRIGHT

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

=cut
# -------------------------------------------------------------------- #
#   デフォルトで読み出す .ent
# -------------------------------------------------------------------- #
    my $DEFAULT_ENTITIES = [qw(
        HTMLlat1.ent
        HTMLspecial.ent
        HTMLsymbol.ent
    )];
# -------------------------------------------------------------------- #
#   コンストラクタ
# -------------------------------------------------------------------- #
sub new {
    my $package = shift or return;
    my $names = [ @_ ];

    my $obj = {};
    bless $obj, $package;

    my $pwd = &where_you_are();                 # ディレクトリ
    unless ( scalar @$names ) {
        # $names = &entity_list( $pwd );        # 全てを取り出す
        $names = $DEFAULT_ENTITIES;
        unless ( ref $names && scalar @$names ) {
            die "no .ent files found at '$pwd'\n";
        }
    }

    foreach my $name1 ( @$names ) {
        my $ent;
        if ( $name1 =~ m#^/# ) {
            $obj->read_entity( $name1 );    # 絶対パス指定
        } else {
            my $file = $pwd ."/". $name1;
            $obj->read_entity( $file ); # 相対パス指定
        }
    }

    $obj;                                   # オブジェクトを返す
}
# -------------------------------------------------------------------- #
#   &#xHHHH; 形式の値を持つハッシュを返すメソッド
# -------------------------------------------------------------------- #
sub get_hex_hash {
    my $obj = shift;
    my $hash1 = $obj->{entity};
    my $hash2 = { map {$_=>sprintf("&#x%04X;",$hash1->{$_})} keys %$hash1 };
    $hash2;
}
# -------------------------------------------------------------------- #
#   ディレクトリ内の全ての .ent ファイル名を取り出す（現在は不使用）
# -------------------------------------------------------------------- #
sub entity_list {
    my $path = shift;

    opendir( DIR, $path ) or die "$! '$path'\n";
    my $files = [];
    while( 1 ) {
        my $file = readdir( DIR );
        last unless defined $file;
        next unless ( $file =~ m#[^\/]\.ent$#i );
        push( @$files, $file );
    }
    closedir( DIR );
    $files;
}
# -------------------------------------------------------------------- #
#   .ent ファイルを読み込む（0x0080〜0xFFFDまで）
# -------------------------------------------------------------------- #
sub read_entity {
    my $obj = shift;
    my $file = shift;
    my $hash = $obj->{entity} || {};
#   $DEBUG and print "[read_entity] $file\n";
    open( ENT, $file ) or die "$! '$file'\n";
    local $/ = undef;
    my $body = join( "", <ENT> );
    while( $body =~ m/<!ENTITY\s+(\w+)\s+CDATA\s+
                                 (?:([^\s"]+)|"([^"]+)")[^>]+>/xg ) {
        my( $ref, $entity ) = ( $1, $2||$3 );
        my( $code, $hex ) = ( $entity =~ m/^\&\#(?:(\d+)|x([0-9A-Fa-f]+));$/s );
        $code = hex($hex) if ( $hex ne "" );
        next if ( $code < 0x0080 );
        next if ( $code >= 0xFFFE );
        # $DEBUG and print "[read_entity] $file &$ref; $code\n";
        $hash->{$ref} = $code;
    }
    close( ENT );
    $obj->{entity} = $hash;
}
# -------------------------------------------------------------------- #
#   実体参照表記をコード参照表記に変換する
# -------------------------------------------------------------------- #
sub entity2hex {
    my $obj = shift;
    my $src = \$_[0];
    $src = $$src if ref $$src;              # 必ず１レベルのリファレンス
    my $ent = $obj->{entity} or return;
    $$src =~ s{ (\&([A-Za-z][\w\-]*);) }
              { defined $ent->{$2} ? sprintf("&#x%04X;",$ent->{$2}) : $1 }gex;
}
# -------------------------------------------------------------------- #
#   実行中のファイル名を取り出す
# -------------------------------------------------------------------- #
sub where_you_are {
    my $path = (caller(0))[1];      # 呼び出し元が実行中のファイル名
    $path =~ s#[^/]+$##s;           # ディレクトリ名に変換
    $path = "." if ( $path eq "" );
    $path;                          # ディレクトリ名を返す
}
# -------------------------------------------------------------------- #
;1; # End of the script.
# -------------------------------------------------------------------- #