#!/usr/bin/env perl use strict; use warnings; use 5.010; our $VERSION = '0.0'; use Getopt::Long; use List::Util qw(first max); use Travel::Status::DE::DeutscheBahn; my ( $date, $time ); my $types = q{}; my %train_type; my $filter_via; my @output; binmode( STDOUT, ':encoding(utf-8)' ); GetOptions( 'd|date=s' => \$date, 'v|via=s' => \$filter_via, 'm|mot=s' => \$types, 't|time=s' => \$time, ); 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, mot => \%train_type, station => shift, time => $time, ); 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}, ); } return; } for my $d ( $status->departures() ) { my ( @via, @via_main, @via_show ); @via = $d->route; if ( $filter_via and not( first { $_ =~ m{$filter_via}io } @via ) ) { next; } for my $stop (@via) { if ( $stop =~ m{ ?Hbf} ) { push( @via_main, $stop ); } } pop(@via); if ( @via_main and @via and $via[0] eq $via_main[0] ) { shift(@via_main); } if ( @via < 3 ) { @via_show = @via; } else { @via_show = splice( @via, 0, ( @via_main > 2 ? 1 : 3 - @via_main ) ); while ( @via_show < 3 and @via_main ) { my $stop = shift(@via_main); if ( $stop ~~ \@via_show or $stop eq $d->destination ) { next; } push( @via_show, $stop ); } } for my $stop (@via_show) { $stop =~ s{ ?Hbf}{}; } push( @output, [ $d->time, $d->train, join( q{ }, @via_show ), $d->destination, $d->platform, $d->info ] ); } display_result(@output); __END__ =head1 NAME =head1 SYNOPSIS =head1 VERSION version 0.0 =head1 DESCRIPTION =head1 OPTIONS =head1 EXIT STATUS =head1 CONFIGURATION =head1 DEPENDENCIES =head1 BUGS AND LIMITATIONS =head1 AUTHOR Copyright (C) 2010 by Daniel Friesel Ederf@finalrewind.orgE =head1 LICENSE This program is licensed under the same terms as Perl itself.