summaryrefslogtreecommitdiff
path: root/examples
diff options
context:
space:
mode:
authorDaniel Friesel <derf@finalrewind.org>2014-01-28 23:02:27 +0100
committerDaniel Friesel <derf@finalrewind.org>2014-01-28 23:02:27 +0100
commit1d12c3e5585411a6ff497ee274ba699579fa11b1 (patch)
tree03d875cdfd643b74915506f367a69a171d4d7199 /examples
parent6d3199f75796910c9a82f4c09de9b3384b9ceaa2 (diff)
move track-via to db-iris
Diffstat (limited to 'examples')
-rwxr-xr-xexamples/track-from-to234
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);