[Perl] 電車が遅れたらメールで通知 WWW::TrainInfo::JREast;

地元ローカル線がよく遅れるので、駅着く前に事前に知りたいなぁ…と。
まぁ、そういうケータイサービスなんてゴロゴロしているんですが、作ってみたので貼り付け。

package WWW::TrainInfo::JREast;

use strict;
use warnings;
use URI;
use Web::Scraper;
use DateTime;
our $VERSION = '0.2';

our $SITE_URL = "http://www.jreast.co.jp/";
our $BASE_URL = "http://traininfo.jreast.co.jp/train_info/";
our $AREA_DATA = {
		'k' => {
				'name' => '関東エリア',
				'sub_url' => 'kanto.aspx'
				},
		't' => {
				'name' => '東北エリア',
				'sub_url' => 'tohoku.aspx'
				},
		's' => {
				'name' => '信越エリア',
				'sub_url' => 'shinetsu.aspx'
				},
		'Shinkansen' => {
				'name' => '新幹線',
				'sub_url' => 'shinkansen.aspx'
				},
		'long' => {
				'name' => '長距離列車',
				'sub_url' => 'chyokyori.aspx'
				},
		};

sub new{
	my $class = shift;
	my %c = @_;
	my $self = {
			area => $c{area} || [qw(k s t Shinkansen long)],
			notify_no_delay => $c{notify_no_delay} ||0
		};
	bless $self,$class;	
}

sub get_delay{
	my $self = shift;
	my $area_ref = $self->{area};
	my $total_record = ();
	for my $area (@$area_ref){
		
		my $target_url = $BASE_URL.$AREA_DATA->{$area}->{'sub_url'};													#エリアデータの配信情報取得
		my $scraper = scraper {
			process "table#TblInfo",	description => 'TEXT';
			result 'description';
			};

		#$scraper->user_agent->proxy('http', 'http://proxy.com:8080/');
		my $jreast = $scraper->scrape(URI->new($target_url));
		utf8::encode($jreast);

		if($jreast =~ /^(.*)*(\d{4}年\d{1,2}月\d{1,2}日\d{1,2}時\d{1,2}分 配信 )(.*。?)(\s)*/){							#まずは配信情報があるか確認
			while($jreast =~ /^(.*)*(\d{4}年\d{1,2}月\d{1,2}日\d{1,2}時\d{1,2}分 配信 )(.*。?)(\s)*/){					#あれば一件取り出し
				$jreast =~ s/($1)($2)($3)($4).*//ig;																	#取り出した1件をキリトリ。

				my $description = $3||'';																				#/ 配信情報と配信時間を取得	
				my $ymdhmi_wk = $2;
				$ymdhmi_wk =~ s/(\s*)配信(\s*)//;
				$ymdhmi_wk =~ m{(\d{4})年(\d{1,2})月(\d{1,2})日(\d{1,2})時(\d{1,2})分};
				my $year = $1 ||0;
				my $month = $2||0;
				my $day = $3  ||0;
				my $hour = $4 ||0;
				my $min = $5  ||0;																						#配信情報と配信時間を取得 /
				
				my $line_name 	||= $1 if $description =~ m/^\s*(.*?(.*線.*|ライン|.*」))+は、/;						#路線名・名称
				(my $today_flg 	||= 1 and $line_name =~ s/((.*?)発車の)*// ) if($line_name =~ m/本日(.*?)発車の/);		#本日発車時(寝台特急用)
				my $direction 	||= $1 if $description =~ m/(上下(線|列車)|上り|下り|北行|南行|東行|西行|行き|外回り|内回り)+/; 		#列車進行方向
				my $delay_flg 	||= 1 if $description =~ m/遅れがでています/;											#遅延しているのか、
				my $stop_flg 	||= 1 if $description =~ m/運転を見合わせています/;										#運転見合わせなのか、
				my $sleep_flg 	||= 1 if $description =~ m/運休とな(ってい|り)ます。/;									#運休するのか
				my $not_all_flg ||= 1 if $description =~ m/一部列車が/;												#一部だけか
				my $cause 		||= $2 if $description =~ m/(.*?)、(.*の影響(で|が見込まれるため))/;					#どうしてそうなったのか。
				
				my $record = {																							#整形した情報をセット。
					area => $AREA_DATA->{$area}->{name},
					year =>$year,
					month =>$month,
					day =>$day,
					hour =>$hour,
					min =>$min,
					today_flg =>$today_flg,
					line_name => $line_name,
					direction => $direction,
					delay_flg => $delay_flg || 0,
					stop_flg => $stop_flg || 0,
					sleep_flg => $sleep_flg || 0,
					not_all_flg => $not_all_flg || 0,
					description => $description,
					cause => $cause,
				};
				push @$total_record,$record;
			}
		}else{																											#平常運行時
			next if $self->{notify_no_delay} == 0;																		#平常通りのアナウンスが不要ならnext。

			my $dt = DateTime->now();																					#必要なら、現在の時刻で平常の情報をセット
			$dt->set_time_zone("Asia/Tokyo");
			my $date = $dt->year();
			my $record = {
				year => $dt->year(),
				month =>$dt->month(),
				day =>$dt->day(),
				hour =>$dt->hour(),
				min =>$dt->min(),
				nomal_flg => 1,
				area => $AREA_DATA->{$area}->{name},
				description => $jreast,
			};
			push @$total_record,$record;
		}
	}
	return $total_record;
}

Web::Scraperモジュールを使って、http://www.jreast.co.jp/ の電車運行情報からデータを取ってきて、データ整形するモジュールです。

以下のスクリプトの場合は山手線または、京浜東北線で遅延や運休などが発生したかメール確認できる。
宛先を携帯アドレスにして、cronで通勤時間帯に自動起動するようにすればok

#!/usr/bin/perl
package main;

use strict;
use warnings;
use WWW::TrainInfo::JREast;
use Unicode::Japanese;

my @target_areas = qw(k);
my $delay = WWW::TrainInfo::JREast->new(
										notify_no_delay => 0,
										area => [@target_areas]
										);
my $result = $delay->get_delay();

for my $record (@$result){
	next if !defined $record->{description} or $record->{description} eq '';
	my $body = "";
	if(defined $record->{line_name} and $record->{line_name} =~ /(山手|京浜東北)/){
		$body .= qq#$record->{day}日 $record->{hour}:$record->{min}#;
		$body .= qq#$record->{line_name}が# if $record->{line_name};
		$body .= qq#$record->{direction}で# if $record->{direction};
		$body .= qq#一部列車# if $record->{not_all_flg};
		$body .= qq#遅延# if $record->{delay_flg};
		$body .= qq#運転見合せ# if $record->{stop_flg};
		$body .= qq#運休# if $record->{sleep_flg};
		$body = Unicode::Japanese->new($body, 'utf8')->jis;
		
		open( MAIL, "| /usr/sbin/sendmail -t -f $sender" ) or die( "cant open sendmail");
		print MAIL 'TO: hogehoge@hoge.com\n';
		print MAIL 'From: hogehoge@hoge.com\n';	
		print MAIL "Subject: Notify Train Information\n";
		print MAIL qq|Content-Type: text/plain;charset="ISO-2022-JP"\n|;
		print MAIL "Content-Transfer-Encoding: 7bit\n\n";
		print MAIL "$body";
		close(MAIL) or die( "cant close sendmail");
		last;
	}
}

呼び出し時に

my @target_areas = qw(k);
my $delay = WWW::TrainInfo::JREast->new(notify_no_delay => 0,area =>　[@target_areas]);
my $result = $delay->get_delay();

とした場合は、$resultには関東エリアの情報しかないが、

my @target_areas = qw(k t s Shinkansen long);

とすれば、JR東日本管轄路線情報(左から 関東 東海 信州 新幹線 長距離列車の各エリア)を全て取得可能
notify_no_delay を 1 で指定すれば、正常に運行している場合も、「正常」であることの通知を受け取れます。
一応 路線名や、影響方向(上下etc)、遅延か見合わせなのか、提供している情報をそれなりに柔軟に取ってこれるようにはしてますが、いかんせんテストケースが少ないため、動作は保証は全然できません。
#電車遅れてないとテストできないしね…。

WWW::TrainInfo::Metoro 辺りもサクっと作るかも知れないけど未定。
WWW::TrainInfo::JR他グループ やその他私鉄は自分に必要ないので、作らないと思う。

というか、自分用に勢いで作っただけなので使いにくいところは適当に手を加えてくださいな。

#使ってみたいという奇特な方が居ればの話ですが…。