俺用なのでinteractivityはまったくない。
ダイヤが変わったら手動でスクリプトを実行して自動生成している。
; go.tbl
a: 西71(稲山通)
b: 西66(稲山通)
c: 52(発寒13条3丁目)
d: 琴40(稲山通)
e: 西48(稲山通)
[MON][TUE][WED][THU][FRI]
# 平日
06: e30 a35 c48 d49 e50
07: b00 c12 d12 e13 a18 d24 e29 b31 d34 d47 c52 d59
08: e01 a02 d12 d30 b31 c32 e33 d47 a50 e54
09: b01 d04 c07 e18 a20 d20 d39 c47 a50 e51
10: b01 d02 a20 e21 d32 c47 a50
11: b01 d02 e06 a20 d32 c47 a50 e51
12: b01 d02 a20 e21 d32 c47 a50 e51
13: b01 d02 a20 e21 d32 c47 a50 e51
14: b01 d02 a20 e21 d32 c47 a50 e51
15: b01 d02 a20 e21 d32 c47 d47 a50 e51
16: b01 d04 a11 e19 d24 a41 b44 d44 c47 e48
17: d04 a11 d24 b25 e26 a41 d44 c47 e51
18: b03 d04 a11 e13 d24 c27 e31 b41 d44
19: d04 b18 e26 c27 d27
20: d02 e26 c27 d27 b39
21: d20 e30 c39 b50
22: d01
23: d01
[SAT][SUN][HOL]
# 土日祝
06: e30 c48 d48
07: b01 e05 d19 a28 b31 c34 e36 d43
08: e09 d10 a11 c17 b23 e26 d34 a50
09: d01 e01 c05 b16 a20 e26 d32 c47 a50
10: d02 b06 a20 e21 d32 c47
11: d02 b06 e11 a20 d32 c47
12: d02 b11 e11 a20 d32 c47 e51
13: d02 b06 a20 e21 d32 c47 e51
14: d02 b18 a20 e21 d32 c47 e51
15: d02 a20 e21 b23 d32 c47 e51
16: d02 b11 a20 e21 d32 b43 c47
17: e01 d02 a20 b23 e31 d32 c37
18: d02 a20 e21 b23 d32 c37 e51 d57
19: b21 d27 e41 d57
20: c00 b21 d22 e31 c40 d52
21: e20 d22 c32
22: d01 d59
; back.tbl
a: 西66(北34条駅前)
b: 西48(発寒小学校)
c: 西48(地下鉄琴似駅前)
d: 西71(札幌駅前)
e: 52(JR琴似駅)
f: 52(札幌駅前)
g: 琴40(JR琴似駅)
[MON][TUE][WED][THU][FRI]
# 平日
06: g17 g41 a49
07: c00 g02 b10 g14 c20 d20 g29 b30 f33 a40 g42 c50 e54 g59
08: b00 a05 f05 g09 d12 c20 e26 g28 b30 f35 c40 b50 g54 e56 d58
09: c10 b20 g24 c30 f35 d38 a40 b40 g54 e56
10: c00 b10 d15 g24 c30 f35 a40 b40 d45 g54 e56
11: c00 b10 d15 g24 f35 a40 c45 d45 g54 b55 e56
12: d15 g24 c30 f35 a40 b40 d45 g54 e56
13: c00 b10 d15 g24 c30 f35 a40 b40 d45 g54 e56
14: c00 b10 d15 g24 c30 f35 a40 b40 d45 g49 e56
15: c00 g09 b10 d15 g24 c30 f35 a40 b40 g44 d45 e56
16: c00 g04 b10 d15 g24 c30 f35 b40 a43 g44 d45 e56
17: c00 d00 g04 b10 f10 a20 g24 c30 d30 e31 b40 f42 g44 a57
18: d00 e03 g04 c05 b15 g24 f25 c30 d30 a35 b40 g44 e46 c50
19: b00 d00 g04 c10 f15 b20 g22 d35 e36 a50 g50
20: c00 f05 b10 d10 g15 e24 g44 f52 c54
21: a00 b02 e11 g25 g53 c58 f58
22: b06 e17 g25
[SAT][SUN][HOL]
# 土日祝
06: g17 g46 a49
07: c00 g07 b10 f33 g34 a37 c40 b50 e52 g59
08: a10 c10 d12 b20 g20 f22 c40 e41 b50 g54
09: c00 d03 b10 g24 c35 f35 d38 a45 b45 g54 e56
10: c00 d08 b10 g24 f35 d38 a40 g54 e56
11: c00 d08 b10 g24 f35 a45 c50 g54 e56
12: b00 d08 g24 f35 a40 c50 g54 e56
13: b00 d08 g24 c30 f35 b40 a45 g54 e56
14: c00 d08 b10 g24 c30 f35 b40 a50 g54 e56
15: c00 d08 b10 g24 c30 f35 b40 g54 a55 e56
16: c00 d08 b10 g24 c30 f35 a40 b40 g54 e56
17: c00 d08 b10 a20 g24 c40 f40 b50 g54 a58
18: e01 d08 c10 b20 g24 f25 e44 g54 a58
19: c00 d08 b10 f10 g22 e29 c30 b40 f50 g50 a58
20: e09 c10 g15 b20 g44 f46 a59 c59
21: e05 b07 g25 c45 b53 g53 f58
22: e17 g23
やっつけで作ったスクリプトはこんな感じ。
#!/usr/local/bin/perl
# -*- Mode:perl -*-
#
# Usage: $0 <input files>
#
# text format:
#
# rosen-code-station
#
use strict;
use LWP::UserAgent;
use Jcode;
my %DOW = (
1 => "[MON][TUE][WED][THU][FRI]\n# 平日\n",
8 => "[SAT][SUN][HOL]\n# 土日祝\n",
);
my @prefix = split("", 'abcdefghijklmnopqrstuvwxyz');
my $BASE_FORMAT = 'http://ekibus.city.sapporo.jp/cgi-bin/coursett.cgi?cid=%d&dow=%d';
my $PAGE_FORMAT = 'http://ekibus.city.sapporo.jp/cgi-bin/coursett.cgi?cid=%d&dow=%d&page=%d';
# 路線別タイムテーブル格納ハッシュ
# $time->{$code}->{'name'} : SCALAR 路線名
# $time->{$code}->{'prefix'} : SCALAR 路線名記号
# $time->{$code}->{$name}->{$dow} : $name:停留所名, ARRAY hhmm
my $time;
############################################################
foreach my $file (@ARGV) {
my $tbl = $file;
$tbl =~ s/txt$/tbl/;
my @list = get_txt($file);
make($tbl, @list);
}
exit;
############################################################
sub get_txt {
my ($txt) = @_;
open my $fd, $txt;
my @buffer = <$fd>;
close $fd;
my @code = ();
foreach my $line (@buffer) {
$line =~ /^\#/ && next;
chomp $line;
my ($rosen, $code, $stations) = split(/-/, $line);
my @stations = split(/,/, $stations);
foreach my $station (@stations) {
my $st = "$code,$station";
push @code, $st;
}
}
return @code;
}
############################################################
sub make {
my ($tbl, @code_st) = @_;
$time = ();
my %html;
# $hours->{hh}: ARRAY
my $hours = ();
foreach my $code_st (@code_st) {
my ($code, $station) = split(/,/, $code_st);
foreach my $dow (keys %DOW) {
if (! defined $html{$code}->{$dow}) {
# get all pages from code, dow
my $file = get_base($code, $dow);
my $last_page = get_pages($file);
add_pages($code, $dow, $last_page);
# set cache
$html{$code}->{$dow} = $file;
}
# parse station time from code, dow html
parse_page($code, $dow, $station);
}
}
my $pind = 0;
foreach my $c (keys %{$time}) {
foreach my $st (keys %{$time->{$c}}) {
if ($st ne 'name') {
$time->{$c}->{$st}->{prefix} = $prefix[$pind];
foreach my $d (keys %{$time->{$c}->{$st}}) {
if ($d ne 'prefix') {
foreach my $t (@{$time->{$c}->{$st}->{$d}}) {
$t =~ /(\d\d)(\d\d)/o;
my ($hh, $mm) = ($1, "$prefix[$pind]$2");
push @{$hours->{$d}->{$hh}}, $mm;
}
}
}
$pind++;
}
}
}
# output
open(FD, ">" . $tbl);
print FD "; $tbl\n";
foreach my $c (keys %{$time}) {
foreach my $st (keys %{$time->{$c}}) {
if ($st ne 'name') {
print FD jcode("$time->{$c}->{$st}->{prefix}: $time->{$c}->{name}($st)\n", 'euc')->tr("０-９Ａ-Ｚ", "0-9A-Z")->sjis;
}
}
}
print FD "\n";
foreach my $d (sort keys %DOW) {
print FD jcode("$DOW{$d}", 'euc')->sjis;
foreach my $hh (sort keys %{$hours->{$d}}) {
if ($#{$hours->{$d}->{$hh}} >= 0) {
print FD "$hh:";
foreach my $mm (sort mmSort @{$hours->{$d}->{$hh}}) {
print FD " $mm";
}
print FD "\n";
}
}
}
close(FD);
}
sub mmSort {
my ($anum, $bnum);
$a =~ /[a-z]+(\d\d)/o;
$anum = $1;
$b =~ /[a-z]+(\d\d)/o;
$bnum = $1;
return ($anum <=> $bnum);
}
############################################################
sub get_base {
my ($code, $dow) = @_;
my $file = "${code}_${dow}.html";
my $uri = sprintf($BASE_FORMAT, $code, $dow);
my $ua = LWP::UserAgent->new;
my $req = HTTP::Request->new('GET', $uri);
my $res = $ua->request($req, $file);
return $file;
}
############################################################
sub get_pages {
my ($file) = @_;
open my $fd, $file;
my @buffer = <$fd>;
close $fd;
my $last_page = 1;
foreach (@buffer) {
if (m|<a href='coursett.cgi\?cid=\d+\&dow=\d\&page=\d+'>(\d+)</a>|o) {
$last_page = $1;
}
}
return $last_page;
}
############################################################
sub add_pages {
my ($code, $dow, $last_page) = @_;
my $file = "${code}_${dow}.html";
for my $page (2 .. $last_page) {
my $uri = sprintf($PAGE_FORMAT, $code, $dow, $page);
my $ua = LWP::UserAgent->new;
my $req = HTTP::Request->new('GET', $uri);
my $res = $ua->request($req);
open my $fd, ">>" . $file;
print $fd $res->content;
close $fd;
}
}
############################################################
sub parse_page {
my ($code, $dow, $station) = @_;
my $file = "${code}_${dow}.html";
open my $fd, $file;
my @buffer = <$fd>;
close $fd;
my $buffer = join("", @buffer);
if ($buffer =~ m|<TR><TD ALIGN="right"><IMG.*?<font color="white">(.*?)</font></TD></TR>|io) {
my $stname = $1;
if ($stname =~ /\[(.*?)\]/o) {
$stname = $1;
}
$time->{$code}->{name} = $stname; # 路線名取得
}
# if ($buffer =~ m|<FONT SIZE="-1" color="white">(.*?)</FONT>|io) {
# my @last = split(/\xA2\xAA/, $1); # →
# $time->{$code}->{name} .= $last[$#last]; # 目的地取得
# }
$time->{$code}->{name} =~ s/\(.*?\)//g;
$buffer =~ s/\s//g;
@buffer = split(/bgcolor="#(dfe9f7|f5fffa)"align="CENTER"/io, $buffer);
foreach my $line (@buffer) {
my $match_pattern = "><TD>$station</TD><TD>(.*?)</TD><TD>(.{4})</TD><TD>(.{4})</TD><TD>(.{4})</TD><TD>(.{4})</TD><TD>(.{4})</TD><TD>(.{4})</TD><TD>(.{4})</TD><TD>(.{4})</TD><TD>(.{4})</TD><TD>(.{4})</TD></TR>";
if ($line =~ m|$match_pattern|i) {
my $stname = $1;
my @time = ($2, $3, $4, $5, $6, $7, $8, $9, $10, $11);
$stname =~ s/\(.*?\)//g;
# omit NOT TIME format
foreach my $i (0 .. $#time) {
if ($time[$i] !~ /\d{4}/) {
splice(@time, $i);
}
}
push @{$time->{$code}->{$stname}->{$dow}}, @time;
}
}
}