Hi-net mania

http://d.hatena.ne.jp/lestrrat/20070421#1177116589で

Gunghoのコンポーネントはオブジェクト作成時に設定されます。なので自分でinject_baseする必要はないのです。

と教えてもらったので，ちょっと考え直してみました．
前回のスクリプトで，

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

というところをいじればいいわけです．つまり，

Gungho::Inline->new(
    {
        provider   => \&provider,
        handler    => \&handler,
        throttle   => { simple => { max_items => 10, interval => 300 } },
        components => ['Throttle::Simple'],
    }
)->run();

ということ．この設定であれば，300秒間に最大10回までしかアクセスしないことになります．うまく動いてる（っぽい）ことを確認しました．で，こっちにThrottleの設定が入るので，先のスクリプトのproviderメソッドも簡単になります．

sub provider {
    my ( $c, $p ) = @_;
    my $url = 'http://www.hinet.bosai.go.jp';
    $p->add_request(
        $c->prepare_request( Gungho::Request->new( GET => $url ) ) );
    1;
}

これで思った通りに動くようになったみたいなので，早速Twitterにupdateするようにしてみました．本当はPoCoCl::Twitterを使うべきなんですが，すぐに動かしてみたかったので，Net::Twitterで動かしています．

スクリプト

実際に使ってみたスクリプトは以下のようになります．

#!/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 Net::Twitter;
use Encode qw(_utf8_off);
use utf8;

my $old;
my $twit = Net::Twitter->new( username => "hinetmania", password => "password" );

## 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,
        throttle   => { simple => { max_items => 10, interval => 300 } },
        components => ['Throttle::Simple'],
    }
)->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 ) ) );
    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 ) or ( $$old[1] ne $new[1] ) ) {
        my $str =
          sprintf "%sにM%sの地震が%s(%s,%s)で発生しました",
          $new[1], $new[5], $new[0], $new[2], $new[3];
        _utf8_off($str);
        $twit->update($str);
    }
    $old = \@new;
    1;
}

相変わらずエラー処理が何も入っていません．スクリプトが異常終了していても，それを調べる手段がないといういい加減さ．何か思いついたら機能拡張をしていきたいと思っています．このスクリプトの出力はhttp://twitter.com/hinetmaniaで確認することができます．それにしても，動かしてみたらすぐに地震があって，ちょっと怖かったりします．