hinetmaniaコード修正

http://d.hatena.ne.jp/lestrrat/20070524#1179968337でほめてもらえた！ので，気を良くしてコードをさらに修正，動かし始めました．設定部分はconfig.ymlとして切り出し，アプリケーション固有の部分を分離しています．

スクリプト

Gungho周りのスクリプトはこんな感じになりました．条件分けするhost名とかpath名とかで予めインタフェースを用意しておくとさらに美しくなるかな？host名をハードコードしてるのがちょっと美しくないです．Facade使ったらってコメントに気づくのが遅かったので，それはまた後でやります．

#!/usr/local/bin/perl

use strict;
use warnings;
use FileHandle;
use Gungho::Inline;
use QuakeInfo;

Gungho::Inline->run(
    'config.yml',
    {
        provider => \&provider,
        handler  => \&handler,
    }
);

sub provider {
    my ( $p, $c ) = @_;

    $p->add_request( $c->prepare_request( QuakeInfo->Say() ) );
    1;
}

sub handler {
    my ( $h, $c, $req, $res ) = @_;

    return 1 if ( !$res->is_success );

    my $code = {
        'www.hinet.bosai.go.jp' => sub {
            QuakeInfo->Compare($res);
        },
        'twitter.com' => sub {
            QuakeInfo->Check();
        },
    }->{ URI->new( $req->uri )->host };
    $code->();
    1;
}

上のスクリプトが呼び出しているアプリケーション固有の部分をQuakeInfoというモジュールにしてまとめてみました．

package QuakeInfo;
use strict;
use warnings;
use base qw(Class::Data::Inheritable);
use Gungho::Request;
use utf8;
use URI;
use Web::Scraper;
use Encode qw(find_encoding _utf8_off);

QuakeInfo->mk_classdata('Data');
QuakeInfo->mk_classdata( State => 0 );
QuakeInfo->mk_classdata(
    Scraper => scraper {
        process 'td.bgltsub+td.bgwhite', 'descr[]' => 'text';
        result 'descr';
    }
);

sub Compare {
    my ( $class, $res ) = @_;
    my $content_type = $res->headers->header('Content-Type');
    my $enc          = find_encoding($1)
      if ( $content_type =~ /charset=([A-Za-z0-9_\-]+)/io );
    my $html = $enc->decode( $res->content );
    my $new  = $class->Scraper->scrape($html);
    my $old  = $class->Data();

    $$new[2] =~ s/N//;
    $$new[3] =~ s/E//;

    if ( ( !$old ) || ( $$old[1] ne $$new[1] ) ) {
        $class->Data($new);
        $class->State(1);
    }
    return;
}

sub Check {
    my ($class) = shift;
    $class->State(0);
}

sub Say {
    my ($class) = shift;
    my $word = [
        sub {
            return Gungho::Request->new(
                GET => 'http://www.hinet.bosai.go.jp' );
        },
        sub {
            $class->State(2);
            my $data = $class->Data();
            my $text = sprintf
              "%sにM%sの地震が%sで発生しました %sq=%s%%20%s",
              $$data[1], $$data[5], $$data[0],
              'http://maps.google.co.jp/maps?f=q&hl=ja&t=k&om=0&z=7&',
              $$data[2], $$data[3];
            _utf8_off($text);

            my $uri = URI->new('http:');
            $uri->query_form( status => $text );
            return Gungho::Request->new(
                POST => 'http://twitter.com/statuses/update.json',
                [ 'Content-Type', 'application/x-www-form-urlencoded' ],
                $uri->query,
            );
        },
        sub {
            return Gungho::Request->new(
                GET => 'http://www.hinet.bosai.go.jp' );
        },
    ]->[ $class->State() ];
    return $word->();
}

Gunghoスクリプトが呼び出す設定ファイルはこんな感じになります．

---
components:
  - Throttle::Domain
  - Authentication::Basic
credentials:
  basic:
    -
      - http://twitter.com:80
      - Twitter API
      - username
      - password
throttle:
  domain:
    domains:
      - match: \.bosai\.go\.jp$
    interval: 300
    max_items: 10