diff options
Diffstat (limited to 'bin/hafas-m')
| -rwxr-xr-x | bin/hafas-m | 246 |
1 files changed, 246 insertions, 0 deletions
diff --git a/bin/hafas-m b/bin/hafas-m new file mode 100755 index 0000000..cc78d26 --- /dev/null +++ b/bin/hafas-m @@ -0,0 +1,246 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use 5.010; + +our $VERSION = '1.05'; + +use Getopt::Long qw(:config no_ignore_case); +use List::Util qw(first max); +use Travel::Status::DE::HAFAS; + +my %train_type; + +my ( $date, $time ); +my $arrivals = 0; +my $ignore_late = 0; +my $types = q{}; +my $language; +my $developer_mode; + +my @output; + +binmode( STDOUT, ':encoding(utf-8)' ); + +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, + 't|time=s' => \$time, + 'V|version' => \&show_version, + 'devmode' => \$developer_mode, + +) or show_help(1); + +for my $type ( split( qr{,}, $types ) ) { + if ( substr( $type, 0, 1 ) eq q{!} ) { + $train_type{ substr( $type, 1 ) } = 0; + } + else { + $train_type{$type} = 1; + } +} + +my $status = Travel::Status::DE::HAFAS->new( + date => $date, + language => $language, + mot => \%train_type, + station => shift || show_help(1), + time => $time, + mode => $arrivals ? 'arr' : 'dep', + developer_mode => $developer_mode, +); + +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 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 $line->[5]; + } + print "\n"; + } + + return; +} + +if ( my $err = $status->errstr ) { + say STDERR "Request error: ${err}"; + exit 2; +} + +for my $d ( $status->results() ) { + + if ( $ignore_late and $d->delay ) { + next; + } + + push( + @output, + [ + $d->time, + $d->is_cancelled + ? 'CANCELED' + : ( $d->delay ? '+' . $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<-a>] [B<-d> I<date>] [B<-L>] [B<-m> I<motlist>] [B<-t> I<time>] +I<station> + +=head1 VERSION + +version 1.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 and B<-f> to list all stops between start end +I<station>, not I<station> and end. + +=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>). + +=item B<-L>, B<--ignore-late> + +Do not display delayed trains. + +=item B<-m>, B<--mot> I<motlist> + +Comma-separated list of modes of transport to show/hide. Accepts the following +arguments: + + ice InterCity Express trains + ic_ec InterCity / EuroCity trains + d InterRegio and similar + nv "Nahverkehr", RegionalExpress and such + s S-Bahn + bus + ferry + u U-Bahn + tram + +You can prefix an argument with "!" to hide it. The default is C<< +ice,ic_ec,d,nv,s >>. Note that B<-m> does not replace the default, so if you +only want to see S-Bahn and U-Bahn departures, you'd have to use C<< -m +!ice,!ic_ec,!d,!nv,u >>. + +=item B<-t>, B<--time> I<hh>:I<mm> + +Time to list departures for. Default: now. + +=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 + +Unknown. + +=head1 AUTHOR + +Copyright (C) 2015 by Daniel Friesel E<lt>derf@finalrewind.orgE<gt> + +=head1 LICENSE + +This program is licensed under the same terms as Perl itself. |