asin:4873111064
Perl & XML
Erik T Ray / Jason McIntosh
財井一彰訳
[原著:Perl & XML]

一昔前のentryが、はてぶで引っかかっていたので。

URIオブジェクトは直接文字列として扱える

まずはこれ。何とprintされるでしょう?

use 5.010;
use strict;
use warnings;
use LWP::UserAgent;
use URI;

my $base =
  'http://japan.cnet.com/news/business/story/0,3800104746,20416479-0,00.htm';

say URI->new_abs('/news/service/', $base);
say LWP::UserAgent->new();

そうです。絶対URLそのものである文字列。LWP::UserAgent=HASH(0xdeadbeef)みたいな「これはオブジェクトである」を示す文字列ではなくて。URIは、printやsayのように文字列を要求する関数から呼び出した場合、自動で文字列化を行ってくれるモジュールなのです。これを使わない手はありません。

あと、元記事ではURIモジュールを直接useせず、LWPでひとまとめに呼んでいますが、これは明示的にuseした方がよいでしょう。あとでこの部分をLWP::UserAgentなりLWP::Simpleなりに書き換える際も楽ですし。

HTMLの書き換えは正規表現ではなくDOMで

もう一つ気になったのは、元記事では正規表現でHTMLを処理していたこと。これだとタグ外の、地の文に現れるhref=やsrc=まで書き換えてしまいます。

以下はXML::LibXMLで処理した例。JavaScriptでDOMを扱うときと要領は同じなので、かなり楽です。ただしブラウザーとは異なり、XML::LibXMLというよりlibxml2がエラーにかなりうるさいので、$SIG{__WARN__}を使って黙らせています。

use 5.010;
use strict;
use warnings;
use LWP::UserAgent;
use XML::LibXML;
use URI;

my $link =
  'http://japan.cnet.com/news/business/story/0,3800104746,20416479-0,00.htm';

my $ua  = LWP::UserAgent->new;
my $res = $ua->get($link);
die $res->status_line unless $res->is_success;
say fixlinx( $res->content, $link );

sub fixlinx {
    my ( $html, $base ) = @_;
    local $SIG{__WARN__} = sub { }; # to keep LibXML quiet
    my $parser = XML::LibXML->new(
        suppress_errors   => 1,
        suppress_warnings => 1,
        recover           => 2,
    );
    my $dom = $parser->parse_html_string($html);
    for my $node ( $dom->getElementsByTagName('a') ) {
        next unless my $href = $node->getAttribute('href');
        $node->setAttribute( 'href' => URI->new_abs( $href, $base ) );
    }
    for my $node ( $dom->getElementsByTagName('img') ) {
        next unless my $src = $node->getAttribute('src');
        $node->setAttribute( 'src' => URI->new_abs( $src, $base ) );
    }

    return $dom->toStringHTML;
}

Enjoy!

Dan the Perl Monger