use strict;
use warnings;
use 5.014;
use DBI;
use Path::Class;
use Getopt::Long::Descriptive;
use Try::Tiny;
use DateTime;
use open ':std',':locale';
use Data::Printer;
sub day_of_journey {
my ($ts) = @_;
my $day = $ts->clone->truncate(to=>'day');
my $day_end = $ts->clone->set(hour=>4,minute=>30,second=>0);
if ($ts < $day_end) {
$day->subtract(days=>1);
}
return $day;
}
sub is_peak {
my ($ts) = @_;
return 0 if $ts->day_of_week ~~ [6,7];
my $peak_start = $ts->clone->set(hour=>4,minute=>30,second=>0);
return 0 if $ts < $peak_start;
my $peak_stop = $ts->clone->set(hour=>9,minute=>29,second=>59);
return 0 if $ts > $peak_stop;
return 1;
}
{my %zone_for_station = (
q{Aldgate East} => 1,
q{Alexandra Palace [National Rail]} => 3,
q{Angel} => 1,
q{Bank} => 1,
q{Barons Court} => 2,
q{Blackfriars} => 1,
q{Blackfriars [London Underground]} => 1,
q{Brentford [National Rail]} => 4,
q{Camden Town} => 2,
q{Chalk Farm} => 2,
q{Chancery Lane} => 1,
q{Charing Cross} => 1,
q{Charing Cross [London Underground]} => 1,
q{Covent Garden} => 1,
q{Custom House DLR} => 3,
q{Cutty Sark DLR} => 2,
q{Dalston Junction [London Overground]} => 2,
q{Dalston Kingsland} => 2,
q{Ealing Broadway} => 3,
q{Ealing Common} => 3,
q{East Croydon [National Rail]} => 5,
q{Embankment} => 1,
q{Euston [London Underground]} => 1,
q{Euston Square} => 1,
q{Finsbury Park [London Underground / National Rail]} => 2,
q{Golders Green} => 3,
q{Goodge Street} => 1,
q{Greenford} => 4,
q{Green Park} => 1,
q{Hanger Lane} => 3,
q{Hayes & Harlington [National Rail]} => 5,
q{Heathrow Terminal 5 [London Underground]} => 6,
q{Highbury & Islington} => 2,
q{High Street Kensington} => 1,
q{Holborn} => 1,
q{Hounslow Central} => 4,
q{Hoxton [London Overground]} => 1,
q{Hyde Park Corner} => 1,
q{Kensal Green} => 2,
q{Kentish Town} => 2,
q{Kings Cross [National Rail]} => 1,
q{Kings Cross [London Underground / National Rail]} => 1,
q{Ladbroke Grove} => 2,
q{Lancaster Gate} => 1,
q{Leicester Square} => 1,
q{Leytonstone} => 3,
q{Limehouse DLR} => 2,
q{Liverpool Street [London Underground]} => 1,
q{London Bridge [London Underground]} => 1,
q{Mansion House} => 1,
q{Marble Arch} => 1,
q{Mornington Crescent} => 2,
q{North Acton} => 2,
q{North Greenwich} => 2,
q{Northfields} => 3,
q{Northolt} => 5,
q{Notting Hill Gate} => 1,
q{Oxford Circus} => 1,
q{Paddington [National Rail]} => 1,
q{Park Royal} => 3,
q{Piccadilly Circus} => 1,
q{Pimlico} => 1,
q{Pinner} => 5,
q{Queensway} => 1,
q{Rayners Lane} => 5,
q{Rotherhithe [London Overground]} => 2,
q{Shepherd's Bush (Central line)} => 2,
q{Shepherd's Bush Market} => 2,
q{Sloane Square} => 1,
q{South Kensington} => 1,
q{Southwark} => 1,
q{St Paul's} => 1,
q{Stratford} => 3,
q{Tottenham Court Road} => 1,
q{Tower Hill} => 1,
q{Turnham Green} => 2,
q{Vauxhall [London Underground]} => 1,
q{Victoria [London Underground]} => 1,
q{Waterloo (Jubilee line entrance)} => 1,
q{Waterloo [London Underground / National Rail]} => 1,
q{West Ealing [National Rail]} => 3,
q{White City} => 2,
q{Wood Green} => 3
);
sub zone_for_station {
my ($station) = @_;
if (not exists $zone_for_station{$station}) {
warn "unknown station: <$station>\n";
}
return $zone_for_station{$station};
}
}
my $default_db_path = file(__FILE__)->parent->file('oyster.db')->stringify;;
my ($opt,$usage) = describe_options(
'%c %o',
[ 'database|d=s', 'path to the database to use',
{ default => $default_db_path } ],
[],
[ 'help|h', 'print help and exit' ],
);
if ($opt->help) {
print $usage->text;
exit;
}
my $dbh = DBI->connect(
'dbi:SQLite:dbname='.$opt->database,
'','',
{ RaiseError => 1, PrintError => 0, AutoCommit => 1 },
);
my $sth = $dbh->prepare(q{SELECT start_ts,stop_ts,description FROM journeys});
$sth->execute;
my %journeys_on_day;
my %range_for_day;
sub update_range {
my ($day_key,$peak,$tube,$start_zone,$stop_zone) = @_;
my ($min_zone,$max_zone) = sort {$a<=>$b} $start_zone,$stop_zone;
my $cur_range=$range_for_day{$day_key}//={};
$cur_range->{peak}||=$peak;
$cur_range->{tube}||=$tube;
if ($tube && ($cur_range->{min_zone}||9 > $min_zone)) {
$cur_range->{min_zone} = $min_zone;
}
if ($tube && ($cur_range->{max_zone}||-1 < $max_zone)) {
$cur_range->{max_zone} = $max_zone;
}
return;
}
my $start_from;
if ($ARGV[0]) {
require DateTime::Format::Natural;
$start_from = DateTime::Format::Natural->new(
prefer_future => 0,
time_zone=>'Europe/London',
)->parse_datetime($ARGV[0])->truncate(to=>'day');
}
while (my $row=$sth->fetchrow_hashref) {
my $start_ts = DateTime->from_epoch(
epoch=> $row->{start_ts},
time_zone=>'Europe/London',
);
next if $start_from && $start_ts < $start_from;
my $day_key= day_of_journey($start_ts)->ymd;
my @journey;my ($peak,$tube,$start_zone,$stop_zone)=(0,0,0,0);
$peak = is_peak($start_ts);
if ($row->{description} =~ m{\ABus journey, route (\S+)}) {
@journey=('bus','bus');$tube=0;
}
elsif ($row->{description} =~ m{\A(.*?) to (.*)}) {
($start_zone,$stop_zone) = sort {$a<=>$b}
map { zone_for_station($_) } $1,$2;
@journey=($start_zone,$stop_zone);$tube=1;
}
else {
warn "unparseable journey: <$row->{description}>, ignoring\n";
next;
}
push @{$journeys_on_day{$day_key}},[$peak,@journey];
update_range($day_key,$peak,$tube,$start_zone,$stop_zone);
}
my %prices = (
bus => [1.40,4.40],
'0-1-1' => [2.10,7.00],
'1-1-1' => [2.10,8.40],
'0-1-2' => [2.10,7.00],
'1-1-2' => [2.80,8.40],
'0-1-3' => [2.70,7.70],
'1-1-3' => [3.20,10.60],
'0-1-4' => [2.70,7.70],
'1-1-4' => [3.80,10.60],
'0-1-5' => [3.00,8.50],
'1-1-5' => [4.60,15.80],
'0-1-6' => [3.00,8.50],
'1-1-6' => [5.00,15.80],
'0-2-2' => [1.50,7.00],
'1-2-2' => [1.60,8.40],
'0-2-3' => [1.50,7.70],
'1-2-3' => [1.60,10.60],
'0-2-4' => [1.50,7.70],
'1-2-4' => [2.30,10.60],
'0-2-5' => [1.50,8.50],
'1-2-5' => [2.70,15.80],
'0-2-6' => [1.50,8.50],
'1-2-6' => [2.70,15.80],
'0-3-3' => [1.50,7.70],
'1-3-3' => [1.60,10.60],
'0-3-4' => [1.50,7.70],
'1-3-4' => [1.60,10.60],
'0-3-5' => [1.50,8.50],
'1-3-5' => [2.30,15.80],
'0-3-6' => [1.50,8.50],
'1-3-6' => [2.70,15.80],
'0-4-4' => [1.50,7.70],
'1-4-4' => [1.60,10.60],
'0-4-5' => [1.50,8.50],
'1-4-5' => [1.60,15.80],
'0-4-6' => [1.50,8.50],
'1-4-6' => [2.30,15.80],
'0-5-5' => [1.50,8.50],
'1-5-5' => [1.60,15.80],
'0-5-6' => [1.50,8.50],
'1-5-6' => [1.60,15.80],
'0-6-6' => [1.50,8.50],
'1-6-6' => [1.60,15.80],
);
my $total=0;
for my $day (sort keys %journeys_on_day) {
my $cost=0;
for my $journey (@{$journeys_on_day{$day}}) {
if ($journey->[1] eq 'bus') {
$cost += $prices{bus}->[0];
}
else {
my $key = join '-',@$journey;
$cost += $prices{$key}->[0] or die "Can't get price for $key";
}
}
my $range= $range_for_day{$day};
my $cap;
if (not $range->{tube}) {
$cap= $prices{bus}->[1];
}
else {
my $cap_key = join '-',@{$range}{qw(peak min_zone max_zone)};
$cap = $prices{$cap_key}->[1] or die "Can't get cap for $cap_key";
}
if ($cost > $cap) {
$cost = $cap;
}
say "Cost for $day: $cost";
$total+=$cost;
}
say "Total: $total";
__END__
