DB: Switch to mgate.exe API (f3beaf2d) · Commits · derf / Travel-Status-DE-HAFAS

Changelog

+12 −0

Original line number	Diff line number	Diff line
		git HEAD

		* Use mgate.exe HAFAS interface by default. This introduces several
		breaking changes in hafas-m, Travel::Status::DE::HAFAS, and
		Travel::StatuS::DE::HAFAS::Result.
		* hafas-m: -l/--lang and -L/--ignore-late are no longer supported
		* Travel::Status::DE::HAFAS->new: "date" and "time" keys are no longer
		supported. Use "datetime" instead.
		* Travel::Status::DE::HAFAS->new: "lang" key is no longer supported.
		* Travel::Status::DE::HAFAS->new: "mode" key is no longer supported. Set
		"arrivals" to a true value to request arrivals instead of departures.

		Travel::Status::DE::DeutscheBahn 3.01 - Sat Jun 06 2020

		* Fix support for ÖBB and other backends which recently switched from

bin/hafas-m

+61 −42

Original line number	Diff line number	Diff line
		@@ -5,6 +5,7 @@ use 5.014;

		our $VERSION = '3.01';

		use DateTime;
		use Encode qw(decode);
		use Getopt::Long qw(:config no_ignore_case);
		use List::MoreUtils qw(uniq);
		@@ -13,9 +14,7 @@ use Travel::Status::DE::HAFAS;

		my ( $date, $time );
		my $arrivals = 0;
		my $ignore_late = 0;
		my $types = q{};
		my $language;
		my $developer_mode;
		my ( $list_services, $service, $hafas_url );
		my ( @excluded_mots, @exclusive_mots );
		@@ -31,8 +30,6 @@ GetOptions(
		'a\|arrivals' => \$arrivals,
		'd\|date=s' => \$date,
		'h\|help' => sub { show_help(0) },
		'l\|lang=s' => \$language,
		'L\|ignore-late' => \$ignore_late,
		'm\|mot=s' => \$types,
		's\|service=s' => \$service,
		't\|time=s' => \$time,
		@@ -53,19 +50,53 @@ if ($list_services) {

		parse_mot_options();

		my $status = Travel::Status::DE::HAFAS->new(
		date => $date,
		language => $language,
		my %opt = (
		excluded_mots => \@excluded_mots,
		exclusive_mots => \@exclusive_mots,
		station => shift \|\| show_help(1),
		time => $time,
		mode => $arrivals ? 'arr' : 'dep',
		arrivals => $arrivals,
		developer_mode => $developer_mode,
		service => $service,
		url => $hafas_url,
		);

		if ( $date or $time ) {
		my $dt = DateTime->now( time_zone => 'Europe/Berlin' );
		if ($date) {
		if ( $date
		=~ m{ ^ (?<day> \d{1,2} ) [.] (?<month> \d{1,2} ) [.] (?<year> \d{4})? $ }x
		)
		{
		$dt->set(
		day => $+{day},
		month => $+{month}
		);
		if ( $+{year} ) {
		$dt->set( year => $+{year} );
		}
		}
		else {
		say "--date must be specified as DD.MM.[YYYY]";
		exit 1;
		}
		}
		if ($time) {
		if ( $time =~ m{ ^ (?<hour> \d{1,2} ) : (?<minute> \d{1,2} ) $ }x ) {
		$dt->set(
		hour => $+{hour},
		minute => $+{minute}
		);
		}
		else {
		say "--time must be specified as HH:MM";
		exit 1;
		}
		}
		$opt{datetime} = $dt;
		}

		my $status = Travel::Status::DE::HAFAS->new(%opt);

		sub show_help {
		my ($code) = @_;

		@@ -176,7 +207,9 @@ sub display_result {

		if ( my $err = $status->errstr ) {
		say STDERR "Request error: ${err}";
		if ( $status->errcode and $status->errcode eq 'H730' ) {
		if ( $status->errcode
		and ( $status->errcode eq 'H730' or $status->errcode eq 'LOCATION' ) )
		{
		show_similar_stops();
		}
		exit 2;
		@@ -192,10 +225,6 @@ for my $m ( $status->messages ) {

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

		if ( $ignore_late and $d->delay ) {
		next;
		}

		my $info_line = $d->info // q{};

		for my $message ( $d->messages ) {
		@@ -207,7 +236,7 @@ for my $d ( $status->results ) {
		push(
		@output,
		[
		$d->sched_time,
		$d->sched_datetime->strftime('%H:%M'),
		$d->is_cancelled
		? 'CANCELED'
		: ( $d->delay ? sprintf( '%+d', $d->delay ) : q{} ),
		@@ -255,19 +284,10 @@ 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.

		=item B<-d>, B<--date> I<dd>.I<mm>.I<yyyy>
		=item B<-d>, B<--date> I<dd>.I<mm>.[I<yyyy>]

		Date to list departures for. Default: today.

		=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>), depending on the used service.

		=item B<-L>, B<--ignore-late>

		Do not display delayed trains.

		=item B<--list>

		List known HAFAS installations. A HAFAS service from this list can be querie
		@@ -300,8 +320,7 @@ Time to list departures for. Default: now.

		=item B<-u>, B<--url> I<url>

		Request arrivals/departures using the API entry point at I<url>. Note that the
		language and output selection suffix (e.g. "/dn") must not be included here.
		Request arrivals/departures using the API entry point at I<url>.
		Note that B<--mot> will not work when using this opton.

		=item B<-V>, B<--version>

lib/Travel/Status/DE/HAFAS.pm

+278 −57

Original line number	Diff line number	Diff line
		@@ -10,6 +10,9 @@ no if $] >= 5.018, warnings => 'experimental::smartmatch';
		use Carp qw(confess);
		use DateTime;
		use DateTime::Format::Strptime;
		use Digest::MD5 qw(md5_hex);
		use Encode qw(decode encode);
		use JSON;
		use List::Util qw(any);
		use LWP::UserAgent;
		use POSIX qw(strftime);
		@@ -33,9 +36,24 @@ my %hafas_instance = (
		stopfinder => 'https://reiseauskunft.bahn.de/bin/ajax-getstop.exe',
		trainsearch => 'https://reiseauskunft.bahn.de/bin/trainsearch.exe',
		traininfo => 'https://reiseauskunft.bahn.de/bin/traininfo.exe',
		mgate => 'https://reiseauskunft.bahn.de/bin/mgate.exe',
		name => 'Deutsche Bahn',
		productbits =>
		[qw[ice ic_ec d regio s bus ferry u tram ondemand x x x x]],
		productbits => [qw[ice ic_ec d regio s bus ferry u tram ondemand]],
		salt => 'bdI8UVj4' . '0K5fvxwf',
		request => {
		client => {
		id => 'DB',
		v => '20100000',
		type => 'IPH',
		name => 'DB Navigator',
		},
		ext => 'DB.R21.12.a',
		ver => '1.15',
		auth => {
		type => 'AID',
		aid => 'n91dB8Z77MLdoR0K'
		},
		},
		},
		NAHSH => {
		url => 'https://nah.sh.hafas.de/bin/stboard.exe',
		@@ -94,11 +112,6 @@ my %hafas_instance = (

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

		my %lwp_options = %{ $conf{lwp_options} // { timeout => 10 } };
		@@ -107,14 +120,12 @@ sub new {

		$ua->env_proxy;

		my $reply;

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

		if ( not defined $service and not defined $conf{url} ) {
		$service = 'DB';
		$service = $conf{service} = 'DB';
		}

		if ( defined $service and not exists $hafas_instance{$service} ) {
		@@ -123,6 +134,7 @@ sub new {

		my $ref = {
		active_service => $service,
		arrivals => $conf{arrivals},
		developer_mode => $conf{developer_mode},
		exclusive_mots => $conf{exclusive_mots},
		excluded_mots => $conf{excluded_mots},
		@@ -130,41 +142,172 @@ sub new {
		results => [],
		station => $conf{station},
		ua => $ua,
		post => {
		now => DateTime->now( time_zone => 'Europe/Berlin' ),
		};

		bless( $ref, $obj );

		if ( $hafas_instance{$service}{mgate} ) {
		return $ref->new_mgate(%conf);
		}
		return $ref->new_legacy(%conf);
		}

		sub new_mgate {
		my ( $self, %conf ) = @_;
		my $json = JSON->new->utf8;
		my $service = $conf{service};

		my $now = $self->{now};
		my $date = ( $conf{datetime} // $now )->strftime('%Y%m%d');
		my $time = ( $conf{datetime} // $now )->strftime('%H%M%S');

		my $lid;
		if ( $self->{station} =~ m{ ^ [0-9]+ $ }x ) {
		$lid = 'A=1@L=' . $self->{station} . '@';
		}
		else {
		$lid = 'A=1@O=' . $self->{station} . '@';
		}

		my $mot_mask = 1023;

		my %mot_pos;
		for my $i ( 0 .. $#{ $hafas_instance{$service}{productbits} } ) {
		$mot_pos{ $hafas_instance{$service}{productbits}[$i] } = $i;
		}

		if ( my @mots = @{ $self->{exclusive_mots} // [] } ) {
		$mot_mask = 0;
		for my $mot (@mots) {
		$mot_mask \|= 1 << $mot_pos{$mot};
		}
		}

		if ( my @mots = @{ $self->{excluded_mots} // [] } ) {
		for my $mot (@mots) {
		$mot_mask &= ~( 1 << $mot_pos{$mot} );
		}
		}

		my $req = {
		svcReqL => [
		{
		req => {
		type => ( $conf{arrivals} ? 'ARR' : 'DEP' ),
		stbLoc => { lid => $lid },
		dirLoc => undef,
		maxJny => 30,
		date => $date,
		time => $time,
		dur => -1,
		jnyFltrL =>
		[ { type => "PROD", mode => "INC", value => $mot_mask } ]
		},
		meth => 'StationBoard'
		}
		],
		client => {
		id => 'DB',
		v => '20100000',
		type => 'IPH',
		name => 'DB Navigator'
		},
		ext => 'DB.R21.12.a',
		ver => '1.15',
		auth => {
		type => 'AID',
		'aid' => 'n91dB8Z77MLdoR0K'
		}
		};

		$req = $json->encode($req);
		$self->{post} = $req;

		my $url = $conf{url} // $hafas_instance{$service}{mgate};

		if ( my $salt = $hafas_instance{$service}{salt} ) {
		$url .= '?checksum=' . md5_hex( $self->{post} . $salt );
		}

		if ( $conf{json} ) {
		$self->{raw_json} = $conf{json};
		}
		else {
		if ( $self->{developer_mode} ) {
		say "requesting $req from $url";
		}

		my $reply = $self->{ua}->post(
		$url,
		'Content-Type' => 'application/json',
		Content => $self->{post}
		);
		if ( $reply->is_error ) {
		$self->{errstr} = $reply->status_line;
		return $self;
		}

		if ( $self->{developer_mode} ) {
		say decode( 'utf-8', $reply->content );
		}

		$self->{raw_json} = $json->decode( $reply->content );
		}

		$self->check_mgate;
		$self->parse_mgate;

		return $self;
		}

		sub new_legacy {
		my ( $self, %conf ) = @_;

		my $now = $self->{now};
		my $date = ( $conf{datetime} // $now )->strftime('%d.%m.%Y');
		my $time = ( $conf{datetime} // $now )->strftime('%H:%M');
		my $mode = $conf{arrivals} ? 'arr' : 'dep';
		my $lang = 'd';
		my $service = $conf{service};

		$self->{post} = {
		input => $conf{station},
		date => $date,
		time => $time,
		start => 'yes', # value doesn't matter, just needs to be set
		boardType => $mode,
		L => 'vs_java3',
		},
		};

		bless( $ref, $obj );

		$ref->set_productfilter;
		$self->set_productfilter;

		my $url = ( $conf{url} // $hafas_instance{$service}{url} ) . "/${lang}n";

		if ( $conf{xml} ) {
		$ref->{raw_xml} = $conf{xml};

		# used for testing
		$self->{raw_xml} = $conf{xml};
		}
		else {
		$reply = $ua->post( $url, $ref->{post} );
		if ( $self->{developer_mode} ) {
		say "requesting from $url";
		}
		my $reply = $self->{ua}->post( $url, $self->{post} );

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

		$ref->{raw_xml} = $reply->content;
		$self->{raw_xml} = $reply->content;
		}

		# the interface often does not return valid XML (but it's close!)
		if ( substr( $ref->{raw_xml}, 0, 5 ) ne '<?xml' ) {
		$ref->{raw_xml}
		if ( substr( $self->{raw_xml}, 0, 5 ) ne '<?xml' ) {
		$self->{raw_xml}
		= '<?xml version="1.0" encoding="iso-8859-15"?><wrap>'
		. $ref->{raw_xml}
		. $self->{raw_xml}
		. '</wrap>';
		}

		@@ -172,7 +315,7 @@ sub new {

		# Returns invalid XML with tags inside HIMMessage's lead attribute.
		# Fix this.
		$ref->{raw_xml}
		$self->{raw_xml}
		=~ s{ lead = " \K ( [^"]+ ) }{ $1 =~ s{ < [^>]+ > }{}grx }egx;
		}

		@@ -180,23 +323,23 @@ sub new {
		# errors in delay="...") when setting the language to dutch/italian.
		# No, I don't know why.

		eval { $ref->{tree} = XML::LibXML->load_xml( string => $ref->{raw_xml} ) };
		eval { $self->{tree} = XML::LibXML->load_xml( string => $self->{raw_xml} ) };

		if ( my $err = $@ ) {
		if ( $ref->{developer_mode} ) {
		say $ref->{raw_xml};
		if ( $self->{developer_mode} ) {
		say $self->{raw_xml};
		}
		$ref->{errstr} = "Backend returned invalid XML: $err";
		return $ref;
		$self->{errstr} = "Backend returned invalid XML: $err";
		return $self;
		}

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

		$ref->check_input_error;
		$ref->prepare_results;
		return $ref;
		$self->check_input_error;
		$self->prepare_results;
		return $self;
		}

		sub set_productfilter {
		@@ -254,7 +397,26 @@ sub check_input_error {
		$self->{errcode} = $err->getAttribute('code');
		}

		return;
		return $self;
		}

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

		if ( $self->{raw_json}{cInfo}{code} ne 'OK' ) {
		$self->{errstr} = 'cInfo code is ' . $self->{raw_json}{cInfo}{code};
		$self->{errcode} = $self->{raw_json}{cInfo}{code};
		}
		elsif ( @{ $self->{raw_json}{svcResL} // [] } == 0 ) {
		$self->{errstr} = 'svcResL is empty';
		}
		elsif ( $self->{raw_json}{svcResL}[0]{err} ne 'OK' ) {
		$self->{errstr}
		= 'svcResL[0].err is ' . $self->{raw_json}{svcResL}[0]{err};
		$self->{errcode} = $self->{raw_json}{svcResL}[0]{err};
		}

		return $self;
		}

		sub errcode {
		@@ -289,7 +451,7 @@ sub similar_stops {
		$self->{errstr} = $err;
		return;
		}
		return $sf->results;
		return $self->results;
		}
		return;
		}
		@@ -333,9 +495,6 @@ sub prepare_results {

		$self->{results} = [];

		$self->{datetime_now} //= DateTime->now(
		time_zone => 'Europe/Berlin',
		);
		$self->{strptime_obj} //= DateTime::Format::Strptime->new(
		pattern => '%d.%m.%YT%H:%M',
		time_zone => 'Europe/Berlin',
		@@ -388,13 +547,11 @@ sub prepare_results {
		push(
		@{ $self->{results} },
		Travel::Status::DE::HAFAS::Result->new(
		sched_date => $date,
		sched_datetime => $datetime,
		datetime_now => $self->{datetime_now},
		datetime_now => $self->{now},
		raw_delay => $delay,
		raw_e_delay => $e_delay,
		messages => \@messages,
		sched_time => $time,
		train => $train,
		operator => $operator,
		route_end => $dest,
		@@ -404,6 +561,74 @@ sub prepare_results {
		)
		);
		}
		return $self;
		}

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

		$self->{results} = [];

		if ( $self->{errstr} ) {
		return $self;
		}

		$self->{strptime_obj} //= DateTime::Format::Strptime->new(
		pattern => '%Y%m%dT%H%M%S',
		time_zone => 'Europe/Berlin',
		);

		my @locL = @{ $self->{raw_json}{svcResL}[0]{res}{common}{locL} // [] };
		my @prodL = @{ $self->{raw_json}{svcResL}[0]{res}{common}{prodL} // [] };
		my @opL = @{ $self->{raw_json}{svcResL}[0]{res}{common}{opL} // [] };
		my @icoL = @{ $self->{raw_json}{svcResL}[0]{res}{common}{icoL} // [] };
		my @jnyL = @{ $self->{raw_json}{svcResL}[0]{res}{jnyL} // [] };

		for my $result (@jnyL) {
		my $date = $result->{date};
		my $time_s
		= $result->{stbStop}{ $self->{arrivals} ? 'aTimeS' : 'dTimeS' };
		my $time_r
		= $result->{stbStop}{ $self->{arrivals} ? 'aTimeR' : 'dTimeR' };
		my $datetime_s
		= $self->{strptime_obj}->parse_datetime("${date}T${time_s}");
		my $datetime_r
		= $time_r
		? $self->{strptime_obj}->parse_datetime("${date}T${time_r}")
		: undef;
		my $delay
		= $datetime_r
		? ( $datetime_r->epoch - $datetime_s->epoch ) / 60
		: undef;

		my $destination = $result->{dirTxt};
		my $is_cancelled = $result->{isCncl};
		my $jid = $result->{jid};
		my $platform = $result->{stbStop}{dPlatfS};
		my $new_platform = $result->{stbStop}{dPlatfR};

		my $product = $prodL[ $result->{prodX} ];
		my $train = $product->{prodCtx}{name};
		my $train_type = $product->{prodCtx}{catOutS};
		my $line_no = $product->{prodCtx}{line};

		push(
		@{ $self->{results} },
		Travel::Status::DE::HAFAS::Result->new(
		sched_datetime => $datetime_s,
		rt_datetime => $datetime_r,
		datetime => $datetime_r // $datetime_s,
		datetime_now => $self->{now},
		delay => $delay,
		is_cancelled => $is_cancelled,
		train => $train,
		route_end => $destination,
		platform => $platform,
		new_platform => $new_platform,
		)
		);
		}
		return $self;
		}

		sub results {
		@@ -505,9 +730,9 @@ Supported I<opts> are:
		The station or stop to report for, e.g. "Essen HBf" or
		"Alfredusbad, Essen (Ruhr)". Mandatory.

		=item B<date> => I<dd>.I<mm>.I<yyyy>
		=item B<datetime> => I<DateTime object>

		Date to report for. Defaults to the current day.
		Date and time to report for. Defaults to now.

		=item B<excluded_mots> => [I<mot1>, I<mot2>, ...]

		@@ -547,10 +772,6 @@ Request results from I<service>, defaults to "DB".
		See B<get_services> (and C<< hafas-m --list >>) for a list of supported
		services.

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

		Time to report for. Defaults to now.

		=item B<url> => I<url>

		Request results from I<url>, defaults to the one belonging to B<service>.

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

+8 −33

Original line number	Diff line number	Diff line
		@@ -11,8 +11,8 @@ use parent 'Class::Accessor';
		our $VERSION = '3.01';

		Travel::Status::DE::HAFAS::Result->mk_ro_accessors(
		qw(sched_date date sched_datetime datetime info operator raw_e_delay
		raw_delay sched_time time train route_end)
		qw(sched_date date sched_datetime datetime info is_cancelled operator delay
		sched_time time train route_end)
		);

		sub new {
		@@ -21,17 +21,16 @@ sub new {
		my $ref = \%conf;
		bless( $ref, $obj );

		if ( my $delay = $ref->delay ) {
		$ref->{datetime}
		= $ref->{sched_datetime}->clone->add( minutes => $delay );
		$ref->{date} = $ref->{datetime}->strftime('%d.%m.%Y');
		$ref->{time} = $ref->{datetime}->strftime('%H:%M');
		if ( $ref->{delay} ) {
		$ref->{datetime} = $ref->{rt_datetime};
		}
		else {
		$ref->{datetime} = $ref->{sched_datetime};
		$ref->{date} = $ref->{sched_date};
		$ref->{time} = $ref->{sched_time};
		}
		$ref->{date} = $ref->{datetime}->strftime('%d.%m.%Y');
		$ref->{time} = $ref->{datetime}->strftime('%H:%M');
		$ref->{sched_date} = $ref->{sched_datetime}->strftime('%d.%m.%Y');
		$ref->{sched_time} = $ref->{sched_datetime}->strftime('%H:%M');

		return $ref;
		}
		@@ -56,21 +55,6 @@ sub countdown_sec {
		return $self->{countdown_sec};
		}

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

		if ( defined $self->{raw_e_delay} ) {
		return $self->{raw_e_delay};
		}
		if ( defined $self->{raw_delay}
		and $self->{raw_delay} ne q{-}
		and $self->{raw_delay} ne 'cancel' )
		{
		return $self->{raw_delay};
		}
		return;
		}

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

		@@ -83,15 +67,6 @@ sub line {
		return $self->{train};
		}

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

		if ( $self->{raw_delay} and $self->{raw_delay} eq 'cancel' ) {
		return 1;
		}
		return 0;
		}

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

t/20-db.t

+56 −60

Original line number	Diff line number	Diff line
		@@ -6,16 +6,18 @@ use 5.020;
		use utf8;

		use File::Slurp qw(read_file);
		use Test::More tests => 67;
		use JSON;
		use Test::More tests => 61;

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

		my $xml = read_file('t/in/DB.Berlin Jannowitzbrücke.xml');
		my $json
		= JSON->new->utf8->decode( read_file('t/in/DB.Berlin Jannowitzbrücke.json') );

		my $status = Travel::Status::DE::HAFAS->new(
		service => 'DB',
		station => 'Berlin Jannowitzbrücke',
		xml => $xml
		json => $json
		);

		is( $status->errcode, undef, 'no error code' );
		@@ -27,69 +29,65 @@ is(
		'active service name'
		);

		is( scalar $status->results, 73, 'number of results' );
		is( scalar $status->results, 30, 'number of results' );

		my @results = $status->results;

		# Result 0: S-Bahn
		# Result 0: Bus

		is( $results[0]->date, '13.06.2020', 'result 0: date' );
		is( $results[0]->date, '02.10.2022', 'result 0: date' );
		is(
		$results[0]->datetime->strftime('%Y%m%d %H%M%S'),
		'20200613 141700',
		'20221002 170500',
		'result 0: datetime'
		);
		is( $results[0]->delay, 2, 'result 0: delay' );
		is( $results[0]->info, undef, 'result 0: no info' );
		is( $results[0]->delay, 10, 'result 0: delay' );
		ok( !$results[0]->is_cancelled, 'result 0: not cancelled' );
		ok( !$results[0]->is_changed_platform, 'result 0: platform not changed' );
		is( scalar $results[0]->messages, 0, 'result 0: no messages' );

		for my $res ( $results[0]->line, $results[0]->train ) {
		is( $res, 'S 5', 'result 0: line/train' );
		is( $res, 'Bus 300', 'result 0: line/train' );
		}
		for my $res ( $results[0]->line_no, $results[0]->train_no ) {
		is( $res, 5, 'result 0: line/train number' );
		is( $res, 300, 'result 0: line/train number' );
		}

		is( $results[0]->operator, undef, 'result 0: no operator' );
		is( $results[0]->platform, '4', 'result 0: platform' );
		is( $results[0]->platform, undef, 'result 0: platform' );

		for my $res ( $results[0]->route_end, $results[0]->destination,
		$results[0]->origin )
		{
		is( $res, 'Berlin Westkreuz', 'result 0: route start/end' );
		is( $res, 'Tiergarten, Philharmonie', 'result 0: route start/end' );
		}

		is( $results[0]->sched_date, '13.06.2020', 'result 0: sched_date' );
		is( $results[0]->sched_date, '02.10.2022', 'result 0: sched_date' );
		is(
		$results[0]->sched_datetime->strftime('%Y%m%d %H%M%S'),
		'20200613 141500',
		'20221002 165500',
		'result 0: sched_datetime'
		);
		is( $results[0]->sched_time, '14:15', 'result 0: sched_time' );
		is( $results[0]->time, '14:17', 'result 0: time' );
		is( $results[0]->type, 'S', 'result 0: type' );
		is( $results[0]->sched_time, '16:55', 'result 0: sched_time' );
		is( $results[0]->time, '17:05', 'result 0: time' );
		is( $results[0]->type, 'Bus', 'result 0: type' );

		# Result 2: Bus
		# Result 2: U-Bahn

		is( $results[2]->date, '13.06.2020', 'result 2: date' );
		is( $results[2]->date, '02.10.2022', 'result 2: date' );
		is(
		$results[2]->datetime->strftime('%Y%m%d %H%M%S'),
		'20200613 141700',
		'20221002 170000',
		'result 2: datetime'
		);
		is( $results[2]->delay, 0, 'result 2: delay' );
		is( $results[2]->info, undef, 'result 2: no info' );
		ok( !$results[2]->is_cancelled, 'result 2: not cancelled' );
		ok( !$results[2]->is_changed_platform, 'result 2: platform not changed' );
		is( scalar $results[2]->messages, 0, 'result 2: no messages' );

		for my $res ( $results[2]->line, $results[2]->train ) {
		is( $res, 'Bus 300', 'result 2: line/train' );
		is( $res, 'U 8', 'result 2: line/train' );
		}
		for my $res ( $results[2]->line_no, $results[2]->train_no ) {
		is( $res, 300, 'result 2: line/train number' );
		is( $res, 8, 'result 2: line/train number' );
		}

		is( $results[2]->operator, undef, 'result 2: no operator' );
		@@ -98,55 +96,53 @@ is( $results[2]->platform, undef, 'result 2: no platform' );
		for my $res ( $results[2]->route_end, $results[2]->destination,
		$results[2]->origin )
		{
		is( $res, 'Warschauer Str. (S+U), Berlin', 'result 2: route start/end' );
		is( $res, 'Hermannstr. (S+U), Berlin', 'result 2: route start/end' );
		}

		is( $results[2]->sched_date, '13.06.2020', 'result 2: sched_date' );
		is( $results[2]->sched_date, '02.10.2022', 'result 2: sched_date' );
		is(
		$results[2]->sched_datetime->strftime('%Y%m%d %H%M%S'),
		'20200613 141700',
		'20221002 170000',
		'result 2: sched_datetime'
		);
		is( $results[2]->sched_time, '14:17', 'result 2: sched_time' );
		is( $results[2]->time, '14:17', 'result 2: time' );
		is( $results[2]->type, 'Bus', 'result 2: type' );
		is( $results[2]->sched_time, '17:00', 'result 2: sched_time' );
		is( $results[2]->time, '17:00', 'result 2: time' );
		is( $results[2]->type, 'U', 'result 2: type' );

		# Result 6: U-Bahn
		# Result 3: S-Bahn

		is( $results[6]->date, '13.06.2020', 'result 6: date' );
		is( $results[3]->date, '02.10.2022', 'result 3: date' );
		is(
		$results[6]->datetime->strftime('%Y%m%d %H%M%S'),
		'20200613 142100',
		'result 6: datetime'
		$results[3]->datetime->strftime('%Y%m%d %H%M%S'),
		'20221002 170100',
		'result 3: datetime'
		);
		is( $results[6]->delay, 1, 'result 6: delay' );
		is( $results[6]->info, undef, 'result 6: no info' );
		ok( !$results[6]->is_cancelled, 'result 6: not cancelled' );
		ok( !$results[6]->is_changed_platform, 'result 6: platform not changed' );
		is( scalar $results[6]->messages, 0, 'result 6: no messages' );

		for my $res ( $results[6]->line, $results[6]->train ) {
		is( $res, 'U 8', 'result 6: line/train' );
		is( $results[3]->delay, 0, 'result 3: delay' );
		ok( !$results[3]->is_cancelled, 'result 3: not cancelled' );
		ok( !$results[3]->is_changed_platform, 'result 3: platform not changed' );

		for my $res ( $results[3]->line, $results[3]->train ) {
		is( $res, 'S 3', 'result 3: line/train' );
		}
		for my $res ( $results[6]->line_no, $results[6]->train_no ) {
		is( $res, 8, 'result 6: line/train number' );
		for my $res ( $results[3]->line_no, $results[3]->train_no ) {
		is( $res, 3, 'result 3: line/train number' );
		}

		is( $results[6]->operator, undef, 'result 6: no operator' );
		is( $results[6]->platform, undef, 'result 6: no platform' );
		is( $results[3]->operator, undef, 'result 3: no operator' );
		is( $results[3]->platform, 4, 'result 3: platform' );

		for my $res ( $results[6]->route_end, $results[6]->destination,
		$results[6]->origin )
		for my $res ( $results[3]->route_end, $results[3]->destination,
		$results[3]->origin )
		{
		is( $res, 'Paracelsus-Bad (U), Berlin', 'result 6: route start/end' );
		is( $res, 'Berlin-Spandau (S)', 'result 3: route start/end' );
		}

		is( $results[6]->sched_date, '13.06.2020', 'result 6: sched_date' );
		is( $results[3]->sched_date, '02.10.2022', 'result 3: sched_date' );
		is(
		$results[6]->sched_datetime->strftime('%Y%m%d %H%M%S'),
		'20200613 142000',
		'result 6: sched_datetime'
		$results[3]->sched_datetime->strftime('%Y%m%d %H%M%S'),
		'20221002 170100',
		'result 3: sched_datetime'
		);
		is( $results[6]->sched_time, '14:20', 'result 6: sched_time' );
		is( $results[6]->time, '14:21', 'result 6: time' );
		is( $results[6]->type, 'U', 'result 6: type' );
		is( $results[3]->sched_time, '17:01', 'result 3: sched_time' );
		is( $results[3]->time, '17:01', 'result 3: time' );
		is( $results[3]->type, 'S', 'result 3: type' );

Admin message