HTML から span like なインライン要素タグを正規表現を使って除く修行、その3

Perl

以前、HTML から span like なインライン要素タグを正規表現を使って除去するスクリプトを書いた。

そいつの不備を見つけた。属性値が「size=+1」とか「color=#808080」とか書かれているときに正規表現にマッチせずに削除できていなかった。それを修正したの次のスクリプト。

my $SINGLE_QUOTED = qr{\' [^\']* \'}xms;
my $DOUBLE_QUOTED = qr{\" [^\"]* \"}xms;
my $NOT_QUOTED = qr{ [^\s\'\">]+ }xms;
my $NAME = qr{ [abiu] | em | tt | big | font | address |                        
               s (?: otrike | pan | trong | amp | mall | u[bp] ) |              
               c (?: ite | ode )                                                
          }xmsi;
my $ATTR_NAME  = qr{ [a-zA-Z0-9-_:]+ }xms;
my $ATTR_VALUE = qr{ $SINGLE_QUOTED | $DOUBLE_QUOTED | $NOT_QUOTED }xms;
my $TAG = qr{ < (?:                                                             
                 (?: $NAME (?: \s+ $ATTR_NAME = $ATTR_VALUE )* )  # start tag   
                  |                                                             
                 (?: / $NAME                                   )  # end tag     
                )                                                               
              \s* > }xms;

$html =~ s{ $TAG }{}xmsg;

追記 2010-01-27

xhtml でネームスペースを切っているときの属性名 (: が含まれる) に対応していなかったので修正。

追記 2010-01-29

世の中に出回っている HTML を調べていると、「a href="..." target ="blank"」と属性名 (target) の後に余分なスペースが入ったタグや、「a href="..."Target ="blank"」と属性名 (Target) の前のスペースがないタグがときおり見つかる。それに対応するには、もっと正規表現を緩めないといけない。とりあえず次のようにした。

my $SINGLE_QUOTED = qr{\' [^\']* \'}xms;
my $DOUBLE_QUOTED = qr{\" [^\"]* \"}xms;
my $NOT_QUOTED = qr{ [^\s\'\">]+ }xms;
my $NAME = qr{ [abiu] | em | tt | big | font | address |                        
               s (?: otrike | pan | trong | amp | mall | u[bp] ) |              
               c (?: ite | ode )                                                
          }xmsi;
my $ATTR_NAME  = qr{ [a-zA-Z0-9-_:]+ }xms;
my $ATTR_VALUE = qr{ $SINGLE_QUOTED | $DOUBLE_QUOTED | $NOT_QUOTED }xms;
my $ATTR = qr{ $ATTR_NAME \s* = \s* $ATTR_VALUE }xms;
my $TAG = qr{ < (?:                                                             
                 (?: $NAME (?: \s+ $ATTR (?: \s* $ATTR )* )? )  # start tag     
                  |                                                             
                 (?: / $NAME                                   )  # end tag     
                )                                                               
              \s* > }xms;