db-ris

#!/usr/bin/env perl
use strict;
use warnings;
use 5.010;

our $VERSION = '0.0';

use Getopt::Long;
use Travel::Status::DE::DeutscheBahn;

my ( $date, $time );
my $types = q{};
my %train_type;

binmode( STDOUT, ':encoding(utf-8)' );

GetOptions(
	'd|date=s' => \$date,
	'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,
);

for my $d ( $status->departures() ) {

	my ( @via, @via_main, @via_show );

	@via = $d->route;

	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}{};
	}

	printf(
		"%5s %-10s %-80s %-20s %-2s %s\n",
		$d->time, $d->train, join( q{  }, @via_show ),
		$d->destination, $d->platform, $d->info
	);
}

__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 E<lt>derf@finalrewind.orgE<gt>

=head1 LICENSE

This program is licensed under the same terms as Perl itself.