Squashed commit of the following: (556f2598) · Commits · derf / Travel-Status-DE-HAFAS

bin/db-ris→bin/hafas-m

+44 −60

Original line number	Diff line number	Diff line
		@@ -7,17 +7,16 @@ our $VERSION = '1.05';

		use Getopt::Long qw(:config no_ignore_case);
		use List::Util qw(first max);
		use Travel::Status::DE::DeutscheBahn;
		use Travel::Status::DE::HAFAS;

		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 $developer_mode;

		my @output;

		@@ -26,14 +25,13 @@ 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,
		'devmode' => \$developer_mode,

		) or show_help(1);

		@@ -46,27 +44,28 @@ for my $type ( split( qr{,}, $types ) ) {
		}
		}

		my $status = Travel::Status::DE::DeutscheBahn->new(
		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: db-ris [-d <dd.mm.yyyy>] [-m <motlist>] [-t <time>] '
		. "[-v <via>] <station>\n"
		. "See also: man db-ris\n";
		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 "db-ris version ${VERSION}";
		say "hafas-m version ${VERSION}";

		exit 0;
		}
		@@ -80,23 +79,28 @@ sub display_result {
		die("Nothing to show\n");
		}

		for my $i ( 0 .. 5 ) {
		for my $i ( 0 .. 4 ) {
		$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";
		my $d = $line->[6];
		if ( $d->messages ) {
		print "\n";
		for my $msg ( $d->messages ) {
		printf( "# %s\n", $msg );
		}
		}

		if ($show_full_route) {
		print "\n" . $line->[6] . "\n\n\n";
		printf(
		join( q{ }, ( map { "%-${_}s" } @line_length ) ),
		@{$line}[ 0 .. 4 ]
		);
		if ( $line->[5] ) {
		print $line->[5];
		}
		print "\n";
		}

		return;
		@@ -109,14 +113,6 @@ if ( my $err = $status->errstr ) {

		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;
		}
		@@ -125,14 +121,14 @@ for my $d ( $status->results() ) {
		@output,
		[
		$d->time,
		$d->is_cancelled
		? 'CANCELED'
		: ( $d->delay ? '+' . $d->delay : q{} ),
		$d->train,
		$arrivals ? q{} : join( q{ }, $d->route_interesting ),
		$d->route_end,
		$d->platform,
		( $d->platform // q{} ) . ( $d->is_changed_platform ? ' !' : q{} ),
		$d->info,
		join( "\n",
		map { sprintf( '%-5s %s', @{$_} ) } $d->route_timetable ),
		$d->route_info,
		$d
		]
		);
		}
		@@ -143,12 +139,12 @@ __END__

		=head1 NAME

		db-ris - Interface to the DeutscheBahn online departure monitor
		hafas-m - Interface to the DeutscheBahn/HAFAS 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>
		B<hafas-m> [B<-a>] [B<-d> I<date>] [B<-L>] [B<-m> I<motlist>] [B<-t> I<time>]
		I<station>

		=head1 VERSION

		@@ -156,8 +152,8 @@ 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>.
		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
		@@ -178,10 +174,6 @@ I<station>, not I<station> and end.

		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),
		@@ -215,13 +207,6 @@ only want to see S-Bahn and U-Bahn departures, you'd have to use C<< -m

		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.
		@@ -250,12 +235,11 @@ None.

		=head1 BUGS AND LIMITATIONS

		There are a few character encoding problems (most notably, B<--via> does not
		understand UTF-8 umlauts).
		Unknown.

		=head1 AUTHOR

		Copyright (C) 2011 by Daniel Friesel E<lt>derf@finalrewind.orgE<gt>
		Copyright (C) 2015 by Daniel Friesel E<lt>derf@finalrewind.orgE<gt>

		=head1 LICENSE

lib/Travel/Status/DE/DeutscheBahn.pm

+19 −314

Original line number	Diff line number	Diff line
		@@ -4,258 +4,16 @@ use strict;
		use warnings;
		use 5.010;

		no if $] >= 5.018, warnings => "experimental::smartmatch";

		use Carp qw(confess);
		use LWP::UserAgent;
		use POSIX qw(strftime);
		use Travel::Status::DE::DeutscheBahn::Result;
		use XML::LibXML;
		use parent 'Travel::Status::DE::HAFAS';

		our $VERSION = '1.05';

		sub new {
		my ( $obj, %conf ) = @_;
		my $date = strftime( '%d.%m.%Y', localtime(time) );
		my $time = strftime( '%H:%M', localtime(time) );

		my %lwp_options = %{ $conf{lwp_options} // { timeout => 10 } };

		my $ua = LWP::UserAgent->new(%lwp_options);

		$ua->env_proxy;

		my $reply;

		my $lang = $conf{language} // 'd';

		if ( not $conf{station} ) {
		confess('You need to specify a station');
		}

		my $ref = {
		mot_filter => [
		$conf{mot}->{ice} // 1,
		$conf{mot}->{ic_ec} // 1,
		$conf{mot}->{d} // 1,
		$conf{mot}->{nv} // 1,
		$conf{mot}->{s} // 1,
		$conf{mot}->{bus} // 0,
		$conf{mot}->{ferry} // 0,
		$conf{mot}->{u} // 0,
		$conf{mot}->{tram} // 0,
		],
		post => {
		advancedProductMode => q{},
		input => $conf{station},
		date => $conf{date} \|\| $date,
		time => $conf{time} \|\| $time,
		REQTrain_name => q{},
		start => 'yes',
		boardType => $conf{mode} // 'dep',

		# L => 'vs_java3',
		},
		};

		for my $i ( 0 .. @{ $ref->{mot_filter} } ) {
		if ( $ref->{mot_filter}->[$i] ) {
		$ref->{post}->{"GUIREQProduct_$i"} = 'on';
		}
		}

		bless( $ref, $obj );

		$reply
		= $ua->post(
		"http://reiseauskunft.bahn.de/bin/bhftafel.exe/${lang}n?rt=1",
		$ref->{post} );

		if ( $reply->is_error ) {
		$ref->{errstr} = $reply->status_line();
		return $ref;
		}

		$ref->{html} = $reply->content;

		$ref->{tree} = XML::LibXML->load_html(
		string => $ref->{html},
		recover => 2,
		suppress_errors => 1,
		suppress_warnings => 1,
		);

		$ref->check_input_error();

		return $ref;
		}

		sub new_from_html {
		my ( $obj, %opt ) = @_;

		my $ref = {
		html => $opt{html},
		post => { boardType => $opt{mode} // 'dep' }
		};

		$ref->{post}->{boardType} = $opt{mode} // 'dep';

		$ref->{tree} = XML::LibXML->load_html(
		string => $ref->{html},
		recover => 2,
		suppress_errors => 1,
		suppress_warnings => 1,
		);

		return bless( $ref, $obj );
		}

		sub check_input_error {
		my ($self) = @_;

		my $xp_errdiv = XML::LibXML::XPathExpression->new(
		'//div[@class = "errormsg leftMargin"]');
		my $xp_opts
		= XML::LibXML::XPathExpression->new('//select[@class = "error"]');
		my $xp_values = XML::LibXML::XPathExpression->new('./option');

		my $e_errdiv = ( $self->{tree}->findnodes($xp_errdiv) )[0];
		my $e_opts = ( $self->{tree}->findnodes($xp_opts) )[0];

		if ($e_errdiv) {
		$self->{errstr} = $e_errdiv->textContent;

		if ($e_opts) {
		my @nodes = ( $e_opts->findnodes($xp_values) );
		$self->{errstr}
		.= join( q{}, map { "\n" . $_->textContent } @nodes );
		}
		}

		return;
		}

		sub errstr {
		my ($self) = @_;

		return $self->{errstr};
		}

		sub get_node {
		my ( $parent, $name, $xpath, $index ) = @_;
		$index //= 0;

		my @nodes = $parent->findnodes($xpath);

		if ( $#nodes < $index ) {

		# called by map, so we must explicitly return undef.
		## no critic (Subroutines::ProhibitExplicitReturnUndef)
		return undef;
		}

		my $node = $nodes[$index];

		return $node->textContent;
		}

		sub results {
		my ($self) = @_;
		my $mode = $self->{post}->{boardType};

		my $xp_element = XML::LibXML::XPathExpression->new(
		"//table[\@class = \"result stboard ${mode}\"]/tr");
		my $xp_train_more = XML::LibXML::XPathExpression->new('./td[3]/a');

		# bhftafel.exe is not y2k1-safe
		my $re_morelink = qr{ date = (?<date> .. [.] .. [.] .. ) }x;

		my @parts = (
		[ 'time', './td[@class="time"]' ],
		[ 'train', './td[3]' ],
		[ 'route', './td[@class="route"]' ],
		[ 'dest', './td[@class="route"]//a' ],
		[ 'platform', './td[@class="platform"]' ],
		[ 'info', './td[@class="ris"]' ],
		[ 'routeinfo', './td[@class="route"]//span[@class="red bold"]' ],
		);
		my ( $class, %opt ) = @_;

		@parts = map { [ $_->[0], XML::LibXML::XPathExpression->new( $_->[1] ) ] }
		@parts;
		$opt{service} = 'deutschebahn';

		my $re_via = qr{
		^ \s* (?<stop> .+? ) \s* \n
		(?<time> \d{1,2}:\d{1,2} )
		}mx;

		if ( defined $self->{results} ) {
		return @{ $self->{results} };
		}
		if ( not defined $self->{tree} ) {
		return;
		}

		$self->{results} = [];

		for my $tr ( @{ $self->{tree}->findnodes($xp_element) } ) {

		my @via;
		my $first = 1;
		my ( $time, $train, $route, $dest, $platform, $info, $routeinfo )
		= map { get_node( $tr, @{$_} ) } @parts;
		my $e_train_more = ( $tr->findnodes($xp_train_more) )[0];

		if ( not( $time and $dest ) ) {
		next;
		}

		$e_train_more->getAttribute('href') =~ $re_morelink;

		my $date = $+{date};

		substr( $date, 6, 0 ) = '20';

		$platform //= q{};
		$info //= q{};
		$routeinfo //= q{};

		for my $str ( $time, $train, $dest, $platform, $info, $routeinfo ) {
		$str =~ s/\n/ /mg;
		$str =~ tr/ //s;
		$str =~ s/^ +//;
		$str =~ s/ +$//;
		}

		while ( $route =~ m{$re_via}g ) {
		if ($first) {
		$first = 0;
		next;
		}

		if ( $+{stop} =~ m{ [(] Halt \s entf.llt [)] }ox ) {
		next;
		}

		push( @via, [ $+{time}, $+{stop} ] );
		}

		push(
		@{ $self->{results} },
		Travel::Status::DE::DeutscheBahn::Result->new(
		date => $date,
		time => $time,
		train => $train,
		route_raw => $route,
		route => \@via,
		route_end => $dest,
		platform => $platform,
		info_raw => $info,
		routeinfo_raw => $routeinfo,
		)
		);
		}

		return @{ $self->{results} };
		return $class->SUPER::new(%opt);
		}

		1;
		@@ -264,14 +22,14 @@ __END__

		=head1 NAME

		Travel::Status::DE::DeutscheBahn - Interface to the DeutscheBahn online
		arrival/departure monitor
		Travel::Status::DE::HAFAS - Interface to HAFAS-based online arrival/departure
		monitors

		=head1 SYNOPSIS

		use Travel::Status::DE::DeutscheBahn;
		use Travel::Status::DE::HAFAS;

		my $status = Travel::Status::DE::DeutscheBahn->new(
		my $status = Travel::Status::DE::HAFAS->new(
		station => 'Essen Hbf',
		);

		@@ -296,7 +54,7 @@ version 1.05
		=head1 DESCRIPTION

		Travel::Status::DE::DeutscheBahn is an interface to the Deutsche Bahn
		arrival/departure monitor available at
		departure monitor available at
		L<http://reiseauskunft.bahn.de/bin/bhftafel.exe/dn>.

		It takes a station name and (optional) date and time and reports all arrivals
		@@ -310,67 +68,12 @@ unspecified).
		=item my $status = Travel::Status::DE::DeutscheBahn->new(I<%opts>)

		Requests the departures/arrivals as specified by I<opts> and returns a new
		Travel::Status::DE::DeutscheBahn element with the results. Dies if the wrong
		Travel::Status::DE::HAFAS element with the results. Dies if the wrong
		I<opts> were passed.

		Supported I<opts> are:

		=over

		=item B<station> => I<station>

		The train station to report for, e.g. "Essen HBf" or
		"Alfredusbad, Essen (Ruhr)". Mandatory.

		=item B<date> => I<dd>.I<mm>.I<yyyy>

		Date to report for. Defaults to the current day.

		=item B<language> => I<language>

		Set language for additional information. Accepted arguments: B<d>eutsch,
		B<e>nglish, B<i>talian, B<n> (dutch).

		=item B<lwp_options> => I<\%hashref>

		Passed on to C<< LWP::UserAgent->new >>. Defaults to C<< { timeout => 10 } >>,
		you can use an empty hashref to override it.

		=item B<time> => I<hh>:I<mm>

		Time to report for. Defaults to now.

		=item B<mode> => B<arr>\|B<dep>

		By default, Travel::Status::DE::DeutscheBahn reports train departures
		(B<dep>). Set this to B<arr> to get arrivals instead.

		=item B<mot> => I<\%hashref>

		Modes of transport to show. Accepted keys are: B<ice> (ICE trains), B<ic_ec>
		(IC and EC trains), B<d> (InterRegio and similarly fast trains), B<nv>
		("Nahverkehr", mostly RegionalExpress trains), B<s> ("S-Bahn"), B<bus>,
		B<ferry>, B<u> ("U-Bahn") and B<tram>.

		Setting a mode (as hash key) to 1 includes it, 0 excludes it. undef leaves it
		at the default.

		By default, the following are shown: ice, ic_ec, d, nv, s.

		=back

		=item $status->errstr

		In case of an error in the HTTP request, returns a string describing it. If
		no error occurred, returns undef.

		=item $status->results

		Returns a list of arrivals/departures. Each list element is a
		Travel::Status::DE::DeutscheBahn::Result(3pm) object.

		If no matching results were found or the parser / http request failed, returns
		undef.
		Calls Travel::Status::DE::HAFAS->new with service = DB. All I<opts> are passed
		on. Please see Travel::Status::DE::HAFAS(3pm) for I<opts> documentation
		and other methdos.

		=back

		@@ -386,21 +89,23 @@ None.

		=item * LWP::UserAgent(3pm)

		=item * Travel::Status::DE::HAFAS(3pm)

		=item * XML::LibXML(3pm)

		=back

		=head1 BUGS AND LIMITATIONS

		There are a few character encoding issues.
		Unknown.

		=head1 SEE ALSO

		Travel::Status::DE::DeutscheBahn::Result(3pm).
		Travel::Status::DE::HAFAS(3pm).

		=head1 AUTHOR

		Copyright (C) 2011 by Daniel Friesel E<lt>derf@finalrewind.orgE<gt>
		Copyright (C) 2015 by Daniel Friesel E<lt>derf@finalrewind.orgE<gt>

		=head1 LICENSE

lib/Travel/Status/DE/HAFAS.pm

0 → 100644

+346 −0

Original line number	Diff line number	Diff line
		package Travel::Status::DE::HAFAS;

		use strict;
		use warnings;
		use 5.010;

		no if $] >= 5.018, warnings => "experimental::smartmatch";

		use Carp qw(confess);
		use LWP::UserAgent;
		use POSIX qw(strftime);
		use Travel::Status::DE::HAFAS::Result;
		use XML::LibXML;

		our $VERSION = '1.05';

		sub new {
		my ( $obj, %conf ) = @_;

		my $date = $conf{date} // strftime( '%d.%m.%Y', localtime(time) );
		my $time = $conf{time} // strftime( '%H:%M', localtime(time) );
		my $lang = $conf{language} // 'd';
		my $mode = $conf{mode} // 'dep';
		my $service = $conf{service} // 'DB';

		my %lwp_options = %{ $conf{lwp_options} // { timeout => 10 } };

		my $ua = LWP::UserAgent->new(%lwp_options);

		$ua->env_proxy;

		my $reply;

		if ( not $conf{station} ) {
		confess('You need to specify a station');
		}

		my $ref = {
		active_service => $service,
		developer_mode => $conf{developer_mode},
		post => {
		input => $conf{station},
		date => $date,
		time => $time,
		start => 'yes', # value doesn't matter, just needs to be set
		boardType => $mode,
		L => 'vs_java3',
		},
		service => {
		DB => {
		url => 'http://reiseauskunft.bahn.de/bin/bhftafel.exe',
		name => 'Deutsche Bahn',
		productbits =>
		[qw[ice ic_ec d nv s bus ferry u tram ondemand x x x x]],
		}
		},
		};

		bless( $ref, $obj );

		$ref->set_productfilter;

		my $url = $ref->{service}{$service}{url} . '/' . $lang . 'n';

		$reply = $ua->post( $url, $ref->{post} );

		if ( $reply->is_error ) {
		$ref->{errstr} = $reply->status_line;
		return $ref;
		}

		# the interface does not return valid XML (but it's close!)
		$ref->{raw_xml}
		= '<?xml version="1.0" encoding="iso-8859-15"?><wrap>'
		. $reply->content
		. '</wrap>';

		if ( $ref->{developer_mode} ) {
		say $ref->{raw_xml};
		}

		$ref->{tree} = XML::LibXML->load_xml(
		string => $ref->{raw_xml},

		# recover => 2,
		# suppress_errors => 1,
		# suppress_warnings => 1,
		);

		if ( $ref->{developer_mode} ) {
		say $ref->{tree}->toString(1);
		}

		$ref->check_input_error;
		return $ref;
		}

		sub set_productfilter {
		my ($self) = @_;

		my $service = $self->{active_service};

		$self->{post}{productsFilter}
		= '1' x ( scalar @{ $self->{service}{$service}{productbits} } );
		}

		sub check_input_error {
		my ($self) = @_;

		my $xp_err = XML::LibXML::XPathExpression->new('//Err');
		my $err = ( $self->{tree}->findnodes($xp_err) )[0];

		if ($err) {
		$self->{errstr}
		= $err->getAttribute('text')
		. ' (code '
		. $err->getAttribute('code') . ')';
		}

		return;
		}

		sub errstr {
		my ($self) = @_;

		return $self->{errstr};
		}

		sub results {
		my ($self) = @_;
		my $mode = $self->{post}->{boardType};

		my $xp_element = XML::LibXML::XPathExpression->new('//Journey');
		my $xp_msg = XML::LibXML::XPathExpression->new('./HIMMessage');

		if ( defined $self->{results} ) {
		return @{ $self->{results} };
		}
		if ( not defined $self->{tree} ) {
		return;
		}

		$self->{results} = [];

		for my $tr ( @{ $self->{tree}->findnodes($xp_element) } ) {

		my @message_nodes = $tr->findnodes($xp_msg);
		my $train = $tr->getAttribute('prod');
		my $time = $tr->getAttribute('fpTime');
		my $date = $tr->getAttribute('fpDate');
		my $dest = $tr->getAttribute('targetLoc');
		my $platform = $tr->getAttribute('platform');
		my $new_platform = $tr->getAttribute('newpl');
		my $delay = $tr->getAttribute('delay');
		my $e_delay = $tr->getAttribute('e_delay');
		my $info = $tr->getAttribute('delayReason');
		my $routeinfo = $tr->textContent;
		my @messages;

		if ( not( $time and $dest ) ) {
		next;
		}

		for my $n (@message_nodes) {
		push( @messages, $n->getAttribute('header') );
		}

		substr( $date, 6, 0 ) = '20';

		$info //= q{};
		$routeinfo //= q{};

		$train =~ s{#.*$}{};

		push(
		@{ $self->{results} },
		Travel::Status::DE::HAFAS::Result->new(
		date => $date,
		raw_delay => $delay,
		raw_e_delay => $e_delay,
		messages => \@messages,
		time => $time,
		train => $train,
		route_end => $dest,
		platform => $platform,
		new_platform => $new_platform,
		info => $info,
		routeinfo_raw => $routeinfo,
		)
		);
		}

		return @{ $self->{results} };
		}

		# static
		sub get_services {
		}

		1;

		__END__

		=head1 NAME

		Travel::Status::DE::HAFAS - Interface to HAFAS-based online arrival/departure
		monitors

		=head1 SYNOPSIS

		use Travel::Status::DE::HAFAS;

		my $status = Travel::Status::DE::HAFAS->new(
		station => 'Essen Hbf',
		);

		if (my $err = $status->errstr) {
		die("Request error: ${err}\n");
		}

		for my $departure ($status->results) {
		printf(
		"At %s: %s to %s from platform %s\n",
		$departure->time,
		$departure->line,
		$departure->destination,
		$departure->platform,
		);
		}

		=head1 VERSION

		version 1.05

		=head1 DESCRIPTION

		Travel::Status::DE::HAFAS is an interface to HAFAS-based
		arrival/departure monitors, for instance the one available at
		L<http://reiseauskunft.bahn.de/bin/bhftafel.exe/dn>.

		It takes a station name and (optional) date and time and reports all arrivals
		or departures at that station starting at the specified point in time (now if
		unspecified).

		=head1 METHODS

		=over

		=item my $status = Travel::Status::DE::HAFAS->new(I<%opts>)

		Requests the departures/arrivals as specified by I<opts> and returns a new
		Travel::Status::DE::HAFAS element with the results. Dies if the wrong
		I<opts> were passed.

		Supported I<opts> are:

		=over

		=item B<station> => I<station>

		The train station to report for, e.g. "Essen HBf" or
		"Alfredusbad, Essen (Ruhr)". Mandatory.

		=item B<date> => I<dd>.I<mm>.I<yyyy>

		Date to report for. Defaults to the current day.

		=item B<language> => I<language>

		Set language for additional information. Accepted arguments: B<d>eutsch,
		B<e>nglish, B<i>talian, B<n> (dutch).

		=item B<lwp_options> => I<\%hashref>

		Passed on to C<< LWP::UserAgent->new >>. Defaults to C<< { timeout => 10 } >>,
		you can use an empty hashref to override it.

		=item B<time> => I<hh>:I<mm>

		Time to report for. Defaults to now.

		=item B<mode> => B<arr>\|B<dep>

		By default, Travel::Status::DE::HAFAS reports train departures
		(B<dep>). Set this to B<arr> to get arrivals instead.

		=item B<mot> => I<\%hashref>

		Modes of transport to show. Accepted keys are: B<ice> (ICE trains), B<ic_ec>
		(IC and EC trains), B<d> (InterRegio and similarly fast trains), B<nv>
		("Nahverkehr", mostly RegionalExpress trains), B<s> ("S-Bahn"), B<bus>,
		B<ferry>, B<u> ("U-Bahn") and B<tram>.

		Setting a mode (as hash key) to 1 includes it, 0 excludes it. undef leaves it
		at the default.

		By default, the following are shown: ice, ic_ec, d, nv, s.

		=back

		=item $status->errstr

		In case of an error in the HTTP request, returns a string describing it. If
		no error occurred, returns undef.

		=item $status->results

		Returns a list of arrivals/departures. Each list element is a
		Travel::Status::DE::HAFAS::Result(3pm) object.

		If no matching results were found or the parser / http request failed, returns
		undef.

		=back

		=head1 DIAGNOSTICS

		None.

		=head1 DEPENDENCIES

		=over

		=item * Class::Accessor(3pm)

		=item * LWP::UserAgent(3pm)

		=item * XML::LibXML(3pm)

		=back

		=head1 BUGS AND LIMITATIONS

		Unknown.

		=head1 SEE ALSO

		Travel::Status::DE::HAFAS::Result(3pm).

		=head1 AUTHOR

		Copyright (C) 2015 by Daniel Friesel E<lt>derf@finalrewind.orgE<gt>

		=head1 LICENSE

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

lib/Travel/Status/DE/DeutscheBahn/Result.pm→lib/Travel/Status/DE/HAFAS/Result.pm

+277 −0

File changed and moved.

Preview size limit exceeded, changes collapsed.

t/20-db.t

deleted100644 → 0

+0 −79

Original line number	Diff line number	Diff line
		#!/usr/bin/env perl
		use strict;
		use warnings;
		use 5.010;

		use File::Slurp qw(slurp);
		use Test::More tests => 98;

		BEGIN {
		use_ok('Travel::Status::DE::DeutscheBahn');
		}
		require_ok('Travel::Status::DE::DeutscheBahn');

		my $html = slurp('t/in/essen.html');

		my $status = Travel::Status::DE::DeutscheBahn->new_from_html(html => $html);

		isa_ok($status, 'Travel::Status::DE::DeutscheBahn');
		can_ok($status, qw(results));

		my @departures = $status->results;

		for my $departure (@departures) {
		isa_ok($departure, 'Travel::Status::DE::DeutscheBahn::Result');
		can_ok($departure, qw(date route_end destination origin info platform route
		route_raw time train));
		}

		is($departures[0]->date, '06.07.2011', 'first result: date ok');
		is($departures[0]->time, '19:21', 'first result: time ok');
		is($departures[0]->train, 'RE 10228', 'first result: train ok');
		is($departures[0]->destination, 'Duisburg Hbf', 'first result: destination ok');
		is($departures[0]->platform, '2', 'first result: platform ok');
		is($departures[0]->delay, 0, 'first result: delay ok');

		is($departures[-1]->time, '20:18', 'last result: time ok');
		is($departures[-1]->train, 'S 6', 'last result: train ok');
		is($departures[-1]->platform, '12', 'last result: platform ok');

		is($departures[8]->time, '19:31', '9th result: time ok');
		is($departures[8]->train, 'NWB75366', '9th result: train ok');
		is($departures[8]->info_raw, 'k.A.', '9th result: info_raw ok');
		is($departures[8]->info, q{}, '9th result: info ok');
		is($departures[8]->delay, undef, '9th result: delay ok');

		is($departures[15]->delay, 15, '16th result: delay ok');

		is_deeply([$departures[8]->route],
		['Essen-Borbeck', 'Bottrop Hbf', 'Gladbeck West', 'Gladbeck-Zweckel',
		'Feldhausen', 'Dorsten', 'Hervest-Dorsten', 'Deuten', 'Rhade',
		'Marbeck-Heiden', 'Borken(Westf)'], '9th result: route ok');

		is_deeply([$departures[8]->route_timetable],
		[
		['19:36', 'Essen-Borbeck'],
		['19:43', 'Bottrop Hbf'],
		['19:50', 'Gladbeck West'],
		['19:53', 'Gladbeck-Zweckel'],
		['19:56', 'Feldhausen'],
		['20:01', 'Dorsten'],
		['20:05', 'Hervest-Dorsten'],
		['20:10', 'Deuten'],
		['20:15', 'Rhade'],
		['20:21', 'Marbeck-Heiden'],
		['20:27', 'Borken(Westf)'],
		],
		'9th result: route_timetable ok');

		is_deeply([$departures[5]->route_interesting(3)],
		['Essen-Steele', 'Essen-Steele Ost', 'Bochum'],
		'6th result: route_interesting(3) ok');

		is_deeply([$departures[7]->route_interesting(3)],
		['Wattenscheid', 'Bochum', 'Dortmund'],
		'8th result: route_interesting(3) ok');

		is_deeply([$departures[10]->route_interesting(5)],
		[qw[Wattenscheid Bochum Witten Hagen]],
		'11th result: route_interesting(5) ok');

Admin message