WebService::LivedoorReader ちょっとだけ進めた

git によって僅かばかりやる気がでたので、WebService::LivedoorReader をちょっとだけ進めた。
とはいえ、前回作っていた状態とほぼ変化はなく、機能的にはむしろ退化したりしてる。

コンストラクタは内部にて WWW::Mechanize を構築する程度で、今後何をパラメータにするかを考えたいが、他の機能を実装するまで後回しにする予定。Moose 化も考えたものの、Moose の勉強に相当かかりそうな気がしたので、とりあえずハッシュベースで。

sub new {
    my ($class, $param) = @_;
    my $self = bless {
        mech => WWW::Mechanize->new,
        user => $param->{username},
        pass => $param->{password},
    }, $class;
    $self;
}

LDR の API の多くは、POST するパラメータとして ApiKey を要求する。この ApiKey は LDR のログイン時に設定されるクッキー中にあるが、これを取得するあたりは Plagger で使われているコードをほぼ拝借してる。(コアに含まれていない)WWW::Mechanize を使っているのは、単にぼくがメンドくさかっただけ。エラー処理はもっとやらないといけないんだけど、当面は機能側のコーディング進めたい。

sub apikey {
    my $self = shift;
    $self->{apikey} and return $self->{apikey};

    $self->{mech}->get( $LOGIN_URL );
    $self->{mech}->submit_form(
        form_name => 'loginForm',
        fields => {
            livedoor_id => $self->{user},
            password    => $self->{pass},
        }
    );
    $self->{mech}->cookie_jar->scan(
        sub {
            my ($key, $val) = @_[1, 2];
            $key =~ /reader_sid$/ or return;
            $self->{apikey} = $val;
        }
    );
    $self->{apikey};
}

LDR の各 API はそれぞれが URL を持っていて、その URL に POST することで JSON 形式のデータを返すように一貫されている。というわけなので、リクエスト・レスポンス処理の共通部分と思われるところを括り出してみた。

sub _request {
    my ($self, $api, $param) = @_;
    ($api =~ m|^/|) or confess "api must start with '/'";

    my $res = $self->{mech}->post( $API_URL . $api => {
        ApiKey => $self->apikey,
        $param? %$param : (),
    });
    from_json( $res->decoded_content );
}

これを使って、今日は pin 関係の API を実装。例えば、pin を立てる API はこんな風になる。

sub add_pin {
    my ($self, $url, $title)  = @_;
    my $res = $self->_request( '/pin/add' => {
        link => $url,
        $title? ( title => $title ) : (),
    });
    $res->{isSuccess};
}

/api/pin/add のように、何か意味のあるもの(例えば URL の一覧など)を返さない API は、isSuccess と ErrorCode をキーとして持つ JSON データを返す。そのため、メソッドからはとりあえず成功かどうかを返すようにしてみた。

pin を立てた全てのページ情報を取得する API として /api/pin/all があるが、この API は link、created_on、title の 3 つの情報をハッシュとし、その配列を JSON で返す。とりあえずそのまま呼出元に返すだけで良いかとか思ったので、これだけのメソッドになった。

sub all_pin {
    my $self = shift;
    $self->_request( '/pin/all' );
}

今回はわりとマジメにテストを書いたが、なにがなにやらだんだん分からなくなってきた。これ、pin 関係のテスト。

use strict;
use warnings;
use Test::More;
use WebService::LivedoorReader;
use List::MoreUtils qw(any none);
use Scalar::Util qw(looks_like_number);
use Account;

my $account = ac_info( 'account.yaml' );
my $ldr = WebService::LivedoorReader->new( $account->{ldr} );
isa_ok( $ldr, 'WebService::LivedoorReader' );
can_ok( $ldr, (qw(all_pin add_pin count_pin remove_pin clear_pin)));

my $yahoo = 'http://www.yahoo.co.jp';

$ldr->remove_pin( $yahoo );

my $count = $ldr->count_pin;
ok( looks_like_number( $count ), 'number of pins' );

ok( $ldr->add_pin( $yahoo => 'test' ), 'add pin' );
is( $count + 1, $ldr->count_pin, 'number of pins after addition' );
my $pins = $ldr->all_pin;
is( ref $pins => 'ARRAY', 'retrieves pins' );

ok( any( sub {
               $_->{link}  eq $yahoo
           and $_->{title} eq 'test' 
    }, @$pins), 'pins contain newly added pin' );


ok( $ldr->remove_pin( $yahoo ), 'remove pin' );

$pins = $ldr->all_pin;
ok( none ( sub {
               $_->{link}  eq $yahoo
           and $_->{title} eq 'test' 
    }, @$pins), 'pins do not contain newly added pin' );

done_testing;