summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDaniel Friesel <derf@finalrewind.org>2014-01-27 19:28:32 +0100
committerDaniel Friesel <derf@finalrewind.org>2014-01-27 19:28:32 +0100
commit1cdc3772cd84f38a3e8a2c04a232c0d8cafd2ef3 (patch)
treea03c148c95a085a0a8ddfde50762ae99baa77fe8
parent39a2e3814c1cd9e1b32fe4952da395a4878f986b (diff)
add from -> to tracking example for @Marudor. May be merged into db-iris later
-rwxr-xr-xexamples/track-from-to234
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);