Unverified Commit fb5d3e66 authored by Birte Kristina Friesel's avatar Birte Kristina Friesel
Browse files

IRIS->new_p: Support with_related=>1

parent d0f6ffdb

lib/Travel/Status/DE/IRIS.pm

+82 −26
Original line number Original line Diff line number Diff line
@@ -31,6 +31,7 @@ sub try_load_xml { 
	return ( $tree, undef );

	return ( $tree, undef );

}

}





# "station" parameter must be an EVA or DS100 ID.

sub new_p {

sub new_p {

	my ( $class, %opt ) = @_;

	my ( $class, %opt ) = @_;

	my $promise = $opt{promise}->new;

	my $promise = $opt{promise}->new;
@@ -51,34 +52,90 @@ sub new_p { 
		$lookbehind_steps++;

		$lookbehind_steps++;

	}

	}





	$self->get_station_p(

	my @candidates = $opt{get_station}( $opt{station} );

		name => $opt{station},



	)->then(

	if ( @candidates == 0 ) {

		sub {

		return $promise->reject('station not found');

			my ($station) = @_;

	}

			$self->{station}          = $station;

	if ( @candidates >= 2 ) {

			$self->{related_stations} = [];

		return $promise->reject('station identifier is ambiguous');



	}

			my $dt_req = $self->{datetime}->clone;



			my @subreq

	$self->{station} = {

			  = ( $self->get_timetable_p( $self->{station}{uic}, $dt_req ) );

		ds100 => $candidates[0][0],

			for ( 1 .. $lookahead_steps ) {

		name  => $candidates[0][1],

				$dt_req->add( hours => 1 );

		uic   => $candidates[0][2],

				push( @subreq,

	};

					$self->get_timetable_p( $self->{station}{uic}, $dt_req ) );

	$self->{related_stations} = [];

			}



			$dt_req = $self->{datetime}->clone;

	my @queue = ( $self->{station}{uic} );

			for ( 1 .. $lookbehind_steps ) {

	my @related_reqs;

				$dt_req->subtract( hours => 1 );

	my @related_stations;

				push( @subreq,

	my %seen       = ( $self->{station}{uic} => 1 );

					$self->get_timetable_p( $self->{station}{uic}, $dt_req ) );

	my $iter_depth = 0;



	while ( @queue and $iter_depth < 12 and $opt{with_related} ) {

		my $eva = shift(@queue);

		$iter_depth++;

		for my $ref ( @{ $opt{meta}{$eva} // [] } ) {

			if ( not $seen{$ref} ) {

				push( @related_stations, $ref );

				$seen{$ref} = 1;

				push( @queue, $ref );

			}

			}

		}

	}



	for my $eva (@related_stations) {

		@candidates = $opt{get_station}( $opt{station} );





			return $self->{promise}->all(@subreq);

		if ( @candidates == 1 ) {

			push(

				@{ $self->{related_stations} },

				{

					ds100 => $candidates[0][0],

					name  => $candidates[0][1],

					uic   => $candidates[0][2],

				}

			);

		}

		}

	)->then(

	}



	my $dt_req = $self->{datetime}->clone;

	my @timetable_reqs

	  = ( $self->get_timetable_p( $self->{station}{uic}, $dt_req ) );



	for my $eva (@related_stations) {

		push( @timetable_reqs, $self->get_timetable_p( $eva, $dt_req ) );

	}



	for ( 1 .. $lookahead_steps ) {

		$dt_req->add( hours => 1 );

		push( @timetable_reqs,

			$self->get_timetable_p( $self->{station}{uic}, $dt_req ) );

		for my $eva (@related_stations) {

			push( @timetable_reqs, $self->get_timetable_p( $eva, $dt_req ) );

		}

	}



	$dt_req = $self->{datetime}->clone;

	for ( 1 .. $lookbehind_steps ) {

		$dt_req->subtract( hours => 1 );

		push( @timetable_reqs,

			$self->get_timetable_p( $self->{station}{uic}, $dt_req ) );

		for my $eva (@related_stations) {

			push( @timetable_reqs, $self->get_timetable_p( $eva, $dt_req ) );

		}

	}



	$self->{promise}->all(@timetable_reqs)->then(

		sub {

		sub {

			return $self->get_realtime_p;

			my @realtime_reqs

			  = ( $self->get_realtime_p( $self->{station}{uic} ) );

			for my $eva (@related_stations) {

				push( @realtime_reqs, $self->get_realtime_p( $eva, $dt_req ) );

			}

			return $self->{promise}->all(@realtime_reqs);

		}

		}

	)->then(

	)->then(

		sub {

		sub {
@@ -619,11 +676,10 @@ sub get_timetable { 
}

}





sub get_realtime_p {

sub get_realtime_p {

	my ($self) = @_;

	my ( $self, $eva ) = @_;





	my $promise = $self->{promise}->new;

	my $promise = $self->{promise}->new;





	my $eva = $self->{station}{uic};

	$self->get_with_cache_p( $self->{rt_cache},

	$self->get_with_cache_p( $self->{rt_cache},

		$self->{iris_base} . "/fchg/${eva}" )->then(

		$self->{iris_base} . "/fchg/${eva}" )->then(

		sub {

		sub {