prepare async support. TODO: meta / related station handling

1 files changed, 231 insertions, 0 deletions

diff --git a/lib/Travel/Status/DE/IRIS.pm b/lib/Travel/Status/DE/IRIS.pm
index f46cb2b..1c21339 100644
--- a/lib/Travel/Status/DE/IRIS.pm
+++ b/lib/Travel/Status/DE/IRIS.pm
@@ -31,6 +31,72 @@ sub try_load_xml {
 	return ( $tree, undef );
 }
 
+sub new_p {
+	my ( $class, %opt ) = @_;
+	my $promise = $opt{promise}->new;
+
+	if ( not $opt{station} ) {
+		return $promise->reject('station flag must be passed');
+	}
+
+	my $self = $class->new( %opt, async => 1 );
+	$self->{promise} = $opt{promise};
+
+	my $lookahead_steps = int( $self->{lookahead} / 60 );
+	if ( ( 60 - $self->{datetime}->minute ) < ( $self->{lookahead} % 60 ) ) {
+		$lookahead_steps++;
+	}
+	my $lookbehind_steps = int( $self->{lookbehind} / 60 );
+	if ( $self->{datetime}->minute < ( $self->{lookbehind} % 60 ) ) {
+		$lookbehind_steps++;
+	}
+
+	$self->get_station_p(
+		name => $opt{station},
+	)->then(
+		sub {
+			my ($station) = @_;
+			$self->{station}          = $station;
+			$self->{related_stations} = [];
+
+			my $dt_req = $self->{datetime}->clone;
+			my @subreq
+			  = ( $self->get_timetable_p( $self->{station}{uic}, $dt_req ) );
+			for ( 1 .. $lookahead_steps ) {
+				$dt_req->add( hours => 1 );
+				push( @subreq,
+					$self->get_timetable_p( $self->{station}{uic}, $dt_req ) );
+			}
+			$dt_req = $self->{datetime}->clone;
+			for ( 1 .. $lookbehind_steps ) {
+				$dt_req->subtract( hours => 1 );
+				push( @subreq,
+					$self->get_timetable_p( $self->{station}{uic}, $dt_req ) );
+			}
+
+			return $self->{promise}->all(@subreq);
+		}
+	)->then(
+		sub {
+			return $self->get_realtime_p;
+		}
+	)->then(
+		sub {
+			$self->postprocess_results;
+			$promise->resolve($self);
+			return;
+		}
+	)->catch(
+		sub {
+			my ($err) = @_;
+			$promise->reject($err);
+			return;
+		}
+	)->wait;
+
+	return $promise;
+}
+
 sub new {
 	my ( $class, %opt ) = @_;
 
@@ -74,6 +140,10 @@ sub new {
 		$lookbehind_steps++;
 	}
 
+	if ( $opt{async} ) {
+		return $self;
+	}
+
 	if ( not $self->{user_agent} ) {
 		my %lwp_options = %{ $opt{lwp_options} // { timeout => 10 } };
 		$self->{user_agent} = LWP::UserAgent->new(%lwp_options);
@@ -182,6 +252,55 @@ sub postprocess_results {
 	$self->create_replacement_refs;
 }
 
+sub get_with_cache_p {
+	my ( $self, $cache, $url ) = @_;
+
+	if ( $self->{developer_mode} ) {
+		say "GET $url";
+	}
+
+	my $promise = $self->{promise}->new;
+
+	if ($cache) {
+		my $content = $cache->thaw($url);
+		if ($content) {
+			if ( $self->{developer_mode} ) {
+				say '  cache hit';
+			}
+			return $promise->resolve($content);
+		}
+	}
+
+	if ( $self->{developer_mode} ) {
+		say '  cache miss';
+	}
+
+	my $res = $self->{user_agent}->get_p($url)->then(
+		sub {
+			my ($tx) = @_;
+			if ( my $err = $tx->error ) {
+				$promise->reject(
+					"GET $url returned HTTP $err->{code} $err->{messag}");
+				return;
+			}
+			my $content = $tx->res->body;
+			if ($cache) {
+				$cache->freeze( $url, \$content );
+			}
+			$promise->resolve($content);
+			return;
+		}
+	)->catch(
+		sub {
+			my ($err) = @_;
+			$promise->reject($err);
+			return;
+		}
+	)->wait;
+
+	return $promise;
+}
+
 sub get_with_cache {
 	my ( $self, $cache, $url ) = @_;
 
@@ -218,6 +337,48 @@ sub get_with_cache {
 	return ( $content, undef );
 }
 
+sub get_station_p {
+	my ( $self, %opt ) = @_;
+
+	my $promise = $self->{promise}->new;
+	my $station = $opt{name};
+
+	$self->get_with_cache_p( $self->{main_cache},
+		$self->{iris_base} . '/station/' . $station )->then(
+		sub {
+			my ($raw) = @_;
+			my ( $xml_st, $xml_err ) = try_load_xml($raw);
+			if ($xml_err) {
+				$promise->reject('Failed to parse station data: Invalid XML');
+				return;
+			}
+			my $station_node = ( $xml_st->findnodes('//station') )[0];
+
+			if ( not $station_node ) {
+				$promise->reject(
+					"Station '$station' has no associated timetable");
+				return;
+			}
+			$promise->resolve(
+				{
+					uic   => $station_node->getAttribute('eva'),
+					name  => $station_node->getAttribute('name'),
+					ds100 => $station_node->getAttribute('ds100'),
+				}
+			);
+			return;
+		}
+	)->catch(
+		sub {
+			my ($err) = @_;
+			$promise->reject($err);
+			return;
+		}
+	)->wait;
+
+	return $promise;
+}
+
 sub get_station {
 	my ( $self, %opt ) = @_;
 
@@ -393,6 +554,41 @@ sub add_result {
 	return $result;
 }
 
+sub get_timetable_p {
+	my ( $self, $eva, $dt ) = @_;
+
+	my $promise = $self->{promise}->new;
+
+	$self->get_with_cache_p( $self->{main_cache},
+		$dt->strftime( $self->{iris_base} . "/plan/${eva}/%y%m%d/%H" ) )->then(
+		sub {
+			my ($raw) = @_;
+			my ( $xml, $xml_err ) = try_load_xml($raw);
+			if ($xml_err) {
+				$promise->reject(
+					'Failed to parse a schedule part: Invalid XML');
+				return;
+			}
+			my $station
+			  = ( $xml->findnodes('/timetable') )[0]->getAttribute('station');
+
+			for my $s ( $xml->findnodes('/timetable/s') ) {
+
+				$self->add_result( $station, $eva, $s );
+			}
+			$promise->resolve;
+			return;
+		}
+	)->catch(
+		sub {
+			my ($err) = @_;
+			$promise->reject($err);
+			return;
+		}
+	)->wait;
+	return $promise;
+}
+
 sub get_timetable {
 	my ( $self, $eva, $dt ) = @_;
 
@@ -422,6 +618,36 @@ sub get_timetable {
 	return $self;
 }
 
+sub get_realtime_p {
+	my ($self) = @_;
+
+	my $promise = $self->{promise}->new;
+
+	my $eva = $self->{station}{uic};
+	$self->get_with_cache_p( $self->{rt_cache},
+		$self->{iris_base} . "/fchg/${eva}" )->then(
+		sub {
+			my ($raw) = @_;
+			my ( $xml, $xml_err ) = try_load_xml($raw);
+			if ($xml_err) {
+				$promise->reject(
+					'Failed to parse a schedule part: Invalid XML');
+				return;
+			}
+			$self->parse_realtime( $eva, $xml );
+			$promise->resolve;
+			return;
+		}
+	)->catch(
+		sub {
+			my ($err) = @_;
+			$promise->reject("Failed to fetch realtime data: $err");
+			return;
+		}
+	)->wait;
+	return $promise;
+}
+
 sub get_realtime {
 	my ($self) = @_;
 
@@ -443,6 +669,11 @@ sub get_realtime {
 		return $self;
 	}
 
+	$self->parse_realtime( $eva, $xml );
+}
+
+sub parse_realtime {
+	my ( $self, $eva, $xml ) = @_;
 	my $station = ( $xml->findnodes('/timetable') )[0]->getAttribute('station');
 
 	for my $s ( $xml->findnodes('/timetable/s') ) {