path: root/bin/iris-delay-stats

#!/usr/bin/env perl

use strict;
use warnings;
use 5.010;

use Cache::File;
use DBI;
use List::Util qw(first);
use Travel::Status::DE::IRIS;

our $VERSION = '0.00';

my $station = shift or die("Usage: $0 <station> [database]\n");
my $dbname = shift // 'dbdb';

my $dbh = DBI->connect( "dbi:Pg:dbname=$dbname;host=localhost;port=5432",
	'dbdb', $ENV{DBDB_PASSWORD} );

my $cache = Cache::File->new(
	cache_root      => '/tmp/dbdb-cache',
	default_expires => '2 hours',
	lock_level      => Cache::File::LOCK_LOCAL(),
);

sub int_or_undef {
	my ($val) = @_;

	if ( defined $val and length($val) and int($val) != 0 ) {
		return int($val);
	}
	return undef;
}

# TODO does not work with postgresql 9.4, does not support views
sub table_exists {
	my ($table_name) = @_;
	return 1;
	my $sth = $dbh->table_info( undef, 'public', $table_name, 'TABLE' );

	$sth->execute;
	my @info = $sth->fetchrow_array;

	my $exists = scalar @info;
	return $exists;
}

sub table_has_departure {
	my ( $table, $train_id, $scheduled_time ) = @_;
	my $res
	  = $dbh->selectall_arrayref(
"select count(*) from $table where train_id = $train_id and scheduled_time = to_timestamp($scheduled_time)"
	  )->[0][0];

	if ( $res > 0 ) {
		return 1;
	}
	return 0;
}

sub get_id {
	my ( $table, $name ) = @_;

	if ( not defined $name ) {
		return undef;
	}

	my $res
	  = $dbh->selectall_arrayref("select id from $table where name = '$name'");
	if ( @{$res} ) {
		return $res->[0][0];
	}
	else {
		$dbh->do("insert into $table (name) values ('$name')");
		$res = $dbh->selectall_arrayref(
			"select id from $table where name = '$name'");
		return $res->[0][0];
	}
}

if ( not table_exists('lines') ) {
	$dbh->do(
		qq{
		create table lines (
			id serial primary key,
			name text unique not null
		)
	}
	);
}
if ( not table_exists('station_codes') ) {
	$dbh->do(
		qq{
		create table station_codes (
			id serial primary key,
			name text unique not null
		)
	}
	);
}
if ( not table_exists('stations') ) {
	$dbh->do(
		qq{
		create table stations (
			id serial primary key,
			name text unique not null
		)
	}
	);
}
if ( not table_exists('train_types') ) {
	$dbh->do(
		qq{
		create table train_types (
			id serial primary key,
			name text unique not null
		)
	}
	);
}
if ( not table_exists('departures') ) {
	$dbh->do(
		qq{
		create table departures (
			train_id bigint not null,
			station integer not null references station_codes (id),
			scheduled_time timestamp (0) with time zone not null,
			delay smallint,
			is_canceled boolean,
			destination integer not null references stations (id),
			train_type integer not null references train_types (id),
			train_no integer not null,
			line_no smallint references lines (id),
			platform smallint,
			primary key (train_id, scheduled_time)
		)
	}
	);
}
if ( not table_exists('departures_with_messages') ) {

	# only for testing, too inefficient for production
	# (the current schema saves lots of disk space, but not computation time)
	$dbh->do(
		qq{
		create view departures_with_messages as
		select train_id, station, scheduled_time, delay, is_canceled,
		destination, train_type, train_no, line_no, platform, }
		  . join( ", ",
			map { "(msgtable${_}.train_id is not null) as msg${_}" }
			  ( 1 .. 99 ) )
		  . " from departures "
		  . join(
			" ",
			map {
"left outer join msg_$_ as msgtable$_ using (scheduled_time, train_id)"
			} ( 1 .. 99 )
		  )
	);
}
if ( not table_exists('hr_departures') ) {
	$dbh->do(
		qq{
		create view hr_departures as
		select train_id, station_codes.name as hr_station, scheduled_time,
		delay, is_canceled, stations.name as hr_destination,
		train_types.name as hr_train_type, train_no,
		lines.name as hr_line_no, platform
		from departures
		join train_types on train_type = train_types.id
		left outer join lines on line_no = lines.id
		join station_codes on station = station_codes.id
		join stations on destination = stations.id
	}
	);
}
for my $msg ( 1 .. 99 ) {
	if ( not table_exists("msg_$msg") ) {
		$dbh->do(
			qq{create table msg_$msg (
			train_id bigint not null,
			scheduled_time timestamp (0) not null,
			primary key (train_id, scheduled_time)
		)}
		);
	}
}

my $status = Travel::Status::DE::IRIS->new(
	station    => $station,
	lookahead  => 60,
	main_cache => $cache,
);

my @fields = (
	qw(train_id station scheduled_time delay
	  is_canceled destination train_type train_no line_no platform)
);
my $fieldlist          = join( ', ', @fields );
my $field_placeholders = '?, ?, to_timestamp(?), ?, ?, ?, ?, ?, ?, ?';
my $insert_query       = qq{
	insert into departures ( $fieldlist ) values ( $field_placeholders )
};
my $update_query = qq{
	update departures set ( $fieldlist ) = ( $field_placeholders )
	where train_id = ? and scheduled_time = to_timestamp(?)
};
my $sth = $dbh->prepare($insert_query);
my $uth = $dbh->prepare($update_query);

my @msg_sth;
for my $msg ( 1 .. 99 ) {
	$msg_sth[$msg] = $dbh->prepare(
		qq{insert into msg_$msg
		( train_id, scheduled_time ) values ( ?, to_timestamp(?) ) }
	);
}

my $station_id = get_id( 'station_codes', $station );

for my $r ( $status->results ) {

	my @msgtypes = (0) x 100;
	for my $m ( $r->raw_messages ) {
		$msgtypes[ $m->[1] ] = 1;
	}

	my $destination_id = get_id( 'stations',    $r->destination );
	my $type_id        = get_id( 'train_types', $r->type );
	my $line_id        = get_id( 'lines',       $r->line_no );
	my $sched_platform = int_or_undef( $r->sched_platform );

	if (
		table_has_departure( 'departures', $r->train_id, $r->datetime->epoch ) )
	{
		$uth->execute(
			$r->train_id,    $station_id,      $r->datetime->epoch,
			$r->delay,       $r->is_cancelled, $destination_id,
			$type_id,        $r->train_no,     $line_id,
			$sched_platform, $r->train_id,     $r->datetime->epoch
		);
	}
	else {
		$sth->execute(
			$r->train_id, $station_id,      $r->datetime->epoch,
			$r->delay,    $r->is_cancelled, $destination_id,
			$type_id,     $r->train_no,     $line_id,
			$sched_platform
		);
	}

	for my $msg ( 1 .. 99 ) {
		if (
			$msgtypes[$msg]
			and not table_has_departure(
				"msg_$msg", $r->train_id, $r->datetime->epoch
			)
		  )
		{
			$msg_sth[$msg]->execute( $r->train_id, $r->datetime->epoch );
		}
	}
}

__END__

=head1 NAME

=head1 SYNOPSIS

=head1 VERSION

=head1 DESCRIPTION

=head1 OPTIONS

=over

=back

=head1 EXIT STATUS

=head1 CONFIGURATION

None.

=head1 DEPENDENCIES

=over

=back

=head1 BUGS AND LIMITATIONS

=head1 AUTHOR

Copyright (C) 2015 by Daniel Friesel E<lt>derf@finalrewind.orgE<gt>

=head1 LICENSE

  0. You just DO WHAT THE FUCK YOU WANT TO.