#!/usr/bin/env perl use strict; use warnings; use 5.014; our $VERSION = '2.05'; use Encode qw(decode); use Getopt::Long qw(:config no_ignore_case); use List::MoreUtils qw(uniq); use List::Util qw(first max); use Travel::Status::DE::HAFAS; my ( $date, $time ); my $arrivals = 0; my $ignore_late = 0; my $types = q{}; my $language; my $developer_mode; my ( $list_services, $service, $hafas_url ); my ( @excluded_mots, @exclusive_mots ); my @output; binmode( STDOUT, ':encoding(utf-8)' ); for my $arg (@ARGV) { $arg = decode( 'UTF-8', $arg ); } GetOptions( 'a|arrivals' => \$arrivals, 'd|date=s' => \$date, 'h|help' => sub { show_help(0) }, 'l|lang=s' => \$language, 'L|ignore-late' => \$ignore_late, 'm|mot=s' => \$types, 's|service=s' => \$service, 't|time=s' => \$time, 'u|url=s' => \$hafas_url, 'V|version' => \&show_version, 'devmode' => \$developer_mode, 'list' => \$list_services, ) or show_help(1); if ($list_services) { printf( "%-40s %-14s %s\n\n", 'operator', 'abbr. (-s)', 'url (-u)' ); for my $service ( Travel::Status::DE::HAFAS::get_services() ) { printf( "%-40s %-14s %s\n", @{$service}{qw(name shortname url)} ); } exit 0; } parse_mot_options(); my $status = Travel::Status::DE::HAFAS->new( date => $date, language => $language, excluded_mots => \@excluded_mots, exclusive_mots => \@exclusive_mots, station => shift || show_help(1), time => $time, mode => $arrivals ? 'arr' : 'dep', developer_mode => $developer_mode, service => $service, url => $hafas_url, ); sub show_help { my ($code) = @_; print 'Usage: hafas-m [-d <dd.mm.yyyy>] [-m <motlist>] [-t <time>] ' . "<station>\n" . "See also: man hafas-m\n"; exit $code; } sub show_version { say "hafas-m version ${VERSION}"; exit 0; } sub parse_mot_options { my $default_yes = 1; if ( $types and $hafas_url ) { say STDERR 'The options -u and -m cannot be combined. Discarding -m'; return; } for my $type ( split( qr{,}, $types ) ) { if ( $type eq 'help' or $type eq 'list' or $type eq q{?} ) { if ( not $hafas_url ) { $service //= 'DB'; } my $desc = Travel::Status::DE::HAFAS::get_service($service); if ($desc) { my @mots = @{ $desc->{productbits} }; @mots = grep { $_ ne 'x' } @mots; @mots = uniq @mots; @mots = sort @mots; say join( "\n", @mots ); exit 0; } else { say STDERR 'no modes of transport known for this service'; exit 1; } } elsif ( substr( $type, 0, 1 ) eq q{!} ) { push( @excluded_mots, substr( $type, 1 ) ); } else { push( @exclusive_mots, $type ); } } return; } sub show_similar_stops { my @candidates = $status->similar_stops; if (@candidates) { say 'You might want to try one of the following stops:'; for my $c (@candidates) { printf( "%s (%s)\n", $c->{name}, $c->{id} ); } } return; } 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) { my $d = $line->[6]; if ( $d->messages ) { print "\n"; for my $msg ( $d->messages ) { printf( "# %s\n", $msg ); } } printf( join( q{ }, ( map { "%-${_}s" } @line_length ) ), @{$line}[ 0 .. 4 ] ); if ( $line->[5] ) { print q{ } . $line->[5]; } print "\n"; } return; } if ( my $err = $status->errstr ) { say STDERR "Request error: ${err}"; if ( $status->errcode and $status->errcode eq 'H730' ) { show_similar_stops(); } exit 2; } for my $d ( $status->results() ) { if ( $ignore_late and $d->delay ) { next; } push( @output, [ $d->time, $d->is_cancelled ? 'CANCELED' : ( $d->delay ? sprintf( '%+d', $d->delay ) : q{} ), $d->train, $d->route_end, ( $d->platform // q{} ) . ( $d->is_changed_platform ? ' !' : q{} ), $d->info, $d ] ); } display_result(@output); __END__ =head1 NAME hafas-m - Interface to the DeutscheBahn/HAFAS online departure monitor =head1 SYNOPSIS B<hafas-m> [B<-d> I<date>] [B<-t> I<time>] [B<-m> I<motlist>] [B<-s> I<service> | B<-u> I<url>] I<station> =head1 VERSION version 2.05 =head1 DESCRIPTION hafas-m is an interface to HAFAS-based departure monitors, for instance the one available at L<http://reiseauskunft.bahn.de/bin/bhftafel.exe/dn>. It requests all departures at I<station> (optionally filtered by date, time, route and means of transport) and lists them on stdout, similar to the big departure screens installed at most main stations. =head1 OPTIONS =over =item B<-a>, B<--arrivals> Show arrivals instead of departures, including trains ending at the specified station. Note that this causes the output to display the start instead of the end station. =item B<-d>, B<--date> I<dd>.I<mm>.I<yyyy> Date to list departures for. Default: today. =item B<-l>, B<--lang> B<d>|B<e>|B<i>|B<n> Set language used for additional information. Supports B<d>eutsch (default), B<e>nglish, B<i>talian and dutch (B<n>), depending on the used service. =item B<-L>, B<--ignore-late> Do not display delayed trains. =item B<--list> List known HAFAS installations. See also B<--service> and B<--url>. =item B<-m>, B<--mot> I<motlist> By default, B<hafas-m> shows all modes of transport arriving/departing at the specified station. With I<motlist>, it is possible to either exclude a list of modes, or exclusively show only a select list of modes. To exclude modes, set I<motlist> to B<!>I<mot1>,B<!>I<mot2>,... To show them exclusively, set I<motlist> to I<mot1>,I<mot2>,... The I<mot> types depend on the used service. Use C<< -m help >> to list them. =item B<-s>, B<--service> I<service> Request arrivals/departures using the API provided by I<service>, defaults to DB (Deutsche Bahn). See B<--list> for a list of known services. =item B<-t>, B<--time> I<hh>:I<mm> Time to list departures for. Default: now. =item B<-u>, B<--url> I<url> Request arrivals/departures using the API entry point at I<url>, defaults to C<< http://reiseauskunft.bahn.de/bin/bhftafel.exe >>. Note that the language and output selection suffix (e.g. "/dn") must not be included here. Again, see B<--list> for a list of known URLs. Unknown URLs are also supported, though note that B<--mot> will not work when using this opton. =item B<-V>, B<--version> Show version information. =back =head1 EXIT STATUS Zero unless things went wrong. =head1 CONFIGURATION None. =head1 DEPENDENCIES =over =item * Class::Accessor(3pm) =item * LWP::UserAgent(3pm) =item * XML::LibXML(3pm) =back =head1 BUGS AND LIMITATIONS The non-default services (anything other than DB) are not well tested. =head1 AUTHOR Copyright (C) 2015-2017 by Daniel Friesel E<lt>derf@finalrewind.orgE<gt> =head1 LICENSE This program is licensed under the same terms as Perl itself.