Perl HTML::TagParser を使ってルーズなHTMLをパースしちゃう

HTMLパーサあれこれ

HTMLは人間がテキストエディタで手打ちしたものがほとんどで、タグの閉じ忘れや閉じる場所がずれていたりすることが多々あります。にんげんだものヽ(´ー｀)ノ
しかし、ブラウザはそんなルーズなソースでも出来る限りがんばって表示して下さいます。いい子ですね。

こんな閉じ忘れでも健気に表示してくれるブラウザさん

<div>
<ul>
    <li>メニュー1</li>
    <li>メニュー2</li>
    <li>メニュー3</li>
</div>

PerlでHTMLを分解しようとCPANを漁ると、XML::ParserやHTML::Parserなどいろいろ種類があります。
だがしかし！この子達はあまりにもストイックで、タグのエラーを見つけるとそこで諦める子がほとんどです。
上記のようなソースを読ませると、「ぼくもうあきらめた」と一言吐いてそれ以上は読んでもくれません。

HTML::TagParser

そこで颯爽と現れたのはHTML::TagParserさん。
なんとこの子は、どんな汚いHTMLでも諦めずに最後まで読み込んでくれるイケメンです。(そしてメイドインジャパン)

ネイティブJavascriptライクで超便利！

使用例

use HTML::TagParser;

#読み込む
my $html = HTML::TagParser->new('http://www.abcd.com');

#エレメントを抽出
$html->getElementById('content1');

#子エレメントを取得
my @childs = @{$element->childNodes()};

#子エレメントのDIVタグのinnerTextを書き出してみる
foreach my $elm (@childs){
    if($elm->tagName() eq "div"){
        print $elm->innerText(),"\n";
    }
}

もう少し使いやすく！

Webは同じようなページであってもサーバーサイドで一部が欠落させられていたりと、パターンを決め打ちするのはなかなか難しい。その都度判別のソースを書くのもちょっと大変。

なのでいっそのこと、いったんスカラー変数に読み込んでしまっちゃうことに。

スカラー化関数

# ---------------------------------------------------------------------------
# 引数: $element:     HTML::TagParser か HTML::TagParser::Element
#       $flag:        子要素が $flag 未満の場合、innerTextを取得。省略時は取得しない。
sub Eelement2Scalar {
    my ($element, $flag) = @_;
    my $ret = {};

    # HTML::TagParserをそのまま放り込まれた時の処理
    if($element && ref($element) ne 'HTML::TagParser::Element' && $element->can("getElementsByTagName")){
        $element = $element->getElementsByTagName('html');
    }

    # tag
    if($element && $element->can("tagName")){
        my $tag = $element->tagName();
        return $ret if($tag !~ /^\w+/); #scriptタグ内でナマモノ見つけた時の回避処理
        $ret->{'tag'} = $tag;
    }

    # attr
    if($element && $element->can("attributes")){
        my $attr = $element->attributes();
        $ret->{'attr'} = $attr if($attr && scalar(%{$attr}) > 0);
    }

    # childs
    my @childs = ();
    if($element && $element->can("childNodes")){
        @childs = @{$element->childNodes()};
        foreach my $elm (@childs){
            push @{$ret->{'childs'}}, Eelement2Scalar($elm, $flag);
        }
    }

    # text
    if($flag && scalar(@childs)<=$flag && $element && $element->can("innerText")){
        $ret->{'text'} = $element->innerText();
    }
    return $ret;
}

使用例

use HTML::TagParser;
#use LWP::Simple;
use Data::Dumper;{package Data::Dumper;sub qquote{return shift;}}$Data::Dumper::Useperl=1;
use Encode;

my $file = sjis("どっかから拾った.html");
my $doc = load_file($file);

## LWP::Simple を使う例
#my $url = "http://www.abcd.com";
#my $doc = get($url);

#IDを指定してエレメントを取得
my $html = HTML::TagParser->new($doc)->getElementById("content_block_2");

#スカラー化
my $child_scalar = Eelement2Scalar($html, 0);

#ダンプ表示
print Dumper $child_scalar;

#ファイル読み込み用
sub load_file {
    my $file = shift;
    my $ret = "";
    if (-e $file) {
        open (my $FILE, "<$file") or die;
        $ret = do { local $/; <$FILE> };
        close($FILE);
    }
    return $ret;
}

#テスト環境はActivePerlなのでファイル名をSJISに変換
sub sjis {
    my ($val) = shift;
    $val = decode_utf8($val) if (!Encode::is_utf8($val));
    return Encode::encode('ms932', $val);
}

出力結果の一例

{
  'tag' => 'td',
  'childs' => [
                {
                  'childs' => [
                                {
                                  'attr' => {
                                              'class' => 'fsize',
                                              'style' => 'font-size:13px;'
                                            },
                                  'tag' => 'span'
                                }
                              ],
                  'tag' => 'div',
                  'attr' => {
                              'style' => 'text-align:left;'
                            }
                }
              ]
}

おわりに

最近のブラウザのJavascriptは同一ドメイン外からajaxでhtmlを取得してくるのを禁止するようになったので、まだまだこういうHTMLパーサーが活躍する機会もありそうです。
サーバーサイドでやる場合、Node.jsを叩くほうが楽なのかもしれませんが、Perlをまだまだ活躍させたいという方はぜひお試しください。