#!/usr/bin/env perl use strict; use warnings; use 5.014; use utf8; no if $] >= 5.018, warnings => 'experimental::smartmatch'; our $VERSION = '0.01'; use Encode qw(decode); use Getopt::Long qw(:config no_ignore_case bundling); use List::Util qw(first max); use List::MoreUtils qw(none); use Travel::Status::DE::IRIS; use Travel::Status::DE::IRIS::Stations; my ( @grep_class, @grep_type, @grep_platform ); my ( %edata, @edata_pre ); my @output; binmode( STDOUT, ':encoding(utf-8)' ); @ARGV = map { decode( 'UTF-8', $_ ) } @ARGV; GetOptions( 'c|class=s@' => \@grep_class, 'h|help' => sub { show_help(0) }, 'o|output=s@' => \@edata_pre, 'p|platform=s@' => \@grep_platform, 'T|type=s' => \@grep_type, 'V|version' => \&show_version, ) or show_help(1); if ( @ARGV < 2 ) { show_help(1); } # opt=foo,bar support @edata_pre = split( qr{,}, join( q{,}, @edata_pre ) ); @grep_class = split( qr{,}, join( q{,}, @grep_class ) ); @grep_platform = split( qr{,}, join( q{,}, @grep_platform ) ); @grep_type = split( qr{,}, join( q{,}, @grep_type ) ); my ($from, $filter_via, $to) = @ARGV; $to //= $filter_via; $from = get_station($from); $to = get_station($to); for my $efield (@edata_pre) { given ($efield) { when ('d') { $edata{delay} = 1 } when ('D') { $edata{delays} = 1 } when ('f') { $edata{fullroute} = 1 } when ('m') { $edata{messages} = 1 } when ('q') { $edata{qos} = 1 } when ('r') { $edata{route} = 1 } when ('t') { $edata{times} = 1 } default { $edata{$efield} = 1 } } } my $status_f = Travel::Status::DE::IRIS->new( station => $from, ); my $status_t = Travel::Status::DE::IRIS->new( station => $to, ); sub get_station { my ($input_name) = @_; my @stations = Travel::Status::DE::IRIS::Stations::get_station($input_name); if ( @stations == 0 ) { say STDERR "No station matches '$input_name'"; exit(1); } elsif ( @stations == 1 ) { return $stations[0][0]; } else { say STDERR "The input '$input_name' is ambiguous. Please choose one " . 'of the following:'; say STDERR join( "\n", map { $_->[1] } @stations ); exit(1); } } sub show_help { my ($code) = @_; print 'Usage: db-iris [-V] [-c <classlist>] [-d <date>] ' . '[-o <output-flags>] [-p <platforms>] [-t <time>] ' . '[-T <typelist>] [-v <via>] <station>' . "\n" . "See also: man db-iris\n"; exit $code; } sub show_version { say "db-iris version ${VERSION}"; exit 0; } sub display_result { my (@lines) = @_; my @line_length; if ( not @lines ) { die("Nothing to show\n"); } for my $i ( 0 .. 4 ) { $line_length[$i] = max map { length( $_->[$i] ) } @lines; } for my $line (@lines) { printf( join( q{ }, ( map { "%-${_}s" } @line_length ) ), @{$line}[ 0 .. 4 ] ); my $d = $line->[5]; if ( $edata{delays} and $d->delay_messages ) { printf( ' %s', join( q{ }, map { $_->[1] } ( reverse $d->delay_messages ) ) ); } if ( $edata{delay} and ( $d->delay or $d->is_cancelled ) and $d->delay_messages ) { printf( ' %s', ( $d->delay_messages )[-1]->[1] ); } if ( $edata{qos} and $d->qos_messages ) { printf( ' %s', join( q{ }, map { $_->[1] } ( reverse $d->qos_messages ) ) ); } print "\n"; if ( $edata{times} ) { if ( not defined $d->delay ) { print "\n"; } elsif ( $d->delay == 0 ) { printf( "%s+0\n", q{ } x 15 ); } else { printf( "%5s → %5s %+d\n", $d->arrival ? $d->arrival->strftime('%H:%M') : q{}, $d->departure ? $d->departure->strftime('%H:%M') : q{}, $d->delay, ); } } if ( $edata{messages} ) { for my $message ( reverse $d->messages ) { # leading spaces to align with regular output printf( " %s %s\n", $message->[0]->strftime('%d.%m. %H:%M'), $message->[1] ); } print "\n"; } if ( $edata{fullroute} ) { print "\n" . join( "\n", $d->route ) . "\n\n"; } } return; } if ( my $err = $status_f->errstr ) { say STDERR "Request error at ${from}: ${err}"; exit 2; } if ( my $err = $status_t->errstr ) { say STDERR "Request error at ${to}: ${err}"; exit 2; } for my $d ( $status_f->results ) { my @via; @via = $d->route_post; if ( ( $filter_via and not( first { $_ =~ m{$filter_via}io } @via ) ) or ( @grep_class and none { $_ ~~ \@grep_class } $d->classes ) or ( @grep_platform and not( $d->platform ~~ \@grep_platform ) ) or ( @grep_type and not( $d->type ~~ \@grep_type ) ) ) { next; } my $delay = q{}; if ( $d->delay ) { $delay = ( $d->delay > 0 ? ' +' : q{ } ) . $d->delay; } if ( $d->is_cancelled ) { $delay = ' CANCELED'; } my $timestr = $d->time; my $d_via = first { $_->train_id eq $d->train_id } $status_t->results; my $timestr_via = ($d_via ? $d_via->arrival->strftime('%H:%M') : '??:??') . $delay; push( @output, [ "$timestr → $timestr_via", $d->train, $edata{route} ? join( q{ }, $d->route_interesting ) : q{}, $d->route_end, $d->platform // q{}, $d ] ); } display_result(@output);