hinetmania改+

もうちょっとやってみた

昨日作ったスクリプトは，あちこちに一時的な変数があって美しくないと思ってました．closureを使えばきれいになりそうな気がしたんですが，クラスメソッドで作る方が現実的かと思って，Class::Data::Inheritableを使ってみました．明日動かしてみて，問題なければこんどこそ入れ替え．

っても

もう少しまとめると，GunghoはYAMLだけかいて，必要なメソッドをクラスに定義するって汎用化ができる気がするな，と．そこまでがんばってみようかな．まぁ，誰も参考にしないスクリプトになりそうだけど（涙

スクリプト

#!/usr/local/bin/perl

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

QuakeInfo->mk_classdata( 'Data' );
QuakeInfo->mk_classdata( State => 0 );

sub Compare {
    my ( $class, $data ) = @_;
    my $old = $class->Data();

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

    if ( ( !$old ) || ( $$old[1] ne $$data[1] ) ) {
        $class->Data($data);
        $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->();
}

package main;

use strict;
use warnings;
no warnings qw(redefine);
use FileHandle;
use Gungho::Inline;
use Web::Scraper;

my $scraper = scraper {
    process 'td.bgltsub+td.bgwhite', 'descr[]' => 'text';
    result 'descr';
};

Gungho::Inline->run(
    {
        throttle => {
            domain => {
                max_items => 10,
                interval  => 300,
                domains   => [ { match => '\.bosai\.go\.jp$' } ],
            }
        },
        credentials => {
            basic => [
                [
                    'http://twitter.com:80', 'Twitter API', 'userid', 'password'
                ]
            ]
        },
        components => [ 'Throttle::Domain', 'Authentication::Basic' ],
    },
    {
        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 {
            my $content_type = $res->headers->header('Content-Type');
            my $enc          = Encode::find_encoding($1)
              if ( $content_type =~ /charset=([A-Za-z0-9_\-]+)/io );

            my $html = $enc->decode( $res->content );
            QuakeInfo->Compare( $scraper->scrape($html) );
        },
        'twitter.com' => sub {
            QuakeInfo->Check();
        },
    }->{ URI->new( $req->uri )->host };
    $code->();
    1;
}