diff options
Diffstat (limited to 'examples')
| -rwxr-xr-x | examples/track-from-to | 234 |
1 files changed, 234 insertions, 0 deletions
diff --git a/examples/track-from-to b/examples/track-from-to new file mode 100755 index 0000000..7b8dc74 --- /dev/null +++ b/examples/track-from-to @@ -0,0 +1,234 @@ +#!/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->time : '??:??') . $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); |