#!/usr/bin/env perl use strict; use warnings; use 5.014; use utf8; use Cache::Memory; use Encode qw(decode); use IO::Handle; use Time::Progress; use Travel::Status::DE::IRIS; use Travel::Status::DE::IRIS::Stations; STDOUT->autoflush(1); my $now = DateTime->now( time_zone => 'Europe/Berlin' ); binmode( STDOUT, ':encoding(utf-8)' ); @ARGV = map { decode( 'UTF-8', $_ ) } @ARGV; my ( $dest_station, $train_type, $train_no, $max_stations ) = @ARGV; $max_stations //= 20; my $main_cache = Cache::Memory->new( namespace => 'IRISMain', default_expires => '6 hours', ); my $rt_cache = Cache::Memory->new( namespace => 'IRISRT', default_expires => '90 seconds' ); sub get_train_or_undef { my ( $station, $ignore_errors ) = @_; my @candidates = Travel::Status::DE::IRIS::Stations::get_station($station); if ( @candidates == 1 ) { $station = $candidates[0][0]; } my $status = Travel::Status::DE::IRIS->new( datetime => $now, station => $station, with_related => 0, main_cache => $main_cache, realtime_cache => $rt_cache, lookahead => 300, ); if ( my $err = $status->errstr ) { if ($ignore_errors) { return undef; } else { say STDERR "Request error at ${station}: ${err}"; exit 1; } } if ( my $warn = $status->warnstr and not $ignore_errors ) { say STDERR "Request warning at ${station}: ${warn}"; } my @res = grep { $_->type eq $train_type and $_->train_no eq $train_no } $status->results; if ( @res == 1 ) { return $res[0]; } return undef; } sub get_train_at_next_station_or_undef { my ($train) = @_; my @route_next = $train->route_post; if ( not @route_next ) { return ( undef, undef ); } return ( $route_next[0], get_train_or_undef( $route_next[0] ) ); } sub get_train_at_prev_station_or_undef { my ($train) = @_; my @route_prev = $train->route_pre; if ( not @route_prev ) { return ( undef, undef ); } return ( $route_prev[-1], get_train_or_undef( $route_prev[-1] ) ); } sub format_datetime { my ($dt) = @_; if ( not defined $dt ) { return q{}; } return $dt->strftime('%H:%M'); } sub format_delay { my ($delay) = @_; if ( not defined $delay ) { return q{}; } return sprintf( '%+d', $delay ); } sub update_trainstatus { my ($train) = @_; return { sched_arrival => $train->sched_arrival, rt_arrival => $train->arrival, sched_departure => $train->sched_departure, rt_departure => $train->departure, cancelled_arrival => $train->arrival_is_cancelled, cancelled_departure => $train->departure_is_cancelled, sched_platform => $train->sched_platform, delay => $train->delay, arrival_delay => $train->arrival_delay, departure_delay => $train->departure_delay, platform => $train->platform, epoch => ( $train->arrival // $train->departure )->epoch, last_update => DateTime->now( time_zone => 'Europe/Berlin' )->epoch, }; } my $initial_train = get_train_or_undef($dest_station); if ( not defined $initial_train ) { say STDERR "Did not find $train_type $train_no at $dest_station\n"; say STDERR "Note that its arrival must not be more than 5 hours in the future\n"; } my @stations = ( $initial_train->route_pre, $dest_station ); my @all_messages = $initial_train->messages; if ( @stations > $max_stations ) { splice( @stations, 0, @stations - $max_stations ); } my %status = ( $dest_station => update_trainstatus($initial_train), ); my $timer_current = 0; my $timer_max = @stations; my $timer = Time::Progress->new( min => 1, max => $timer_max, ); for my $station (@stations) { print $timer->report( "\r\e[2KGetting initial departures %20b %p " . "(${timer_current}/${timer_max}) ${station}", ++$timer_current ); if ( my $train = get_train_or_undef( $station, 1 ) ) { $status{$station} = update_trainstatus($train); } else { $status{$station}{skip} = 1; } } print "\r\e[2K"; while (1) { my $prev_epoch = 0; my $now = DateTime->now( time_zone => 'Europe/Berlin' ); for my $station (@stations) { if ( $status{$station}{skip} ) { printf( "%30s ??:?? → ??:??\n\n", $station ); } else { my $epoch = $status{$station}{epoch}; my @messages = grep { $_->[0]->epoch > $prev_epoch and $_->[0]->epoch <= $epoch } @all_messages; for my $message (@messages) { printf( "%30s %5s %s\n", q{}, $message->[0]->strftime('%H:%M'), $message->[1] ); } if (@messages) { print "\n"; } if ( $prev_epoch < $now->epoch and $now->epoch <= $epoch ) { printf( "%30s %5s\n\n", '>' x 15, $now->strftime('%H:%M') ); } printf( "%30s %5s → %5s %s\n", $station, format_datetime( $status{$station}{sched_arrival} ), format_datetime( $status{$station}{sched_departure} ), format_delay( $status{$station}{delay} ), ); if ( $status{$station}{arrival_delay} or $status{$station}{departure_delay} ) { printf( "%30s %5s → %5s\n", q{}, format_datetime( $status{$station}{rt_arrival} ), format_datetime( $status{$station}{rt_departure} ), ); } print "\n"; $prev_epoch = $epoch; } } sleep(60); for my $station (@stations) { if ( my $train = get_train_or_undef( $station, 1 ) ) { $status{$station} = update_trainstatus($train); @all_messages = $train->messages; } } say "\n----\n"; }