[Perl] グラッときたら通ｃ(ry WWW::JMA::Earthquake;

昨日地震がありまして、速報をTwitterで確認したのですが、そういうのがWassrにも在って良いんじゃね？ということで、例によって脊髄反射で書きました。

モジュール部分

package WWW::JMA::Earthquake;
use strict;
use warnings;
use URI;
use Web::Scraper;
use DateTime;

our $VERSION = '1.0';
our $SITE_URL = "http://www.jma.go.jp";
our $INFO_URL = "/jp/quake/";

sub new{
	my $class = shift;
	my $self = {
		};
	bless $self,$class;	
}

sub parse_info{
	my $self = shift;
	my $result= ();
	my $record = ();

	my $target_url = $SITE_URL.$INFO_URL;														#配信情報取得
	my $scraper = scraper {
		process 'div#base>div#main>div#info>table.textframe#infobox>tr>td', 'field' => 'TEXT';
		result 'field';
	};
	$result = $scraper->scrape(URI->new($target_url));
	utf8::encode($result);

	my ($year,$month,$i_day,$i_hour,$i_min) = ();
	{												#発表年月日時分
		$result =~ m{平成(\d{2})年(\d{1,2})月(\d{1,2})日(\d{1,2})時(\d{1,2})分 (.*)? 発表};
		$year 	= $1 ||0;
		$month 	= $2 ||0;
		$i_day 	= $3 ||0;
		$i_hour = $4 ||0;
		$i_min 	= $5 ||0;
	}
	
	my ($a_day,$a_hour,$a_min) = ();
	{															#発生日時分
		$result =~ m{(\d{1,2})日(\d{1,2})時(\d{1,2})分頃地震がありました。};
		$a_day = $1  ||0;
		$a_hour = $2 ||0;
		$a_min = $3  ||0;				
	}
	
	my $area 		||= $1 if $result =~ m{震(?:源|央)地は(.*)?（(.*)?北緯};					#震源地||震央地
		$area = substr($area,0,-2) if defined $area;											#	あれば、整形
	my $magnitude 	||= $1 if $result =~ m{（マグニチュード）は(.*)?と推定されます。};			#マグニチュード
	my $shindo 		||= $1 if $result =~ m{(震度(１|２|３|４|５|６|７)(強|弱)?)};				#震度 [１２３４５６７]で取れなかったので(１|２|...)で
	my $direction 	||= $1 if $result =~ m{^(.*)次の(通|とお)りです};							#各地の震度を除いた全文テキスト
	
	$record = {																					#整形した情報をセット。
				year =>$year,
				month =>$month,
				i_day =>$i_day,
				i_hour =>$i_hour,
				i_min =>$i_min,
				a_day =>$a_day,
				a_hour =>$a_hour,
				a_min =>$a_min,
				area => $area,
				magnitude =>$magnitude,
				shindo => $shindo,
				direction => $direction,
				fullintext => $result,
	};
	$self->{info} = $record;
}

sub get_info{
	my $self = shift;
	return $self->{info};
}

呼び出し側のスクリプトは以下な感じで。

#!/usr/bin/perl
package main;
use strict;
use warnings;
use WWW::JMA::Earthquake;
my $quac = WWW::JMA::Earthquake->new();
$quac->parse_info();
my $info = $quac->get_info();
exit if !defined $info->{i_day} or $info->{i_day} == 0;

my $tmpl =qq|$info->{i_day}日$info->{i_hour}時$info->{i_min}分気象庁発表 $info->{a_day}日$info->{a_hour}時$info->{a_min}分頃|;
$tmpl .= " 震源地".$info->{area} if defined $info->{area};
$tmpl .= " M".$info->{magnitude} if defined $info->{magnitude};
$tmpl .= " 最大".$info->{shindo} if defined $info->{shindo};
$tmpl .= "の地震が観測されました";

#文字列$tmplをwassrに投げる部分は省略

最後を飛ばし先をメールにすれば、メールでも速報が受け取れます。
これをcronで毎分見に行くように回せばokです。

ただし、何分に発生した情報か、何分に発表した情報かといったのをファイルか何かに保存してそれと比較しないと、何度も同じ情報が飛びますので、その辺は適宜調整が必要です。

まぁ、上記モジュールを使うより、Jquake@Wassr を購読するか、

TwitterのEarthquake_jpをFollowするが一番かもしれません

#実際作ってる時 Twitter/Earthquake_jp を受け取って Jquake@Wassr に投げるんで良いんじゃね？と思ったのは内緒

…何か最近自前モジュール書くときしかダイアリーかいてないような気がする。