2008/01/31


Journal of miyagawa (1653)
TEXTや@srcといったショートカット結果に対して任意のフィルタをかませる事が出来るようになったようです。
これまでのように process "span.entry-content", comment => 'TEXT';
と指定していた部分を process "span.entry-content", comment => [ 'TEXT', 'MyFilter' ];
と記述出来るようになったのです。
MyFilterは「Web::Scraper::Filter::MyFilter」というパッケージで定義され、filterプロシージャが呼び出されます。

さっそく、twitterの発言では70%近くが英語のmiyagawaさんの発言をスクレイピングし、エキサイト翻訳で日本語にフィルタするサンプルを作って見ました。
package Web::Scraper::Filter::EnglishToJapanese;
use base qw( Web::Scraper::Filter );
use warnings;
use LWP::UserAgent;
use HTTP::Request::Common qw(POST);

sub filter {
    my($self, $value) = @_;
    my $req = POST( 'http://www.excite.co.jp/world/english/',
        [before => $value, wb_lp => 'ENJA'] );
    my $data = $Web::Scraper::UserAgent->request($req)->content;
    $data =~ s!\x0D|\x0A!!g;
    $data =~ s/^.*?<textarea[^>]*name="after"[^>]*>(.*?)<\/textarea>.*?$/$1/;
    return $data;
}

1;

use URI;
use Web::Scraper;

my $twitter = scraper {
    process 'td.content',
        'comments[]' => scraper {
            process "span.entry-content", comment => [ 'TEXT', 'EnglishToJapanese' ];
        };
    result 'comments';
};
my $comments = $twitter->scrape( URI->new("http://twitter.com/miyagawa/") );
use YAML;
warn Dump $comments;
で、結果
---
- comment: ' ウェブログを作られた http://tinyurl.com/2xldch '
- comment: ' ウェブを出荷します:、:フィルタサポートがある削り器0.21_01。 バージョン番号が言うようにこれがdevリリースであるのに注意してください。'
- comment: ' 見ます。'
- comment: ' ダッシュボード懺悔室、Yellowcard、少年は少女が好きです: 多くの誘惑が今月のSF warfieldで http://www.ticketmaster.com.. を見せます。 ... '
- comment: ' 100のコメント. diggの上のトップページングのためのtakesako、おめでとう、ワオ490、diggs、 http://tinyurl.com/255ht7 '
- comment: ' スクリーンからStreoパート2までNFGを聞くのがあります。 輝かしいアルバム'
- comment: ' @hanekomu、うん、それはしゃぶられます。 そこでは、日本で同じです。 請求先の住所が米国にある状態で、運よく私はcreditcardsを持っています。'
- comment: ' Dashboard Confessionalの新しいアルバム http://www.amazon.com/gp/pr.. を購入した、アマゾン'
- comment: ' より古いリンクの取り逃がすことは一時的であるように思えました。私がfriendfeedされることへのスイッチかJaikuに好きでないので、 http://tinyurl.com/2gq4uj は少し救いました。'
- comment: ' したがって、さえずりの丁付けはいつまでも、行きましたか? そうだとすれば、私は、確実にさえずりを使用するのを止めるつもりです。'
- comment: ' http://subtech.g.hatena.ne... のウェブログを作りました。 Yappo++typester++Plagger++'
- comment: ' @Yappo++'
- comment: ' IT Crowd s02e05を見ます。'
- comment: ' ep1を見ます。'
- comment: ' 12ドルでmonoprice.comからの外でコンポーネントケーブルと結合器を私のPSPビデオに購入しました。 すさまじい値'
- comment: ' 作成されて、playstationのための削り器は、給送 http://tinyurl.com/yqbtjb plagger++ウェブを格納して、発行しています:、:削り器++'
- comment: ' http://feeds.feedburner.com.. に加入しました。'
- comment: ' 私の2週間のabsenseでは、私はWaMu、Master、およびCapitalOneから10の+クレジットカード申し出を受けました。 ため息をついてください。'
- comment: ' ビールを飲みます。'
エキサイト翻訳の部分をスクレイピングするんが筋ちゃうんかいな!というツッコミは無しでお願いします。
Posted at by




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




これでFilterも作りやすくなるのかな...
例えば、はてなブックマークのフィードからShibuya.pmタグが付いてる物のOPMLを作るとか?(自身無さげ)
でもこれ、MIMEパターンをconfig.yamlに上手くめり込ませる方法ってないのかな...
指定する場合、「このURLに対しては変則的なxxxなMIMEで取りたい」って使いたいんだよね。

Index: lib/Plagger/Plugin/Subscription/Feed.pm
===================================================================
--- lib/Plagger/Plugin/Subscription/Feed.pm (revision 1959)
+++ lib/Plagger/Plugin/Subscription/Feed.pm (working copy)
@@ -17,7 +17,6 @@
 sub load {
     my ( $self, $context ) = @_;
 
-    # TODO: Auto-Discovery, XML::Liberal
     my $uri = URI->new( $self->conf->{url} )
       or $context->error("config 'url' is missing");
 
@@ -30,6 +29,20 @@
     my $content = Plagger::Util::load_uri($uri);
     my $feed = eval { Plagger::FeedParser->parse(\$content) };
 
+    if unless($feed) {
+        use HTML::TokeParser;
+        my $parser = HTML::TokeParser->new(\$content);
+        while (my $token = $parser->get_tag("link")) {
+            my $attr = $token->[1];
+            if ($attr->{rel} eq 'alternate'
+                    && ($attr->{type} eq 'application/rss+xml'
+                     or $attr->{type} eq 'application/atom+xml') {
+                $uri = $attr->{href};
+                $feed = eval { Plagger::FeedParser->parse(\$content) };
+                last;
+            }
+        }
+    }
     unless ($feed) {
         $context->log( error => "Error loading feed $uri: $@" );
         return;
Posted at by