# mdevSGML_s2h ( ver 0.1 ) :
# This program converts Medical Device SGML into the HTML form.
#   Written by prepress-tips 2008.12.15
#   Contact: prepress-tips@users.sourceforge.jp
# This program is under the same licensing terms as Perl
# ( the Artistic License 1.0 or the GNU GPL ).
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

# - 処理の概要は ‥

    # 開始メッセージを表示する。
        msg( 'mdevSGML_s2h ( ver 0.1 )');
    $in;  { # 入力sgmlを読む。
        # 入力sgmlを読む。
            @ARGV > 0 || err( 'ファイル名を指定してください。' );
            my $fn = $ARGV[0];
            -f $fn || err( 'ファイルがありません。' );
            $fn =~ /^(?:\\|[\00-\x7f\xa0-\xdf]|..)*\\([^\\]+\.sgml?)$/i ||
                err( 'sgmlファイルを指定してください。' );
            msg( "  $1" );
            $in = join '', getF( $fn );
    }
    @atr_tag;  { # 属性タグのリスト
        # 属性タグのリスト
            @atr_tag = (
                'graphic', 'br',
                'chr', 'bold', 'italic', 'under', 'sup', 'sub',
                'chem', 'div', 'nom', 'den', 'han', 'gaiji',
            );
    }
    { # 入力sgmlを タグ＋テキスト の形に分ける。
        # タブと改行を \\tと\\nに置換する。
            $in =~ s/\t/\\t/g;
            $in =~ s/\x0d?\x0a/\\n/g;
        # 半角＆をエスケープする。
            $in =~ s/\&/&/g;
        # 属性タグをエスケープする。
            for( @atr_tag ) {
                $in =~ s/<($_(\s[^>]*)?)>/&lt;$1&gt;/gi;
                $in =~ s/<(\/$_)>/&lt;$1&gt;/gi;
            }
        # DOCTYPE宣言をエスケープする。
            while( $in =~ s/(<!DOCTYPE [^<]*)<(![^>]*)>/$1&lt;$2&gt;/i ) {};
        # タグ＋テキストの形に分ける。
            while( $in =~ s/([^\x0a])(<[^<>]*>)/$1\x0a$2/ ) {}
    }
    { # 入力sgmlの書式を揃える。
        # 属性の記述を統一する。
            $in =~ s,(<[\w-]+)\s+,$1 ,g;
            while( $in =~ s,(<[\w-]+[^>]*)\s+=,$1=,i ) {};
            while( $in =~ s,(<[\w-]+[^>]*)=\s+,$1=,i ) {};
        # 定型の属性を削除する。
            $in =~ s,<Warning boxline="yes" boxcolor="rd" color="red">,<Warning>,gi;
            my @tag =(
                'Contraindication-and-Prohibitions',
            );
            for ( @tag ) { $in =~ s,<$_ boxline="yes" boxcolor="rd" color="black">,<$_>,gi; }
        # 不要な属性を削除する。
            $in =~ s,<variablelabel onswitch="off">,<variablelabel>,gi;
            $in =~ s,<serialno onoff="on">,<serialno>,gi;
        # 不要な\\nを削除する。
            $in =~ s,>(\\n)+,>\\n,g;
            $in =~ s,(\\n)+\x0a,\x0a,g;
        # variablelabelタグの属性を追加する。
            my @a = (
                'Company-identifier',
                'Download',
                'The-permission-number-of-business-condition',
                'Name-of-manufacturer',
                'Address-of-manufacturer',
                'The-recognition-number-of-business-condition',
                'Phonenumber-of-manufacturer',
                'Name-of-oversea-manufacturer',
                'Address-of-oversea-manufacturer',
                'The-authorization-number-of-business-condition',
                'Phonenumber-of-oversea-manufacturer',
                'The-company-name-of-specification-into-English',
                'Address-of-specification-into-English',
                'The-country-code',
                'Name-of-a-country',
            );
            my $a = "(?:".( join "|", @a ).")";
            $in =~ s/(<$a>\s*<variablelabel)(>)/$1 onswitch="on"$2/gi;
        # variablelabelタグを属性に変える。
            $in =~ s/(>)\s*(<variablelabel[\s>])/$1$2/gi;
            $in =~ s/(<\/variablelabel>)\s*(?!<)/$1/gi;
            $in =~ s/<variablelabel>[^<]*<\/variablelabel>//gi;
            $in =~ s/<variablelabel\s[^>]*>\s*<\/variablelabel>//gi;
            $in =~ s/<([^>]*)>\s*<(variablelabel)\s[^>]*>([^<]*\S)\s*<\/\2>/<$1 $2="$3">/gi;
        # serialnoタグの onoff属性を タグに変える。
            $in =~ s/<(serialno)\sonoff="off">([^<]*)<\/\1>/<$1-off>$2<\/$1-off>/gi;
    }

    @s2h;  { # 変換規則を読む。
        # 変換規則を読む。
            my $fn = 'mdevSGML_s2h.txt';
            -f $fn || err( '変換規則のファイルがありません： '.$fn );
            @s2h = getF( $fn );
        # 行末の改行・コメント・空行を削除する。
            @s2h = map do {
                s/[\x0d\x0a]*$//; # 行末の改行
                /^\t/ || s/\t*#.*$//; # 行頭がタブのとき 行末のコメント
                /^\s*$/ ? () : $_ ; # 空行
            }, @s2h;
    }
    @tag;  { # 変換規則から タグのリストを作る。
        # 変換規則から タグのリストを作る。
            my @t = map do { ! /^\t/ && /\s\/\s+(.*\S)/ ? $1 : () }, @s2h;
            my %t = map do { ( lc( "<$_>" ) => 1 ); }, @t;
            @tag = sort keys %t;
    }
    %tag2num;  { # タグのリストから タグをタグ番号に置換するテーブルを作る。
        # タグのリストから タグをタグ番号に置換するテーブルを作る。
            my $n = 0; %tag2num = map do { $_ => sprintf "%03d", $n++; }, @tag;
        #  タグをタグ番号に置換するテーブルを出力する（ デバグ用 ）。
    }

    %path2htm;  { # sgmlのタグ列を HTMLのタグに置換するテーブル 
        # 変換規則内のタグを タグ番号に変える。
            for ( @s2h ) {
                /^(?!\t)((?:　)*).*\/\s*(.*\S)\s*$/ || next;
                my ( $s, $t ) = ( $1, $2 );
                $_ = $s.'<'.$tag2num{ lc( "<$t>" ) }.'>';
           }
        # 変換規則内の全角空白によるインデントを タグ列に変える。
            my @t = ();
            for( @s2h ) {
                /^\t/ && next;
                my @s = /　/g; my @n = /<[^>]+>/g;
                splice( @t, scalar @s, @t - @s, @n );
                $_ = join "", @t;
            }
        # 変換規則内の 行頭がタブで始まる行を 前の行に連結する。
            @s2h = map do { /^\t/ ? $_ : $_."\t" ; }, @s2h;
            my $s2h = join "\x0a", @s2h;
            $s2h =~ s/\x0a\t\t//g;
            @s2h = split "\x0a", $s2h;
        # sgmlのタグ列を HTMLのタグに置換するテーブル を作る。
            %path2htm = map do { /\t+/ ? ( $` => [ $' ] ) : () ; }, @s2h;
        # 開始タグ・中区切・終了タグ・属性の それぞれに対応する部分に分ける。
            for( keys %path2htm ) {
                my $s  = @{$path2htm{ $_ }}[0];
                my ( $st, $sp, $et ) = ( "", "", "" ); my @p = ();
                while( $s =~ /〓.*?(〓|：|$)/ ) {
                    $st .= $`; my $p = $&; $s = $';
                    $1 eq '〓' && ( $st .= $p, next );
                    $s =~ /(〓|$)/; push @p, $p.$`; $s = $&.$';
                }
                $st .= $s;
                $st =~ /(\.\.\.)(.*?)\.\.\./ && ( $st = $`.$1.$', $sp = $2 );
                $st =~ /\.\.\./ && ( $st = $`, $et = $' );
                $path2htm{ $_ } = [ $st, $sp, $et, @p ];
            }
        # 属性の置換テーブルを作る。
            for( keys %path2htm ) {
                my @p = splice( @{$path2htm{ $_ }}, 3 );
                my $p = { 'variablelabel' => [ '.*=>$&' ] };
                for( @p ) {
                    /^〓[@]?([@]?.*?)：/ || next;
                    my ( $k, $v ) = ( $1, $' );
                    @v = ( $v =~ /\t.*?=>\t*[^\t]*/g );
                    @v = map do { s/^\t//; s/\$nul\s*$//; /\t*=>\t*/; "$`=>$'"; }, @v;
                    $p->{ $k } = [ @v ];
                }
                push @{$path2htm{ $_ }}, $p;
            }
        #  変換規則を 'chk0.txt' に出力する（ デバグ用 ）。
        #  HTMLのタグに置換するテーブル を出力する（ デバグ用 ）。
    }

    @in;  { # 入力sgmlの配列 
        # 入力sgmlを配列に変える。
            @in = split "\x0a", $in;
    }
    { # 入力sgmlを タグ列＋テキスト の形に変える。
        # 入力sgmlを全角空白でインデントする。
            my $lv = 0;
            for( @in ) {
                /^<\// && $lv--; my $s = '　' x $lv; /^<\w/ && $lv++;
                $_ = $s.$_;
            }
        # 未知のタグを確認する。
            my @u = map do { /<\w[^>]*>/g; }, @in;
            @u = map do { /^<[^\s>]*/; defined( $tag2num{ lc( "$&>" ) } ) ? () : $_ }, @u;
            my %u = map do { ( $_ => 1 ) }, @u;
            @u && msg( '  未知のタグがありました。', map do { "    $_" }, sort keys %u );
        # タグを タグ番号に置換する。
            for ( @in ) {
                s/<(\w[^\s>]*)\s*/<$tag2num{ lc( "<$1>" ) }></; s/<>//;
                s/<\/(\w[^>]*)>/<\/$tag2num{ lc( "<$1>" ) }>/;
           }
        # 終了タグの終わりの文字列を確認する。
            my @u = map do {
                /^(　)*(<\d+>)*<\/\d+>(.*?>)?(\s|\\n)*/ && $' ne "" ? $_ : ()
            }, @in;
            @u && msg( '  終了タグの終わりに文字列がありました。', map do { "    $_" }, @u );
        # 全角空白のインデントをタグ列に変える。
            my @t = ();
            for( @in ) {
                /^(　)*(<[^>]+>)*/; my ( $t, $r ) = ( $&, $' );
                my @s = ( $t =~/　/g ); my @n = ( $t =~ /<[^>]+>/g );
                splice( @t, scalar @s, @t - @s, @n );
                $_ = join "", @t, $r;
            }
    }

    @cat, %cat;  { # 類別を読む。
        # 類別を読む。
            my $fn = 'mdevSGML_cat.txt';
            -f $fn || err( '類別のファイルがありません： '.$fn );
            @cat = getF( $fn );
        # 類別のテーブルを作る。
            %cat = ();
            map do { s/^\s*//; s/\s*$//; /\t+/ && ( $cat{ $` } = [ $' ] ); }, @cat;
    }

    { # 入力sgmlを HTMLに変換し 出力する。
        #  入力sgmlを 'chk1.txt' に出力する（ デバグ用 ）。
        @name;  { # 販売名を調べる。
            # 販売名を調べる。
                { # 販売名のタグを探す。
                     @name = @{find_path( '<Approval-brand-name><detail>' )};
                }
                { # 販売名内の 属性タグを削除する。
                    my $atr = "(".( join "|", @atr_tag ).")";
                    for( @name ) { s/&lt;\/?$atr(\s+\w+\s*=\s*("|').*?\1\s*)?&gt;//gi; }
                }
                { # 販売名内の ＆のエスケープを戻し 強制改行・タブ・\\\\t・\\\\nを削除する。
                    for( @name ) { s,&amp;,&,g; s/&enter;//g; s/\t//g; s/\\t//g; s/\\n//g; }
                }
        }
        @g_name, @lto, @tm;  { #  一般的名称・生物由来の識別・遺伝子組換え材料使用の識別を調べる。
            #  一般的名称・生物由来の識別・遺伝子組換え材料使用の識別を調べる。
                    @g_name = @{find_path( '<New-General-Name><detail>' )};
                    @lto = @{find_prop( '<Classification>', 'Discernment-of-the-living-thing-origin-etc' )};
                    @lto = map do { /^なし$/ ? () : $_ }, @lto;
                    @tm = @{find_prop( '<Classification>', 'Transgenics-material' )};
                    @tm = map do { /^いいえ$/ ? () : $_ }, @tm;
        }
        { # タグ列を HTMLのタグに置換する。
            @hidden;  { # 表示されない情報
                # 表示されない情報
                    @hidden = ();
            }
            my @hide;  { # 表示する情報かどうかの判断の保持
                # 表示する情報かどうかの判断の保持
                    @hide = ();
            }
            my @pare;  { # タグの属性の保持
                # タグの属性の保持
                    @pare = ();
            }
            my @st_s, @st_sp;  # タグの順序・タグ間のHTMLの保持 
            # 入力sgmlの配列 に タグ列を HTMLのタグに置換する 処理を繰り返す。
                for( @in ) { 
                    my $t, $p, $r;  { # タグ列・属性・テキストに分離する。
                        # タグ列・属性・テキストに分離する。
                            /[^>]*$/; ( $t, $r ) = ( $`, $& );
                            $t =~ /^(<\d+>)*<\/?\d+>/; $t = $&; $p = $';
                    }
                    my $c;  { # タグ列に対応する変換テーブルを読む。
                        # タグ列に対応する変換テーブルを読む。
                            $c = path_conv( $t );
                    }
                    # タグ列に対応する変換テーブルがないとき 次へ。
                        $c || next;
                    my $st, $sp, $et, $pr;  { #  開始タグ・タグ間・終了タグに対応するHTML，属性の変換テーブルを 取り出す。
                        #  開始タグ・タグ間・終了タグに対応するHTML，属性の変換テーブルを 取り出す。
                            ( $st, $sp, $et, $pr, ) = @$c;
                    }
                    my $isStart;  { # 開始タグか？
                        # 開始タグか？
                            $isStart = ( $t =~ /<\d+>$/ );
                    }
                    my $hide;  { # 表示する情報か？
                        # 表示する情報か？
                            $hide = ( $st =~ /-hx-/ ) ? @hide && $hide[ 0 ] : $st =~/-h-/ ;
                            if( $isStart ) { unshift @hide, $hide; } else { shift @hide; }
                            $st =~ s/-hx?-//;
                    }
                    # タグの順序を確認する（ 順序が戻ればタグ間のHTMLを挿入する ）。
                        $isStart && $sp ne "" && do { unshift @st_s, 0; unshift @st_sp, $sp; };
                        $isStart && @st_s && $st =~ /-s([1-4])-/ && do {
                            my $n = $1;
                            $st_s[ 0 ] && $st_s[ 0 ] >= $n && ( $st = @st_sp[0].$st );
                            $st_s[ 0 ] = $n;
                        };
                        ! $isStart && $sp ne "" && do{ shift @st_s; shift @st_sp; };
                        $st =~ s/-s[1-4]-//;
                    my $prop, $pare;  { # タグの属性・親タグの属性
                        # タグの属性・親タグの属性
                            $isStart && unshift @pare, prop_get( $p );
                            $prop = $pare[ 0 ];
                            $pare = @pare > 1 ? $pare[ 1 ] : {} ;
                            $isStart || shift @pare;
                    }
                    # テキストを補正する（ 補正の定義があるとき ）。
                        $isStart && $st =~ /^(-\w+-)*\$nul$/ && ( $r = "" );
                        $isStart && defined( $pr->{ '...' } ) && $r ne "" &&
                            ( $r = prop_alt( '...', { '...' => $r }, $pr ) );
                    # HTMLのタグを補正する。
                        $isStart || ( $st = $et, $r = "" );
                        $st = prop_conv( $st.$r, $prop, $pr, $pare );
                    # 変換結果を保存する。
                        $hide && ( $_ = "\t", push @hidden, "\t$st" );
                        $hide || ( $_ = "\t$st" );
                }
        }

        # 警告・禁忌の空タグを削除する。
            my @a = ( 'TBODY', 'TR', 'TD', 'TT', 'H3', 'P', 'FONT( color=red)?' );
            my $a = "(\\\\n|\\s|<\\/?".( join ">|<\\/?", @a ).">)";
            my $i;
            for ( $i = 0; $i + 1 < @in; $i++ ) {
                $in[ $i + 1 ] =~ /^$a+<\/TABLE>(\\n|<P><\/P>)*$/i &&
                $in[ $i ]     =~ /\\n<TABLE borderColor=red border=2>$a+$/i &&
                    ( $in[ $i ] = $`, $in[ $i + 1 ] = "\t" );
            }
        # 変換できなかったタグを削除する。
            my @u = ();
            for( @in, @hidden ) {
                /^\t/ || /<?EBT:/i || /<!DOCTYPE\s/i || ( ( push @u, $_ ), $_ = "" );
            }
            @u && msg( '  変換できない部分がありました。', map do { "    $_" }, @u );
        # 販売名・一般的名称・生物由来の識別・遺伝子組換え材料使用の識別を置換する。
            for( 1 .. 2 ) { insert_info( '〓販売名〓', join '；', @name ); }
            insert_info( '〓一般的名称〓', join '；', @g_name );
            insert_info( '〓生物由来の識別〓', join '；', @lto );
            insert_info( '〓遺伝子組換え材料使用の識別〓', join '；', @tm );
        # 表示されない情報を置換する。
            insert_info( '〓表示されない情報〓', join "\\n", @hidden, "" );
        # 属性タグを置換する。
            for my $tag ( @atr_tag ) {
                my $c = $path2htm{ '<'.$tag2num{ lc( "<$tag>" ) }.'>' };
                my ( $st, undef, $et, $pr, ) = @$c;
                for( @in ) {
                    while( /&lt;($tag(\s.*?)?)&gt;/i ) {
                        my ( $s, $t, $p ) = ( $`, $1, $' ); $t =~ s/^\S+\s*//;
                        my $r = prop_conv( $st, prop_get( "<$t>" ), $pr );
                        $_ = "$s$r$p";
                    }
                    s/&lt;\/$tag&gt;/$et/gi;
                }
            }
        #  入力sgmlを 'chk2.txt' に出力する（ デバグ用 ）。
        # ＆のエスケープを戻し 強制改行を置換する。
            for( @in ) { s,&amp;,&,g; s/&enter;/<BR>/g; }
        # \\t, \\nを 元に戻す。
            @in = map do { /^\t/ ? $' : () }, @in;
            for( @in ) { s/\t//g; s/\\t/\t/g; s/\\n/\x0a/g; }
        # HTMLの体裁を補正する。
            my $in = join "", @in;
            while( $in =~ s/(<DIV( [^>]*)?>\s*)<BR>(?!<IMG )/$1/i ) {};
            $in =~s/\x0a\x0a+/\x0a/g;
            @in = split "\x0a", $in;
        # 出力HTMLを書く。
            my $fn = $ARGV[0];
            if( $fn =~ /\.sgm$/i ) {
                $fn =~ s/\.sgm$/.htm/i;
                putF( $fn, join "\x0a", @in, "" );
            }
    }

=pod - 変換規則の書式 ‥

空行                                    ※ 単に無視する。
〈全角空白〉タグの説明 ／ mdevのタグ名  ※ タグの指定。 ／は半角にすること。
                                           全角空白のインデントで 親子関係を指定する。
〈タブ〉〈タブ〉HTMLのタグ
〈タブ〉〈タブ〉〓@mdevの属性名：       ※ 属性の変換を指定する。
〈タブ〉〈タブ〉〓@@mdevの属性名：      ※ 親タグの属性の変換を指定する。
〈タブ〉〈タブ〉〓...：                 ※ テキストの変換を指定する。
〈タブ〉〈タブ〉〈タブ〉被置換文字列〈タブ〉=>〈タブ〉置換後文字列
                                    ※ 属性またはテキストの変換を指定する。
※ mdevSGML_s2h.txt をサンプルとして参照してください。

※ 空文字列は $nul で指定する。
※ 改行は \n で指定する。
※ ... の前で 開始タグに対応するHTMLのタグを指定し、
   ... の後ろで 終了タグに対応するHTMLのタグを指定する。
※ タグ  A B C D が 連続して並び 後ろのタグから前のタグに戻るところで
   挿入したいHTMLのタグがある場合 ...挿入するHTMLのタグ... で指定する。
   （ タグの並びは ところどころ省略されていても構わない。 ）
   また タグの順序は -s1- -s2- -s3- -s4- で指定する。
※ -h- で 表示されない情報であることを指示する。
   -hx-で 親タグの設定を参照することを指示する。
※ 〓@属性名〓 のところは 属性の値に置換する。
   その際 属性の変換が指定されていれば その通りに変換して置換する。
   〓HTMLのタグ @属性名 HTMLのタグ〓と指定することもできる。
   属性値が空文字列の場合 〓〜〓 すべて挿入しない。
※ 〓販売名〓 〓生物由来の識別〓 〓一般的名称〓 〓遺伝子組換え材料使用の識別〓
   〓表示されない情報〓 は プログラムで自動的に置換する。
※ 被置換文字列は 正規表現で指定する。
   被置換文字列が 空文字列 のときは デフォルト値とみなす。
※ 置換後文字列には $&, $1 〜 $9 が使用できる。
=cut

=pod - HTMLのタグに置換するテーブルの書式 ‥

〈タグ〉・・・〈タグ〉〈タブ〉HTMLのタグ

※ HTMLのタグはの書式は 変換規則のHTMLのタグと同じ。
=cut

=pod - 類別の書式 ‥

類別 〈タブ〉 文字列

※〈タブ〉のない行は注釈と判断。
※ 類別は [A-D]\d\d\d\d
※ mdevSGML_cat.txt をサンプルとして参照してください。
=cut

=pod - デバグについて

デバグ用の記述のコメントアウトをはずせば、デバグ用のファイルが出力されます。
  例．  入力sgmlを 'chk1.txt' に出力する（ デバグ用 ）。
=cut

#  処理の詳細 ‥

# - $in に対する処理

# -- $in に対する処理

# -- $in に対する処理  エスケープ

# -- $in に対する処理  タグ

# - @in に対する処理

# -- @in に対する処理

# -- @in に対する処理  タグ

# -- @in に対する処理  インデント

# -- @in に対する処理  HTMLのタグに置換

# -- @in に対する処理  HTMLのタグに置換  表示されない情報

# -- @in に対する処理  HTMLのタグに置換  タグの順序

# -- @in に対する処理  HTMLのタグに置換  属性

    sub prop_get { # ( tag )の属性を読む。 
        my $t = $_[0];
        $t =~ s/^<\s*//; $t =~ s/\s*>$//;
        my @t = $t =~ /([\w-]+\s*=\s*'[^']*'|[\w-]+\s*=\s*"[^"]*"|[\w-]+\s*\s*=\S+)\s*/g;
        my $h = {};
        map do {
            /\s*=\s*/; my ( $k, $v ) = ( $`, $' );
            $v =~ /^('|")(.*)\1$/ && ( $v = $2 );
            $h->{ $k } = $v;
        }, @t;
        $h;
    }

# -- @in に対する処理  HTMLのタグに置換  変換と補正

    sub path_conv { # ( path )を HTMLのタグに置換するテーブル で置換する。 
            my $t = $_[0];
            $t =~ s/<\//</;
            defined( $path2htm{ $t } ) && return $path2htm{ $t };
            while( $t =~ /^<[^>]+>/ ) {
                $t = $';
                defined( $path2htm{ $t } ) && return $path2htm{ $t };
            }
            return undef;
    }

    sub prop_conv { # ( html )に属性( h )を置換テーブル( p )( pr )で埋め込む。 
        my ( $t, $h, $p, $pr, ) = @_; BEGIN { $adr = 1; }
        $t =~ s/\$nul//g;
        while( $t =~ /〓(?![^@]*(?:〓|$))([^@]*)[@]([@]?[\w-]+)(.*?)(〓|$)/ ) {
            my ( $s, $cs, $k, $cr, $r ) = ( $`, $1, $2, $3, $' );
            $k =~ /^[@]/ && ( $h->{ $k } = $pr->{ $' } );
            my $c = prop_alt( $k, $h, $p ); $c eq "" || ( $c = "$cs$c$cr" );
            $t = "$s$c$r";
        }
        $t =~ /\$adr/ && $t =~ s/\$adr/@{[ $adr++ ]}/g;
        $t;
    }

    sub prop_alt { # 属性( prop )を置換テーブル( p )で置換する。 
        my ( $k, $h, $p, ) = @_;
        defined( $p->{ $k } ) || return "";
        my @a = @{$p->{ $k }}; my $u = "";
        @a = map do { /^=>/ && ( $u = $' ); /^=>/ ? () : $_; }, @a;
        my $r = $h->{ $k }; defined( $r ) || return $u;
        for( @a ) {
            /=>/; my ( $f, $v ) = ( $`, $' );
            $r =~ /^$f$/i || next;
            my @v = ( $&, $1, $2, $3, $4, $5, $6, $7, $8, $9 );
            $v =~ s/\$&/$v[ 0 ]/g; for( 1 .. 9 ) { $v =~ s/\$$_/$v[ $_ ]/g; }
            $v =~ s/^cat\(\s*(\S+)\s*\)/@{$cat{ $1 }}[0]/g;
            return $v;
        }
        return $u;
    }

# -- @in に対する処理  エスケープを戻す

# -- @in に対する処理  販売名等  調べる

    sub find_path { # タグ( tag )を探す 
        my $t = $_[0];
        my $tn = join "", map do { "<$tag2num{ lc( $_ ) }>" }, $t =~ /<[^>]*>/g;
        [ map do { /$tn/ ? $' : () }, @in ];
    }

    sub find_prop { # 属性( prop )を探す 
        my ( $t, $p, ) = @_;
        my $tn = join "", map do { "<$tag2num{ lc( $_ ) }>" }, $t =~ /<[^>]*>/g;
        my @t = map do { /$tn/ ? $_ : () }, @in;
        my @p = map do {
            /$tn/; my $c = path_conv( $`.$& );
            $c && /(<|\s)$p=("|')(.*?)\2/ ? prop_alt( $p, { $p => $3 }, $$c[3] ) : () ;
        }, @t;
        [ @p ];
    }

# -- @in に対する処理  販売名等  置換する

    sub insert_info { # ( str )を( info )に置換する。 
        my $s = quotemeta_ja( $_[0] );
        for( @in ) { /$s/ && ( $_ = "$`$_[1]$'", last ); }
    }

# - @cat に対する処理

# -- @cat に対する処理

# - @s2h に対する処理

# -- @s2h に対する処理

# -- @s2h に対する処理  タグ

# -- @s2h に対する処理  HTMLへの変換

# -- @s2h に対する処理  HTMLへの変換  補正

# - 補助の定型ルーチン

    sub quotemeta_ja { # 日本語文字列( str )のquotemeta 
        join '', map do{ s/(.)([\x40\x5b-\x60\x7b-\x7f])/$1\\$2/; $_ ; },
            ( $_[0] =~ /([\x00-\x7f\xa0-\xdf]|..)/g );
    }

    sub getF { # ファイル( name )を読む。 
        open( IN, '<'.$_[0] ) || err( 'オープンエラー：'.$_[0] );
        my @buf = <IN>; close( IN );
        @buf;
    }

    sub putF { # ファイル( name )に( string )を出力する。 
        if( open( OUT, '>'.$_[0] ) ) { print OUT $_[1]; close( OUT ); }
        else { err( 'オープンエラー：'.$_[0] ); }
    }

    sub err { # メッセージ( array )を表示して エラー終了する。 
        msg( @_ ); exit( 1 );
    }

    sub msg { # メッセージ( array )を表示する。 
        print map do { $_."\x0a" }, @_;
    }

# - 構文

# - ライセンス
# ~   スクリプトの冒頭に記述。