Gungho::Inlineを使ってみる

Gungho，悪戦苦闘しています．ちょっと試してみるにはGungho::Inlineを使えばいいんですが，Componentをどうやって組み込めばいいのかがわからなくて試行錯誤の繰り返しです．まだThrottling機能は使えないんですが，簡単なサンプルができたので皆さんの添削を期待してアップします．

サンプルの挙動

防災科学研究所に定期的にアクセスして
HTML::Selector::XPathとHTML::TreeBuilder::XPathを使って最新震源情報を抽出
前回アクセスした時と内容が違っていたら出力

という簡単なものです．

サンプルスクリプト

いつもはこの節でスクリプト全文を載せているのですが，今回は先にトピックスの説明をしてみます．

use warnings;
no warnings qw(redefine);
use FileHandle;    # <- Needs for darwin os

"no warnings"はメソッドの上書きをしているために必要な処理です．"use FileHandle"は本来必要ないはずなんですが，なぜかmac osx 10.4.9(darwin)では必要になります．これがないと，"Can't locate object method "blocking" via package "FileHandle" at /usr/local/lib/perl5/site_perl/5.8.8/POE/Wheel/SocketFactory.pm line 638."というエラーが出て起動しません．

sub Gungho::Provider::Inline::dispatch {
    my ( $self, $c ) = @_;

    if ( $self->callback ) {
        unless ( $self->callback->( $c, $self ) ) {
            $self->callback(undef);
        }
    }

    my $reqs = $self->requests;
    $self->requests( [] );
    $self->dispatch_request( $c, $$reqs[0] );
}

元々のdispatchメソッドはGungho::Inlineの中でこのように定義されています．

sub dispatch {
    my ($self, $c) = @_;
    
    if ($self->callback) {
        unless ($self->callback->($c, $self)) {
            $self->callback(undef);
        }
    }
    
    my $reqs = $self->requests;
    $self->requests([]);
    while (@$reqs) {
        $self->dispatch_request($c, shift @$reqs);
    }
    
    if (! $self->callback && @{$self->requests} == 0) {
        $self->has_requests(0);
        $c->is_running(0);
    }
}

予めリスト形式で与えられたurlをひとつずつチェックして，リストが空になったら止まる仕組みです．今回のスクリプトはひとつのurlを繰り返しチェックするので止まらないように変更してみました．

sub provider {
    my ( $c, $p ) = @_;
    my $url = 'http://www.hinet.bosai.go.jp';
    $p->add_request(
        $c->prepare_request( Gungho::Request->new( GET => $url ) ) );
    my $module = 'Throttle::Simple';
    my $pkg = $c->load_gungho_module( $module, 'Component' );
    $pkg->inject_base($c);
    $c->prepare_throttler( max_items => 1, interval => 20 );
    1;
}

ここがおかしな所です．"inject_base"を使えばComponentを読み込むと思っていたんですが，そんなに簡単ではなかったようで，Throttle::Simpleの読み込みはまだできていません．どうすればよいのか，識者のコメントをお待ちしています（w

sub handler {
    my ( $req, $res ) = @_;
    my $content_type = $res->headers->header('Content-Type');
    my $enc          = Encode::find_encoding($1)
      if ( $content_type =~ /charset=([A-Za-z0-9_\-]+)/io );
    my $tree = HTML::TreeBuilder::XPath->new;
    $tree->parse( $enc->decode( $res->content ) );
    $tree->eof;

小飼さんの記事にヒントを得て作ってみました．元サイトはEUC-JPを使っているのですが，それをハードコードするのがめんどくさかったのです．

    my @nodes =
      $tree->findnodes(
        HTML::Selector::XPath->new('td.bgltsub+td.bgwhite')->to_xpath );
    my @new = map { $_->content->[0] } @nodes;
    ...
}

CSS Selectorを使うアイディアはnaoyaさんのPerl で CSS セレクタを参考にしました．最新震源情報のテーブルの所が'td.bgltsub+td.bgwhite'で抜き出せるのに気がついたので，それを利用したわけです．

サンプル全文

作ったスクリプトは以下のようになります．まだまだブラッシュアップしないと使い物にならないですが，とりあえずここまで作ったということで曝してみました．

#!/usr/local/bin/perl

use strict;
use warnings;
no warnings qw(redefine);
use FileHandle;    # <- Needs for darwin os
use Gungho::Inline;
use HTML::Selector::XPath;
use HTML::TreeBuilder::XPath;
use Encode;

my $old;

## For redefine
#

sub Gungho::Provider::Inline::dispatch {
    my ( $self, $c ) = @_;

    if ( $self->callback ) {
        unless ( $self->callback->( $c, $self ) ) {
            $self->callback(undef);
        }
    }

    my $reqs = $self->requests;
    $self->requests( [] );
    $self->dispatch_request( $c, $$reqs[0] );
}

#
## End of Redefine

Gungho::Inline->new(
    {
        provider => \&provider,
        handler  => \&handler,
    }
)->run();

sub provider {
    my ( $c, $p ) = @_;
    my $url = 'http://www.hinet.bosai.go.jp';
    $p->add_request(
        $c->prepare_request( Gungho::Request->new( GET => $url ) ) );
    my $module = 'Throttle::Simple';
    my $pkg = $c->load_gungho_module( $module, 'Component' );
    $pkg->inject_base($c);
    $c->prepare_throttler( max_items => 1, interval => 20 );
    1;
}

sub handler {
    my ( $req, $res ) = @_;
    my $content_type = $res->headers->header('Content-Type');
    my $enc          = Encode::find_encoding($1)
      if ( $content_type =~ /charset=([A-Za-z0-9_\-]+)/io );
    my $tree = HTML::TreeBuilder::XPath->new;
    $tree->parse( $enc->decode( $res->content ) );
    $tree->eof;

    my @nodes =
      $tree->findnodes(
        HTML::Selector::XPath->new('td.bgltsub+td.bgwhite')->to_xpath );
    my @new = map { $_->content->[0] } @nodes;
    if ( ( $$old[1] ne $new[1] ) ) {
        printf "M%s Earthquake hits %s(%s,%s) at %s\n", $new[5], $new[0], $new[2], $new[3], $new[1];
    }
    $old = \@new;
}