Big Sky

XML::Simpleだと格納される結果が決まっており、例えば

<statuses>
    <status>
        <id>4773580</id>
        <text>kazuhoさんがやってくれました！</text>
        <user>
            <screen_name>mattn</screen_name>
        </user>
    </status>
    <status>
        <id>4773581</id>
        <text>今日のnickは○○提供です。</text>
        <user>
            <screen_name>kazuho</screen_name>
        </user>
    </status>
</statuses>

こんなXMLを以下の様な形にしたい場合がある場合に少し不便だったりします。

---
id: 4773580
text: kazuhoさんがやってくれました！
screen_name: mattn
---
id: 4773581
text: 今日のnickは○○提供です。
screen_name: kazuho

XML::Simpleを使うと、arrayノード一つにID要素があると勝手にノード扱いになったり、不必要なノードへのアクセスが必要になったりします。以下XML::Simpleのパース結果

---
status:
  4773580:
    text: kazuhoさんがやってくれました！
    user:
      screen_name: mattn
  4773581:
    text: 今日のnickは○○提供です。
    user:
      screen_name: kazuho

こんな場合にはXML::CuteQueriesを使うと便利です。

Paul Miller / XML-CuteQueries - search.cpan.org

A cute little query language for converting XML to Perl

http://search.cpan.org/dist/XML-CuteQueries/

上の例であれば以下のコードで望み通りの形式でパース出来てしまいます。

use strict;
use warnings;
use LWP::Simple;
use XML::CuteQueries;

my $cq = XML::CuteQueries->new;
$cq->parse(get "http://api.wassr.jp/statuses/public_timeline.xml");
my @statuses   = $cq->cute_query("/statuses/*" => {'*' => '', 'user/*' => ''});
use YAML;
warn Dump @statuses;

PODを見ていただければ分かりますが、XPathでクエリ式を書きそれに対するデータシェイプを指定します。例であれば"/statuses/*"にあるノードすべて"*"はデータシェイプのルートに、また"/statuses/*"にある"user/*"(user内の全て)もデータシェイプ内のルートに置くという指定になります。
これ、XML版のWeb::Scraperって感じですかね。便利だわー。

またまた知らなかった。勉強不足。
例えば

<div class="foo">
    <p>
        <span class="test1">title1</span>
    </p>
    <ul>
        <li>list1</li>
        <li>list2</li>
        <li>list3</li>
    </ul>
</div>

<div class="foo">
    <div>
        <span class="test1">title2</span>
    </div>
    <ul>
        <li>list1</li>
        <li>list2</li>
        <li>list3</li>
    </ul>
</div>

<div class="foo">
    <div>
        <span class="test2">title3</span>
    </div>
    <ul>
        <li>list1</li>
        <li>list2</li>
        <li>list3</li>
    </ul>
</div>

こんなHTMLで

• class属性"foo"を持つdiv
• その孫にclass属性"test1"を持つspan
• 上の条件下にある上記divの孫にあるli

を検索したい場合

//div[@class="foo"]//span[@class="test1"]/../..//li

こう書いてたんですが、これだとliの階層が深い場合に".."を書く個数が限定されてしまっていました。
で、今日知ったのですが、expr部には「@xxx="yyy"」といったexprだけでなくパスも書けるのを知った。

//div[@class="foo" and .//span[@class="test1"]]//li

これだとcurrent-contextとして

• class属性"foo"を持つdiv

を保ったままliを検索出来る訳。勉強不足だな。
上の例だとtitle1の下のliと、title2の下のliがマッチする。

ところで皆さんはXPathをテストしたい場合、何を使ってますか？
私はjAutoPagerizeを使っています。jAutoPagerizeはcho45氏作のAutoPagerizeクローンで、私は本家を使わずこちらを使っています。
なぜこれを使っているかというと、jAutoPagerize本来の機能も良いのですがXPathGeneratorが付いているからです。
jAutoPagerizeをインストールすると

というアイコンが画面右上に出るのですが、これをクリックすると

といった形でXPathの入力画面が現れます。ここにXPathを書いて"TAB"キー等でフォーカスを外すと

と赤くハイライトされるのです。視覚的にも分かりやすいですね。他直接ノードからXPathを取得するInspectボタンもクラス名を知るのに使えます。
また、AutoPagerize対応でないページでアイコンが出ていなくても

XPathGenerator

こんなブックマークレットさえ用意しておけば、何時でもXPathGeneratorを表示出来るようになります。

XPathGeneratorかわいいよXPathGenerator

Web::Scraper 0.15とcisco_scraper.pl

問題が一つ。添削してくださったパッチだと

process '//li/node()[4]', 'title' => sub {$_->string_value;};

となっているのですが、4番目とは限らないんです。
たとえば、
http://www.cisco-records.co.jp/html/item/004/010/item393180.html
は何曲か試聴サンプルがないために、この処理だと取得できないです。

おろろ...
これはtext()でTextNodeを参照するしかないですね。
ただ、text()では改行等のゴミまで拾ってしまうので、以下のようにnormalize-space()で空文字ノードを省いています。
もしかすると、node()[2]も同じように修正した方がいいかもしれませんね。

#!/usr/bin/perl

use strict;
use warnings;

use Web::Scraper;
use URI;
use YAML;
use Data::Dumper;

my $uri = shift;

my %scraper;

$scraper{'link'} = scraper {
    process 'a', 'name' => 'TEXT';
    process 'a', 'uri'  => '@href';
    result qw/name uri/;
};

$scraper{'genre'} = scraper {
    process '//a[1]', 'top'   => $scraper{link};
    process '//a[2]', 'style' => $scraper{link};
    result qw/top style/;
};

$scraper{'track'} = scraper {
    process '//li/text()[normalize-space(.)!=""]', 'title' => sub {
        my $s = $_->as_XML;
        $s =~ s/\s+$//;
        return $s;
    };
    process 'li>a', 'uri' => '@href';
    result qw/title uri/;
};

$scraper{'item'} = scraper {
    process 'td.de_title',      'title'  => 'TEXT';
    process 'td.de_artist',     'artist' => 'TEXT';
    process 'td.nm_jacket>img', 'image'  => '@src';
    process 'td.de_price',              'price'   => 'TEXT';
    process 'td.de_label>a',            'label'   => $scraper{link};
    process 'td.de_genre',              'genre'   => $scraper{genre};
    process 'td[headers="de_format"]',  'format'  => 'TEXT';
    process 'td[headers="de_release"]', 'release' => 'TEXT';
    process 'td[headers="de_country"]', 'country' => 'TEXT';
    process 'td[headers="de_sheet"]',   'sheet'   => 'TEXT';
    process 'td[headers="de_arrival"]', 'arrival' => 'TEXT';
    process 'td[headers="de_nomber"]',  'number'  => 'TEXT';
    process '//p[@class="de_star"]/node()[2]', 'star' => 'TEXT';
    process 'ul[id="de_sound"]>li', 'tracks[]' => $scraper{track};
    result
        qw/title artist image price label genre format release release country sheet arrival number star tracks/;
};

my $item = $scraper{'item'}->scrape( URI->new($uri) );
warn Dump $item;

あと、ブックマークコメントで

コールバック渡しだと相対URLの展開がされないのは僕だけ？

との事ですが...少し調べてみた所Web::Scraper側でパッチが必要かもしれません。
以下svn/trunk(rev2351)からの差分です。

Index: lib/Web/Scraper.pm
===================================================================
--- lib/Web/Scraper.pm  (revision 2351)
+++ lib/Web/Scraper.pm  (working copy)
@@ -152,12 +152,12 @@
         local $_ = $node;
         return $val->($node);
     } elsif (blessed($val) && $val->isa('Web::Scraper')) {
-        return $val->scrape($node);
+        return $val->scrape($node, $uri);
     } elsif ($val =~ s!^@!!) {
         my $value =  $node->attr($val);
         if ($uri && is_link_element($node, $val)) {
             require URI;
-            $value = URI->new_abs($value, $uri);
+            $value = URI->new_abs($value, $uri)->as_string;
         }
         return $value;
     } elsif (lc($val) eq 'content' || lc($val) eq 'text') {

twitterのAPIでfriendsが100件しか取れなくなって久しいですが...
WWW::MechanizeとXPathでtwitterの全friendsを取得するサンプル作ってみました。 あまりやり過ぎると、オフィシャル側に怒られそうな気もしますが...
後の使い方は、適当で...

#!/usr/local/bin/perl

use warnings;
use strict;
use LWP::Simple;
use XML::Simple;
use WWW::Mechanize;
use HTML::TreeBuilder::XPath;
use HTML::Selector::XPath qw(selector_to_xpath);
use Data::Dumper;

my $username = 'your_username';
my $password = 'your_password';

my $m = WWW::Mechanize->new(timeout => 10);
$m->get('http://twitter.com/login');
$m->submit_form(
    form_number => 1,
    fields    => {
        username_or_email  => $username,
        password           => $password,
    },
    button    => 'commit',
);

my $xpath = selector_to_xpath('tr.vcard');
my @friends;

my $num_page = 1;
while (1) {
    my $res = $m->get("http://twitter.com/friends/?page=$num_page");
    my $encoding = $res->header('Content-Encoding');
    my $content = $res->content;
    $content = Compress::Zlib::memGunzip($content) if $encoding =~ /gzip/i;
    $content = Compress::Zlib::uncompress($content) if $encoding =~ /deflate/i;

    my $tree = HTML::TreeBuilder::XPath->new;
    $tree->parse($content);
    $tree->eof;
    my @nodes = $tree->findnodes($xpath);
    for my $tr (@nodes) {
        push(@friends, {
                nick => $tr->findnodes('td/strong/a')->[0]->as_text,
                image => $tr->findvalue('td[@class="thumb"]//img/@src')->as_string,
                name => $tr->findvalue('td[@class="thumb"]//img/@alt')->as_string,
                description => $tr->findvalue('td/strong/a/@title')->as_string,
                url => $tr->findvalue('td[@class="thumb"]/a/@href')->as_string,
            });
    }
    $tree->delete;
    @nodes or last;
    $num_page++;
}

print Dumper @friends;

最近遊んでる物、ほとんどmiyagawa氏のものばっかだな...