Gungho::Inline 0.08002対応版

hinetmania改

http://twitter.com/hinetmaniaで使ってるスクリプトはNIED Hi-net β Ver. [High Sensitivity Seismograph Network Japan]にアクセスするときにはGunghoを使っているんですが，twitterにアクセスする際にはNet::Twitterを使っていました．GET/POSTの区別はあるにせよ，Gunghoでできることを違うモジュールで実行しているのは変な話です．ってことで，Gunghoだけで実現してみました．現在は別アカウントで動作試験を行っています．もうちょっと動かしてみて異常動作しなければhinetmaniaで使っているスクリプトと置き換えます．Gunghoがバージョンアップの際に挙動が変わったので，スクリプトに問題があったら，Gunghoのバージョンから戻さないといけないという，このどきどき（違

スクリプト

#!/usr/local/bin/perl

use strict;
use warnings;
no warnings qw(redefine);
use FileHandle;    # <- Needs for darwin os
use URI;
use Gungho::Inline;
use Web::Scraper;
use Encode qw(_utf8_off);
use utf8;

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

Gungho::Inline->run(
    {
        throttle    => { simple => { max_items => 10, interval => 300 } },
        credentials => {
            basic => [
                [
                    'http://twitter.com:80', 'Twitter API', 'userid', 'passwd'
                ]
            ]
        },
        components => [ 'Throttle::Simple', 'Authentication::Basic' ],
        quake => { outbreak => 0, shake => undef },
    },
    {
        provider => \&provider,
        handler  => \&handler,
    }
);

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

    if ( $c->config->{quake}->{outbreak} ) {
        my $shake = $c->config->{quake}->{shake};
        my $text =
          sprintf "%sにM%sの地震が%sで発生しました %sq=%s%%20%s",
          $$shake[1], $$shake[5], $$shake[0],
          'http://maps.google.co.jp/maps?f=q&hl=ja&t=k&om=0&z=7&', $$shake[2],
          $$shake[3];
        _utf8_off($text);

        my $uri = URI->new('http:');
        $uri->query_form( status => $text );
        $p->add_request(
            $c->prepare_request(
                Gungho::Request->new(
                    POST => 'http://twitter.com/statuses/update.json',
                    [ 'Content-Type', 'application/x-www-form-urlencoded' ],
                    $uri->query,
                )
            )
        );
    }
    1;
}

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

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

    my $case = URI->new( $req->uri )->host;

    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 );
            my $old  = $c->config->{quake}->{shake};
            my $new  = $scraper->scrape($html);

            if ( ( !$old ) or ( $$old[1] ne $$new[1] ) ) {
                $$new[2] =~ s/N//;
                $$new[3] =~ s/E//;
                $c->config->{quake}->{shake}    = $new;
                $c->config->{quake}->{outbreak} = 1;
            }
        },
        'twitter.com' => sub {
            $c->config->{quake}->{outbreak} = 0;
        },
    }->{$case};
    $code->();
    1;
}