#!perl use strict; use warnings; use 5.014; use utf8; our $VERSION = '1.98'; use DateTime; use DateTime::Format::Strptime; use Encode qw(decode); use Getopt::Long qw(:config no_ignore_case bundling); use JSON; use List::Util qw(first max); use List::MoreUtils qw(any none); use Travel::Status::DE::IRIS; use Travel::Status::DE::IRIS::Stations; my ( $date, $time ); my $datetime = DateTime->now( time_zone => 'Europe/Berlin' ); my $developer_mode = 0; my $lookahead = 2 * 60; my $realtime = 0; my $with_related = 1; my $json_output = 0; my $use_cache = 1; my ( $schedule_cache, $realtime_cache ); my ( $filter_via, $track_via, $status_via ); 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, 'd|date=s' => \$date, 'h|help' => sub { show_help(0) }, 'l|lookahead=i' => \$lookahead, 'o|output=s@' => \@edata_pre, 'p|platform=s@' => \@grep_platform, 'r|realtime' => \$realtime, 't|time=s' => \$time, 'T|type=s' => \@grep_type, 'v|via=s' => \$filter_via, 'V|track-via=s' => \$track_via, 'x|exact|no-related' => sub { $with_related = 0 }, 'cache!' => \$use_cache, 'devmode' => \$developer_mode, 'json' => \$json_output, 'version' => \&show_version, ) or show_help(1); if ( @ARGV != 1 ) { 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 ($station) = @ARGV; $station = get_station($station); if ($track_via) { $track_via = get_station($track_via); } if ($date) { my ( $day, $month, $year ) = split( qr{ [.] }x, $date ); if ( $date eq 'tomorrow' ) { $datetime->add( days => 1 ); } elsif (not( defined $day and defined $month ) or ( $day < 1 ) or ( $day > 31 ) or ( $month < 1 ) or ( $month > 12 ) ) { say STDERR "-d/--date: Please specify a valid date (dd.mm. / dd.mm.YYYY / tomorrow)"; exit(3); } else { $datetime->set( day => $day, month => $month, year => $year || $datetime->year, ); } } if ($time) { my ( $hour, $minute, $second ) = split( qr{ : }x, $time ); if ( not defined $hour or not defined $minute or ( $hour < 0 ) or ( $hour > 23 ) or ( $minute < 0 ) or ( $minute > 59 ) or ( defined $second and ( ( $second < 0 ) or ( $second > 59 ) ) ) ) { say STDERR "-t/--time: Please specify a valid time"; exit(3); } $datetime->set( hour => $hour, minute => $minute, second => $second || $datetime->second, ); } for my $efield (@edata_pre) { if ( $efield eq 'a' ) { $edata{additional} = 1 } elsif ( $efield eq 'c' ) { $edata{canceled} = 1 } elsif ( $efield eq 'd' ) { $edata{delay} = 1 } elsif ( $efield eq 'D' ) { $edata{delays} = 1 } elsif ( $efield eq 'f' ) { $edata{fullroute} = 1 } elsif ( $efield eq 'm' ) { $edata{messages} = 1 } elsif ( $efield eq 'q' ) { $edata{qos} = 1 } elsif ( $efield eq 'r' ) { $edata{route} = 1 } elsif ( $efield eq 'R' ) { $edata{replacements} = 1 } elsif ( $efield eq 't' ) { $edata{times} = 1 } elsif ( $efield eq '!' ) { $edata{debug} = 1 } else { $edata{$efield} = 1 } } if ($use_cache) { my $cache_path = $ENV{XDG_CACHE_HOME} // "$ENV{HOME}/.cache"; my $schedule_cache_path = "${cache_path}/db-iris-schedule"; my $realtime_cache_path = "${cache_path}/db-iris-realtime"; eval { require Cache::File; $schedule_cache = Cache::File->new( cache_root => $schedule_cache_path, default_expires => '6 hours', lock_level => Cache::File::LOCK_LOCAL(), ); $realtime_cache = Cache::File->new( cache_root => $realtime_cache_path, default_expires => '180 seconds', lock_level => Cache::File::LOCK_LOCAL(), ); }; if ($@) { $schedule_cache = undef; $realtime_cache = undef; } } my $status = Travel::Status::DE::IRIS->new( datetime => $datetime, developer_mode => $developer_mode, lookahead => $lookahead, main_cache => $schedule_cache, realtime_cache => $realtime_cache, station => $station, with_related => $with_related, ); if ($track_via) { $status_via = Travel::Status::DE::IRIS->new( datetime => $datetime, lookahead => $lookahead + 3 * 60, main_cache => $schedule_cache, realtime_cache => $realtime_cache, station => $track_via, ); } sub get_arrival { my ( $result, $fmt ) = @_; my $dt_arrival = $realtime ? $result->arrival : $result->sched_arrival; if ($fmt) { return $dt_arrival ? $dt_arrival->strftime($fmt) : q{}; } return $dt_arrival; } sub get_departure { my ( $result, $fmt ) = @_; my $dt_dep = $realtime ? $result->departure : $result->sched_departure; if ($fmt) { return $dt_dep ? $dt_dep->strftime($fmt) : q{}; } return $dt_dep; } sub get_station { my ($input_name) = @_; if ( $input_name =~ m{ ^ [[:digit:]]+ $ }x ) { return $input_name; } if ( $input_name =~ m{ ^ (? [[:digit:].]+ ) , (? [[:digit:].]+ ) }x ) { my @candidates = Travel::Status::DE::IRIS::Stations::get_station_by_location( $+{lon}, $+{lat} ); if ( not @candidates ) { say STDERR "Found no stations inside a 70km radius around $+{lon},$+{lat}"; exit(1); } say STDERR "Geolocation candidates for $+{lon},$+{lat} are:"; say STDERR join( "\n", map { sprintf( "%-30s %-5s %4.1fkm", $_->[0][1], $_->[0][0], $_->[1] ) } @candidates ); exit(1); } 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][2]; } else { say STDERR "The input '$input_name' is ambiguous. Please choose one " . 'of the following:'; say STDERR join( "\n", map { $_->[1] . ' (' . $_->[0] . ')' } @stations ); exit(1); } } sub show_help { my ($code) = @_; print 'Usage: db-iris [-rx] [-d ] [-o ]' . '[-t