\s?<\/P>(?=)(
\s?)*/$1/g;
s/])[^>]*?><\/DIV>//g;
s/<\/DIV>(?=<\/DIV>)/$&\x0a/g;
s/\x0a+/\x0a/g;
}
$n eq $ss || msg( ' 出力HTMLの体裁が変わったところがあります。' );
$o eq $so || msg( ' 元のHTMLの体裁が変わったところがあります。' );
# デバグ用出力あり ならば unlink( 'chk_no.txt', 'chk_ni.txt', 'chk_oo.txt', 'chk_oi.txt' );
if( $opt =~ /d/i ) { unlink( 'chk_no.txt', 'chk_ni.txt', 'chk_oo.txt', 'chk_oi.txt' ); }
# デバグ用出力あり かつ $n ne $ss ならば msg( ' output: chk_no.txt, chk_ni.txt' ); putF( 'chk_no.txt', $n ); putF( 'chk_ni.txt', $ss );
if( $opt =~ /d/i && $n ne $ss ) { msg( ' output: chk_no.txt, chk_ni.txt' ); putF( 'chk_no.txt', $n ); putF( 'chk_ni.txt', $ss ); }
# デバグ用出力あり かつ $o ne $so ならば msg( ' output: chk_oo.txt, chk_oi.txt' ); putF( 'chk_oo.txt', $o ); putF( 'chk_oi.txt', $so );
if( $opt =~ /d/i && $o ne $so ) { msg( ' output: chk_oo.txt, chk_oi.txt' ); putF( 'chk_oo.txt', $o ); putF( 'chk_oi.txt', $so ); }
}
@mh_mark; # マークhtmlの マーク一覧
%m2a; # マークhtmlの マークとアンカーの対応
$ch_htm; # 比較html
@ch_diff, @ch_diff2; # 比較htmlの ブロックごとの相違一覧
@ch_mark; # 比較htmlの ブロックごとのマーク一覧
@ch_anc; # 比較htmlの ブロックごとのアンカー一覧
%h_mark; { # マークに対応するhtmlタグ
# マークに対応するhtmlタグ
my @c = ( '#6666ee', '#ee5566' );
%h_mark = (
'del' => '',
'/del' => '',
'ins' => '',
'/ins' => '',
);
}
@h_atr; { # htmlの属性タグ
# htmlの属性タグ
@h_atr = (
'b', 'u', 'i', 'sup', 'sub',
);
}
{ #+ リンク
# マークhtmlのマーク一覧を作り マークの対応を補正する。
my $fm = '〓(?:ins|del)\d+〓';
@mh_mark = ( $m_htm =~ /($fm)/g );
@mh_mark = map do { /(\d+)/g }, @mh_mark;
# msg( '--- mh_mark ---', @mh_mark );
my %mm = (); my $i = 0; for( @mh_mark ) { $mm{ $_ } = $i++; }
@c2m = map do {
[ map do { defined( $mm { $_ } ) ? $_ : () }, @$_ ];
}, @c2m;
# my $i = 0; msg( '--- c2m ---', map do { join ' ', $i++, ':', @$_ }, @c2m );
# マークhtmlで マークとアンカーの対応を調べる。
my $fa = '';
my $fm = '〓(?:ins|del)\d+〓';
@mh_ma = ( $m_htm =~ /($fa|$fm)/gi );
@mh_ma = ( ( join '', @mh_ma ) =~ /($fa(?:$fm)*)/gi );
# msg( '--- mh_ma ---', @mh_ma );
%m2a = ();
for( @mh_ma ) {
/^$fa/i; my $d = $&; my $r = $';
$d =~ s/^<\/a>$//i;
my @d = ( $d, ( $r =~ /\d+/g ) );
my $a = shift @d; for( @d ) { $m2a{ $_ } = $a; }
}
# msg_m2a();
# 比較html を読む。
$ch_htm = join '', getF( $fol.$ch_fn );
# 比較htmlの ブロックごとの相違一覧を作る。
@ch_diff = ();
my $fa = '';
my $ff = '';
my $ch = $ch_htm; my $s = 0; my $e = 0;
while( $ch =~ /$fa/i ) {
$ch = $'; my $r = ( $ch =~ /$fa/ ) ? $` : $ch ;
my @r = ( $r =~ /($ff)/gi );
$e = $s + @r - 1; push @ch_diff, [ $s .. $e ]; $s = $e + 1;
}
$s == $cd_no || msg( ' 差分SGMLと比較HTMLの相違箇所数に違いがあります。' );
# my $i = 0;
# msg( '--- ch_diff ---', map do { join ' ', $i++, ':', @$_ }, @ch_diff );
# my $b = 18; msg( '--- ch_diff '.$b.' ---', join ' ', @{$ch_diff[$b]} );
# ブロックごとの相違一覧から 削除された番号を消し 番号を変換する。
my %cd = (); my $i = 0; for( @cs_diff ) { $cd{ $_ } = $i; $i++; }
@ch_diff2 = map do {
[ map do { defined( $cd { $_ } ) ? $cd { $_ } : () }, @$_ ];
}, @ch_diff;
# my $i = 0;
# msg( '--- ch_diff2 ---', map do { join ' ', $i++, ':', @$_ }, @ch_diff2 );
# my $b = 18; msg( '--- ch_diff2 '.$b.' ---', join ' ', @{$ch_diff2[$b]} );
# ブロックごとのマーク一覧を作る。
@ch_mark = map do {
[ map do { @{$c2m[ $_ ]} }, @$_ ];
}, @ch_diff2;
# my $i = 0;
# msg( '--- ch_mark ---', map do { join ' ', $i++, ':', @$_ }, @ch_mark );
# my $b = 18; msg( '--- ch_mark '.$b.' ---', join ' ', @{$ch_mark[$b]} );
# ブロックごとのアンカーの一覧を作る。
@ch_anc = map do {
my @anc = map do { $m2a{ $_ } }, @$_; uniqueA( \@anc );
[ @anc ];
}, @ch_mark;
# my $i = 0;
# msg( '--- ch_anc ---', map do { join ' ', $i++, ';', @$_ }, @ch_anc );
# 比較htmlに アンカーへのリンクを追加する。
my $fa = '';
my $fl = '';
my $ch = $ch_htm; $ch_htm = ''; my $a_no = 0;
while( $ch =~ /$fa/i ) {
$ch_htm .= $`.$&; $ch = $';
my @anc = @{ $ch_anc[ $a_no++ ] };
my $anc = join "\x0a", '', ( map do { sprintf $fl, $_, $_ }, @anc ), '';
@anc && ( $ch_htm .= $anc );
}
$ch_htm .= $ch;
# 新htmlと比較htmlを出力する。
msg( ' update: '.$nh_fn ); putF( $fol.$nh_fn, $n_htm );
msg( ' output: '.$ch_fn ); putF( $fol.$ch_fn, $ch_htm );
}
{ #+ 結果出力
# マークをhtmlタグに変える。
my $o = $m_htm; $out = ''; my $ha = '(?:'.( join '|', @h_atr ).')';
while( $o =~ /〓(ins|del)(\d+)〓((?:.|\s)*?)〓\/\1\2〓/ ) {
$out .= $`; my $k = $1; my $r = $3; $o = $';
$r =~ s/][^>]*?>//gi; $r =~ s/<\/FONT>//gi;
$k eq 'del' && ( $r =~ s/<\/?$ha>//gi );
$out .= $h_mark{ $k }.$r.$h_mark{ "/$k" };
}
$out .= $o;
my $hg = quotemeta( '<!-- graphic -->' );
$out =~ s/(])[^>]*?>)(?:.|\s)*?$hg/$1/g;
# デバグ用出力あり ならば msg( ' output: chk_out.htm' ); putF( 'chk_out.htm', $out );
if( $opt =~ /d/i ) { msg( ' output: chk_out.htm' ); putF( 'chk_out.htm', $out ); }
# 結果を出力する。
msg( ' output: '.$hfn );
putF( $fol.$hfn, $out );
# ! ( デバグ用出力あり ) ならば 作業フォルダを初期化する。
if( ! ( $opt =~ /d/i ) ) {
my @n = ( $n_fn, $o_fn, $c_fn, $ch_fn, $m_fn, $nh_fn, $oh_fn, $mh_fn );
for( @n ) { -f $wfol.$_ && unlink( $wfol.$_ ); }
my @r = map do { -e $wfol.$_ ? $_ : () }, @n;
@r && err( ' 作業フォルダを初期化できません。' );
}
# ! ( デバグ用出力あり ) ならば 差分sgmlを削除する。
if( ! ( $opt =~ /d/i ) ) { unlink( $fol.$c_fn ); }
}
# 処理の詳細 ‥
# - 開始
# - 新・旧・差分sgml
# - マークsgml
sub graphic_esc { # 画像タグのエスケープ
my $t = $_[0]; $t =~ s/^$//;
my $i = $t; my $d = $t;
$i =~ s/(.*?)<\/my:ins>/$1/g;
$i =~ s/(.*?)<\/my:del>//g;
$d =~ s/(.*?)<\/my:del>/$1/g;
$d =~ s/(.*?)<\/my:ins>//g;
$d = ( $d =~ /gfname="([^"]*)"/ ) ? $1.'<!-- graphic -->' : '' ;
"<$i>$d";
}
sub msg_cs_diff { # cd_diffの表示
my %cd = (); for( @cs_diff ) { $cd{ $_ } = 1; }
msg( '--- cs_diff ---',
'総数 '.$cd_no,
'削除されたもの '.( join ' ',
map do { defined( $cd{ $_ } ) ? () : $_ }, ( 0 .. $cd_no - 1 )
),
);
}
# - 新・旧・マークhtml
# - リンク
sub msg_m2a { # マークとアンカーの対応を表示する。
my @m = sort values %m2a; uniqueA( \@m );
@m = map do {
my $a = $_;
my @m = map do { $m2a{ $_ } == $a ? $_ : () }, keys %m2a;
[ $a, ':', sort @m ];
}, @m;
msg( '--- m2a ---', map do { join ' ', @$_ }, @m );
}
=pod
@ch_diff : ブロックごとの相違の番号
@cs_diff : 削除されていない相違の番号
$cd_no : 相違の総数
@c2m : 相違の番号に対応する マークの番号
@c2m == @cs_diff
=cut
# - 出力
# - 補助の定型ルーチン
sub uniqueA { # ( array )の重複を除去する
my $n = '';
@{$_[0]} = map do { my $p = $n; $n = $_; $p eq $n ? () : $n; }, @{$_[0]};
}
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 = ; 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" }, @_;
}
# - 構文
# - ライセンス
# ~ スクリプトの冒頭に記述。