diff options
Diffstat (limited to 'bin/db-ris')
| -rwxr-xr-x | bin/db-ris | 262 |
1 files changed, 0 insertions, 262 deletions
diff --git a/bin/db-ris b/bin/db-ris deleted file mode 100755 index 4c4fc33..0000000 --- a/bin/db-ris +++ /dev/null @@ -1,262 +0,0 @@ -#!/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::DeutscheBahn; - -my %train_type; - -my ( $date, $time ); -my $arrivals = 0; -my $filter_via; -my $ignore_late = 0; -my $show_full_route = 0; -my $types = q{}; -my $language; - -my @output; - -binmode( STDOUT, ':encoding(utf-8)' ); - -GetOptions( - 'a|arrivals' => \$arrivals, - 'd|date=s' => \$date, - 'f|full-route' => \$show_full_route, - 'h|help' => sub { show_help(0) }, - 'l|lang=s' => \$language, - 'L|ignore-late' => \$ignore_late, - 'm|mot=s' => \$types, - 't|time=s' => \$time, - 'v|via=s' => \$filter_via, - 'V|version' => \&show_version, - -) 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::DeutscheBahn->new( - date => $date, - language => $language, - mot => \%train_type, - station => shift || show_help(1), - time => $time, - mode => $arrivals ? 'arr' : 'dep', -); - -sub show_help { - my ($code) = @_; - - print 'Usage: db-ris [-d <dd.mm.yyyy>] [-m <motlist>] [-t <time>] ' - . "[-v <via>] <station>\n" - . "See also: man db-ris\n"; - - exit $code; -} - -sub show_version { - say "db-ris version ${VERSION}"; - - exit 0; -} - -sub display_result { - my (@lines) = @_; - - my @line_length; - - if ( not @lines ) { - die("Nothing to show\n"); - } - - for my $i ( 0 .. 5 ) { - $line_length[$i] = max map { length( $_->[$i] ) } @lines; - } - - for my $line (@lines) { - printf( - join( q{ }, ( map { "%-${_}s" } @line_length ) ) . "\n", - @{$line}[ 0 .. 5 ] - ); - - if ( $line->[7] ) { - print " " . $line->[7] . "\n"; - } - - if ($show_full_route) { - print "\n" . $line->[6] . "\n\n\n"; - } - } - - return; -} - -if ( my $err = $status->errstr ) { - say STDERR "Request error: ${err}"; - exit 2; -} - -for my $d ( $status->results() ) { - - my @via; - - @via = $d->route; - - if ( $filter_via and not( first { $_ =~ m{$filter_via}io } @via ) ) { - next; - } - - if ( $ignore_late and $d->delay ) { - next; - } - - push( - @output, - [ - $d->time, - $d->train, - $arrivals ? q{} : join( q{ }, $d->route_interesting ), - $d->route_end, - $d->platform, - $d->info, - join( "\n", - map { sprintf( '%-5s %s', @{$_} ) } $d->route_timetable ), - $d->route_info, - ] - ); -} - -display_result(@output); - -__END__ - -=head1 NAME - -db-ris - Interface to the DeutscheBahn online departure monitor - -=head1 SYNOPSIS - -B<db-ris> [B<-a>] [B<-d> I<date>] [B<-L>] [B<-m> I<motlist>] [B<-t> I<time>] -[B<-v> I<via>] I<station> - -=head1 VERSION - -version 1.05 - -=head1 DESCRIPTION - -db-ris is an interface to the DeutscheBahn departure monitor -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<-f>, B<--full-route> - -Display complete routes (including arrival times) of all trains. - -=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<--via> I<regex> - -Only display trains whose route (all stations between the current stop and the -destination) matches the perl regular expression I<regex>. The match is not -case-sensitive. Use '^regex$' to match a full string, but be aware that this -may not work as expected. - -=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 - -There are a few character encoding problems (most notably, B<--via> does not -understand UTF-8 umlauts). - -=head1 AUTHOR - -Copyright (C) 2011 by Daniel Friesel E<lt>derf@finalrewind.orgE<gt> - -=head1 LICENSE - -This program is licensed under the same terms as Perl itself. |