# packinsSGML_s2h ( ver 0.1 ) :
# This program converts PACKINS SGML into the HTML form.
#   Written by prepress-tips 2008.12.04
#   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.

# - 処理の概要は ‥

    $in; { # 入力sgmlの文字列 
        # 開始メッセージを表示する。
            msg( 'packinsSGML_s2h ( ver 0.1 )');
        # 入力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 = (
                'chem' => '', 'div' => '', 'nom' => '', 'den' => '/',
                'sup' => 'SUP', 'sub' => 'SUB',
                'chr' => 'FONT color=black',
                'bold' => 'B', 'italic' => 'I', 'under' => 'U',
                'han' => '', 'gaiji' => '',
                'chr color="red"' => 'FONT color=red',
            );
    }
    { # 入力sgmlを タグ＋テキスト の形に分ける。
        # タブと改行を \\tと\\nに置換する。
            $in =~ s/\t/\\t/g;
            $in =~ s/\x0d?\x0a/\\n/g;
        # 半角＆をエスケープする。
            $in =~ s/\&/&/g;
        # 属性タグ・graphicタグをエスケープする。
            for( keys %atr_tag ) { $in =~ s/<(\/?$_)>/&lt;$1&gt;/gi; }
            $in =~ s/<(graphic( [^>]*)?)>/&lt;$1&gt;/gi;
        # DOCTYPE宣言をエスケープする。
            while( $in =~ s/(<!DOCTYPE [^<]*)<(![^>]*)>/$1&lt;$2&gt;/i ) {};
        # タグ＋テキストの形に分ける。
            while( $in =~ s/([^\x0a])(<[^<>]*>)/$1\x0a$2/ ) {}
    }
    { # 入力sgmlの書式を揃える。
        # 属性を追加する。
            $in =~ s,<warnings>,<warnings boxline="yes" boxcolor="rd" color="red">,;
            my @tag =(
                'contraindications', 'avoidedadministration', 'contraindication',
                'precautionsforcontraindication', 'avoid', 'precautionsforavoid',
            );
            for ( @tag ) { $in =~ s,<$_>,<$_ boxline="yes" boxcolor="rd">,gi; }
        # 不要タグを削除する。
            my @tag = (
                'yearmonth', 'detail', 'otherdescription', 'faxnumber',
            );
            for ( @tag ) { $in =~ s,<$_><variablelabel[> ][^<]*</variablelabel></$_>,,gi; }
        # 属性の記述を統一する。
            $in =~ s,(<\w+)\s+,$1 ,g;
            while( $in =~ s,(<\w+[^>]*)\s+=,$1=,i ) {};
            while( $in =~ s,(<\w+[^>]*)=\s+,$1=,i ) {};
        # 不要な属性を削除する。
            $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;
    }

    @s2h; { # 変換規則 
        # 変換規則を読む。
            my $fn = 'packinsSGML_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/ ? () : /<[^>]+>/g ; }, @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/ && next;
                s/<[^>]+>/<$tag2num{ lc( $& ) }>/g;
           }
        # 変換規則内の全角空白によるインデントを タグ列に変える。
            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+//g;
            @s2h = split "\x0a", $s2h;
        # sgmlのタグ列を HTMLのタグに置換するテーブル を作る。
            %path2htm = map do { /\t+/ ? ( $` => $' ) : () ; }, @s2h;
        # 開始タグに対応する部分 と 終了タグに対応する部分 に分ける。
            for( keys %path2htm ) {
                my ( $t, $b ) = ( $path2htm{ $_ }, "" );
                $t =~ /\$v/ && ( $t = $`."\$v", $b = $' ); # \$vがセパレータ
                $path2htm{ $_ } = $t;
                /<([^>]*)>$/ && ( $path2htm{ "$`</$1>" } = $b );
            }
        #  HTMLのタグに置換するテーブル を出力する。
    }

    @in; { # 入力sgmlの配列 
        # 入力sgmlを 配列に変える。
            @in = split "\x0a", $in;
    }
    { # 入力sgmlを タグ列＋テキスト の形に変える。
        # 入力sgmlを全角空白でインデントする。
            my $lv = 0;
            for( @in ) {
                /^<\// && $lv--; my $s = '　' x $lv; /^<\w/ && $lv++;
                $_ = $s.$_;
            }
        # 終了タグに 開始タグの属性をコピーする。
            for( my $n = 0; $n < @in; $n++ ) {
                $in[ $n ] =~ /^((?:　)*)<(?!\/|\?|\!)([^ >]*)( [^>]+)>/ || next;
                my ( $sp, $tag, $prop ) = ( $1, $2, $3 );
                for( my $p = $n + 1; $p < @in; $p++ ) {
                    $in[ $p ] =~ /^$sp<\/$tag/i || next;
                    $in[ $p ] = $&.$prop.$';
                    last;
                }
            }
        # 未知のタグを確認する。
            my @u = map do { /<\w[^>]*>/g; }, @in;
            @u = map do { defined( $tag2num{ lc( $_ ) } ) ? () : $_ }, @u;
            my %u = map do { ( $_ => 1 ) }, @u;
            @u && msg( '  未知のタグがありました。', map do { "    $_" }, sort keys %u );
        # タグを タグ番号に置換する。
            for ( @in ) {
                s/<\w[^>]*>/<$tag2num{ lc( $& ) }>/;
                s/<\/(\w[^>]*)>/<\/$tag2num{ lc( "<$1>" ) }>/gi;
           }
        # 全角空白のインデントをタグ列に変える。
            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;
            }
    }

    { # HTMLのタグに置換するテーブル の中の 販売名とダウンロード を 入力sgmlのそれに変える。
        @name; { # 入力sgml内の 販売名 
            # 販売名を探す。
                my $t = '<approvalbrandname><variablelabel onswitch="on">';
                $t = join "", map do { "<$tag2num{ $_ }>" }, $t =~ /<[^>]*>/g;
                $t =~ s/(<)([^>]*>)$/$1\/$2/;
                for( keys %path2htm ) { /$t/ && ( $t = $_, last ); }
                @name = map do { /^$t/ ? $' : () }, @in;
            # 販売名内の 属性タグ・graphicタグを削除する。
                my @a = map do { /^\w+$/ ? $_ : () }, keys %atr_tag;
                my $t = join "|", @a, 'graphic'; $t = "($t)";
                for( @name ) { s/&lt;\/?$t( +gfname *= *"([^"]+)")?&gt;//gi; }
            # 販売名内の ＆のエスケープを戻し 強制改行・タブ・\\t・\\nを削除する。
                for( @name ) { s,&amp;,&,g; s/&enter;//g; s/\t//g; s/\\t//g; s/\\n//g; }
        }
        #  置換テーブル内の 販売名を置換する。
            my $n = join "；", @name;
            my $t = '<packins lang="ja" version="2.1">'; $t = "<$tag2num{ $t }>";
            $path2htm{ $t } =~ s/販売名/$n/g;
        @pdf; { # 入力sgml内の PDF 
            # PDFを探す。
                my $t = '<downloadfile ext="pdf">'; $t = "<$tag2num{ $t }>";
                for( keys %path2htm ) { /$t/ && ( $t = $_, last ); }
                @pdf = map do { /^$t/ ? $' : () }, @in;
        }
        #  置換テーブル内の ダウンロードを置換する。
            my $p = join "<BR>", @pdf;
            my $t = '<packins lang="ja" version="2.1">'; $t = "<$tag2num{ $t }>";
            $path2htm{ $t } =~ s/ダウンロー[]ド/$p/g;
    }

    { # 入力sgmlを HTMLに変換し 出力する。
        #  入力sgmlを 'chk1.txt' に出力する。
        # タグ列を HTMLのタグに置換する。
            for( @in ) {
                /[^>]*$/; my ( $t, $r ) = ( $`, $& );
                $_ = path_conv( $t ); /^\t/ || next;
                /\$v$/ && ( $_ = "$`$r", next );
                $t =~ /<\/\d+>$/ || next;
                $t = path_conv( $` ); $t =~ /^\t/ || next;
                $t =~ /\$v/ && ( $_ .= $r, next );
            }
        # 変換できなかったタグを削除する。
            my @u = ();
            for( @in ) {
                /^\t/ || /<?EBT:/i || /<!DOCTYPE\s/i || ( ( push @u, $_ ), $_ = "" );
            }
            @u && msg( '  変換できない部分がありました。', map do { "    $_" }, @u );
        # 属性タグを置換する。
            for my $t ( keys %atr_tag ) {
                my $s = ( $atr_tag{ $t } eq "" ) ? "" : "<$atr_tag{ $t }>" ;
                my $e = ( $s =~ /<(\w+)/ ) ? "</$1>" : "" ;
                for( @in ) {
                    s/&lt;$t&gt;/$s/gi;
                    s/&lt;\/$t&gt;/$e/gi;
                }
            }
        # graphicタグ置換して ＆のエスケープを戻し 強制改行を置換する。
            for( @in ) {
                s/&lt;graphic +gfname *= *"([^"]+)" *&gt;/<IMG align=absMiddle src=\"$1\">/gi;
                s,&amp;,&,g;
                s/&enter;/<BR>/g;
            }
        # \\t, \\nを 元に戻す。
            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 = split "\x0a", $in;
        # 出力HTMLを書く。
            my $fn = $ARGV[0];
            if( $fn =~ /\.sgm$/i ) {
                $fn =~ s/\.sgm$/.htm/i;
                putF( $fn, join "\x0a", @in );
            }
    }

=pod - 変換規則の書式 ‥

　<tag(属性)>		# コメント
		(tagの前に置く文字列)$v(tagの後ろに置く文字列)
*<tag>
		(tagの前に置く文字列)$v(tagの後ろに置く文字列)
*<tag1><tag(属性)>
		(tagの前に置く文字列)$v(tagの後ろに置く文字列)
# コメント
※1 コメントは ない場合もある
※2 文字列は 空の場合もある
=cut

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

<tag番号>・・・<tag番号>   → (tagの前に置く文字列)$v
<tag番号>・・・</tag番号>  → (tagの後ろに置く文字列)$v
*<tag番号>・・・<tag番号>  → (tagの前に置く文字列)$v
*<tag番号>・・・</tag番号> → (tagの後ろに置く文字列)$v
※ 文字列は 空の場合もある
※ $vは つかない場合もある
=cut

#  処理の詳細 ‥

# - $in に対する処理

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

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

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

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

# - @in に対する処理  HTMLへ

    sub path_conv { # ( ？ )を HTMLのタグに置換するテーブル で置換する。 
            # 置換できたときは 頭に "\t"を付ける。置換できないときは そのまま返す。
            my $t = $_[0];
            defined( $path2htm{ $t } ) && return "\t".$path2htm{ $t };
            while( $t =~ /^<[^>]+>/ ) {
                $t = $';
                defined( $path2htm{ "*$t" } ) && return "\t".$path2htm{ "*$t" };
            }
            return $_[0];
    }

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

# - @in に対する処理  添付PDF

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

# - @in に対する処理

# - @s2h に対する処理

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

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

# - 補助の定型ルーチン

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

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

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

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

# - ライセンス