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