2008/01/31


otsune nowa - Publish::GooBookmarkを書くためにHTMLソースとか見てるけど」を見ると、otsuneさんが既に書きかけているかも知れないけど...
私の適当なので良ければ...
package Plagger::Plugin::Publish::GooBookmark;
use strict;
use base qw( Plagger::Plugin );

use Encode;
use Time::HiRes qw(sleep);
use URI;
use Plagger::Mechanize;

sub register {
    my($self, $context) = @_;
    $context->register_hook(
        $self,
        'publish.entry' => \&add_entry,
        'publish.init'  => \&initialize,
    );
}

sub initialize {
    my $self = shift;
    unless ($self->{mech}) {
        my $mech = Plagger::Mechanize->new;
        $mech->agent_alias('Windows IE 6');
        $mech->quiet(1);
        $self->{mech} = $mech;
    }
    $self->login_goo_bookmark;
}


sub add_entry {
    my ($self, $context, $args) = @_;

    my @tags = @{$args->{entry}->tags};
    my $tag_string = @tags ? join(',', @tags) : '';

    my $summary;
    if ($self->conf->{post_body}) {
        $summary = encode('utf-8', $args->{entry}->body_text); # xxx should be summary
    }

    my $uri = URI->new('http://bookmark.goo.ne.jp/add/detail/');
    $uri->query_form(
        url  => $args->{entry}->link,
    );

    my $res = eval { $self->{mech}->get($uri->as_string) };
    if ($res && $res->is_success) {
        eval {
            my $button = $self->{mech}->form_name('boomarkEdit')->find_input('addDetail') || 'editEdit';
            $self->{mech}->submit_form(
                form_name => 'boomarkEdit',
                fields => {
                    title       => encode('utf-8', $args->{entry}->title),
                    keywordlist => encode('utf-8', $tag_string),
                    comment     => $summary,
                    publicno    => 0,
                    point       => $self->conf->{rate} || 1,
                },
                button => $button
            )
        };
        if ($@) {
           $context->log(info => "can't submit: " . $@);
        } else {
            $context->log(info => "Post entry success.");
        }
    } else {
       $context->log(info => "fail to bookmark HTTP Status: " . $res->code);
    }
 
    my $sleeping_time = $self->conf->{interval} || 3;
    $context->log(info => "sleep $sleeping_time.");
    sleep( $sleeping_time );
}

sub login_goo_bookmark {
    my $self = shift;
    unless ($self->conf->{username} && $self->conf->{password}) {
        Plagger->context->log(error => 'set your username and password before login.');
    }
    my $res = $self->{mech}->get('https://login.mail.goo.ne.jp/certify-cgi/login.cgi?site=bookmark.goo.ne.jp');
    $self->{mech}->submit_form(
        form_name => 'f1',
        fields => {
            uname => $self->conf->{username},
            pass  => $self->conf->{password},
        },
    );
}

1;

__END__

=head1 NAME

Plagger::Plugin::Publish::GooBookmark - Post to goo bookmark automatically

=head1 SYNOPSIS

  - module: Publish::GooBookmark
    config:
      username: your-username
      password: your-password
      interval: 2
      post_body: 1
      #rate: 3

=head1 DESCRIPTION

This plugin automatically posts feed updates to goo bookmark
L<http://bookmark.goo.ne.jp/>. It supports automatic tagging as well. It
might be handy for synchronizing delicious feeds into goo bookmark.

=head1 AUTHOR

Yasuhiro Matsumoto

=head1 SEE ALSO

L<Plagger>, L<Plagger::Plugin::Publish::LivedoorClip>, L<Plagger::Mechanize>

=cut
レート(GooBookmarkでいうpoint)を設定出来るようにした。
それと、Publish::LivedoorClipで重複登録の際に、エラーが出ていたので、パッチを書いた。こちらもレートを変えられるようにした。
Index: LivedoorClip.pm
===================================================================
--- LivedoorClip.pm (revision 1976)
+++ LivedoorClip.pm (working copy)
@@ -46,12 +46,17 @@
         tags  => encode('utf-8', $tag_string),
         title => encode('utf-8', $args->{entry}->title),
         notes => $summary,
+        rate  => $self->conf->{rate} || 1,
     );
 
     my $add_url = $uri->as_string;
     my $res = eval { $self->{mech}->get($add_url) };
     if ($res && $res->is_success) {
-        eval { $self->{mech}->submit_form(form_name => 'clip') };
+        eval {
+            my $form_name = 'clip';
+            $form_name = 'edit_form' if $self->{mech}->form_name($form_name);
+            $self->{mech}->submit_form(form_name => $form_name)
+        };
         if ($@) {
            $context->log(info => "can't submit: " . $args->{entry}->link);
         } else {
otsuneさんと、Publish::LivedoorClipのAUTHORさんがOKならば、それぞれCodeReposに上げる予定です。

しかしまぁ、SBM同期用YAMLがエライ事になってきた。
global:
  assets_path: /home/user/plagger/assets/
  timezone: Asia/Tokyo
  log:
    level: info

plugins:
  - module: Subscription::Config
    config:
      feed:
        - http://b.hatena.ne.jp/[hatena user]/atomfeed

  - module: Filter::AtomLinkRelated

  - module: Filter::Rule
    rule:
      module: Deduped
      path: /tmp/syncsbm.db

  - module: Publish::Delicious
    config:
      username: xxxx
      password: xxxx
      interval: 2
      post_body: 1
  - module: Publish::LivedoorClip
    config:
      livedoor_id: xxxx
      password: xxxx
      interval: 2
      post_body: 1
      rate: 3
  - module: Publish::Buzzurl
    config:
      usermail: xxxx
      password: xxxx
      interval: 2
      post_body: 1
  - module: Publish::GooBookmark
    config:
      username: xxxx
      password: xxxx
      interval: 2
      post_body: 1
      rate: 3
追記1
otsuneさんのいうWWW::Mechanizeで書いてしまった...
追記2
otsuneさんからツッコミの有難い頂いたので、修正後にCodeReposにアップします。otsuneさんありがとうございました。
追記3
さらにotsuneさんからツッコミの有難い頂いたので、今後は慎重に行きます。苦笑
Posted at by




Web::Scraperの0.15がリリースされたので、色々試してみてます。
ほんのりと変わった所を調べてみます。

UserAgentが置き換えられるようになった

uaのスコープを変えて頂けたので、先日の「WWW::MechanizeとWeb::Scraperでtwitterのfriendsを全部取ってみる」でやった以下の様な無理やりなUA置き換えでなく undef &Web::Scraper::__ua;
*Web::Scraper::__ua = sub {
    $mech;
};
以下のようにキレイな置き換えが出来るようになります。 $Web::Scraper::UserAgent = $mech;
スコープもourになってますから、別のパッケージ作るときにも便利かもしれませんね。


ショートカットとしてRAWが使えるようになった

これはインラインのjavascriptをそのままスクレイピングするのに使えますね。
#!/usr/bin/perl

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

my $my_script = scraper {
    process '//script[2]', 'code' => 'raw';
    result 'code';
};
my $item = $my_script->scrape( URI->new("http://mattn.kaoriya.net") );
warn Dump $item;
この例では、はてなスターのトークン設定部が取得出来ます。 --- |-
<!--
Hatena.Star.Token = '43aa5d7954c8fc062faae4eaaa864913599c277b';
-->
※htmlというショートカットでも使えます。


相対URLから絶対URLを自前で生成しなくてもよくなった

お腹が空いてきたのでWeb::Scraperでモスバーガーのメニューをスクレイピング」でやったように、今までは process '.', url => sub {URI->new_abs($_->attr('href'), $uri)->as_string;};
というコードが必要でしたが、「@」による属性参照でリンクエレメントであるようならば、自動的に絶対URLを生成してくれます。
上のようなコードも process '.', url => '@href';
と楽になりますね。
以上が私が0.13と0.15のdiffをざーーーーと見た感じの変更点です。


おまけ

今日はこれに付け加え、一つtipsを...
Web::ScraperでCISCO RECORDSをスクレーピングより
たとえば <li><span>1</span>Track 1</li>
というHTMLから"Track1"だけを抽出しようにも process 'li', 'title' => 'TEXT';
だと 1Track1 なんて結果になるのでそれを回避するために process 'li', 'title' => sub {
    my $elem = shift;
    $elem->find_by_tag_name('span')->delete;
    return $elem->as_text;
};
なんてことをしてるのですが、もっといい方法があるはず。
treeを壊さずやるとすれば、TextNodeを参照するのがいいかと思います。
例えば、XPathのnode()を使い、番号指定で取得します。だた現状のWeb::ScraperではTextNodeはショートカットで参照出来ませんので、以下のようにstring_valueを返すように手を加えると上手く行きます。
※相対URLの修正も含んでいます。
--- cisco_scraper.pl    Tue Sep 18 13:30:20 2007
+++ cisco_scraper2.pl   Tue Sep 18 14:12:49 2007
@@ -14,9 +14,7 @@
 
 $scraper{'link'} = scraper {
     process 'a', 'name' => 'TEXT';
-    process 'a', 'uri'  => sub {
-        return URI->new_abs( $_->attr('href'), $uri )->as_string;
-    };
+    process 'a', 'uri'  => '@href';
     result qw/name uri/;
 };
 
@@ -27,23 +25,15 @@
 };
 
 $scraper{'track'} = scraper {
-    process 'li', 'title' => sub {
-        my $elem = shift;
-        $elem->find_by_tag_name('span')->delete;
-        return $elem->as_text;
-    };
-    process 'li>a', 'uri' => sub {
-        return URI->new_abs( $_->attr('href'), $uri )->as_string;
-    };
+   process '//li/node()[4]', 'title' => sub {$_->string_value;};
+    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'  => sub {
-        return URI->new_abs( $_->attr('src'), $uri )->as_string;
-    };
+    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};
@@ -53,12 +43,7 @@
     process 'td[headers="de_sheet"]',   'sheet'   => 'TEXT';
     process 'td[headers="de_arrival"]', 'arrival' => 'TEXT';
     process 'td[headers="de_nomber"]',  'number'  => 'TEXT';
-    process 'p.de_star',                'star'    => sub {
-        my $elem = shift;
-        $elem->find_by_tag_name('span')->delete;
-        return $elem->as_text;
-
-    };
+    process '//p[@class="de_star"]/node()[2]', 'star' => sub {$_->string_value;};
     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/;
このTextNode参照の需要があるならショートカットでも良いと思うんですが、いまんところ無さそうですね。

追記
otsune氏より「diff -uじゃないと...」という指摘で修正。
Posted at by




こういう使い方もあるね。
で、どうする...って訳でもないけど
※そういうの、「使い道ない」っていうんだよね。そうだよね。
#!/usr/bin/perl

use strict;
use warnings;

use Web::Scraper;
use URI;
use YAML;

my $airlines_accident_scraper = scraper {
  process '//div[@class="entry-content"]//table/tr',
    'airlines[]' => scraper {
      process '//td[1]', title => 'TEXT';
      process '//td[2]', last_accident => 'TEXT';
      process '//td[3]', flight_count => 'TEXT';
      process '//td[4]', death_accident => 'TEXT';
      process '//td[5]', death_rate => 'TEXT';
      process '//td[6]', accident_incidence => 'TEXT';
      process '//td[7]', total_rank => 'TEXT';
    };
  result 'airlines';
};

my $list = $airlines_accident_scraper->scrape(URI->new('http://www.manji.com/jp/2007/08/post_22.html'));
use YAML;
warn Dump $list;
リストは、マスコミが報じない危険な航空会社リストから拝借。

余談ですが...
Web::Scraper 0.16あたりから、@参照するとstringでなく、URIか返ってくるようになってるので、「認証付きのページで@srcを拾い上げて、認証無しでは参照出来ない画像を落とす」なんて事に使えるようになったみたいです。
Posted at by