Skip to content
Snippets Groups Projects
DeutscheBahn.pm 6.40 KiB
package Travel::Status::DE::DeutscheBahn;

use strict;
use warnings;
use 5.010;

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

our $VERSION = '0.01';

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

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

	my $reply;

	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               => 'Suchen',
			boardType           => $conf{mode} // 'dep',
		},
	};

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

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

	if ( $reply->is_error ) {
		my $errstr = $reply->status_line();
		confess("Could not submit POST request: ${errstr}");
	}

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

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