2008/01/31


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') {
Posted at by




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氏のものばっかだな...
Posted at by




こんな夜中に何やってんだか...
お腹が空いてきたので、モスバーガーのホームページからメニューをスクレイピングしてみる。
別に買いに行く訳じゃないけど...

思った以上に苦戦。苦戦の理由は「HTMLにIDやCLASSが殆んど振られておらず、XPathで抽出出来るパタンがない」こと。しょうがないのでまた無茶ぶりを発揮して、ノード階層をパタンとして使い、最小マッチのノードから欲しいノードへ上昇するというドロ臭いXPathを書いた。
パタンは、td要素を2つ持つtr要素で、かつそのtd要素内にはhref属性に"/menu/"という文字列を含んだa要素、しかもそのa要素は"pdf"という文字列を含んでいない。
結果、CSSセレクタは全く使わなかった(使えなかった?)。これじゃ、Web::Scraperのスライド資料の悪い例のままだ...
ま、取れたので良しとしよう。


mosburger-scraper.pl #!/usr/local/bin/perl

use warnings;
use strict;
use Web::Scraper;
use YAML;
use URI;

my $uri = URI->new("http://www.mos.co.jp/menu/index.html");
my $mosburger = scraper {
    process '//tr[count(td)=2]/td/a[contains(@href,"/menu/") and not(contains(@href,".pdf"))]/img/../../..',
        'menus[]' => scraper {
            process '/tr/td[1]/a',     url => sub {URI->new_abs($_->attr('href'), $uri)->as_string;};
            process '/tr/td[1]/a/img', title => '@alt';
            process '/tr/td[1]/a/img', image => sub {URI->new_abs($_->attr('src'), $uri)->as_string;};
            process '/tr/td[2]/a',
                'perk' => scraper {
                    process '.', url => sub {URI->new_abs($_->attr('href'), $uri)->as_string;};
                    process 'img', title => '@alt';
                };
        };
    result 'menus';
};

my $burgers = $mosburger->scrape($uri);
warn Dump $burgers;

---
- image: http://www.mos.co.jp/menu/img/ph_hamburger18.jpg
  perk:
    title: サウザン野菜バーガー ¥300
    url: http://www.mos.co.jp/menu/hamburger/thousand/
  title: サウザン野菜バーガー
  url: http://www.mos.co.jp/menu/hamburger/thousand/
- image: http://www.mos.co.jp/menu/img/ph_hamburger19.jpg
  perk:
    title: [期間限定 10月中旬まで] シーザーサラダバーガー ¥300
    url: http://www.mos.co.jp/menu/hamburger/seasar/
  title: シーザーサラダバーガー
  url: http://www.mos.co.jp/menu/hamburger/seasar/
...
補足情報(場合によってはセットメニュー)も一緒に取得出来ます。

あー。はらへった。
Posted at by