Route/Part.pm: add {arrival,departure}_{route,station}maps accessors

2 files changed, 107 insertions, 19 deletions

diff --git a/lib/Travel/Routing/DE/EFA.pm b/lib/Travel/Routing/DE/EFA.pm
index 03620b2..b085d16 100644
--- a/lib/Travel/Routing/DE/EFA.pm
+++ b/lib/Travel/Routing/DE/EFA.pm
@@ -411,8 +411,12 @@ sub new {
 		);
 	}
 
-	#	$ref->{config}->{rm_base} //= 'http://efa.vrr.de/vrr/';
-	#	$ref->{config}->{sm_base} //= 'http://efa.vrr.de/download/envmaps/';
+	$ref->{config}->{efa_url} =~ m{
+		(?<netroot> (?<root> [^:]+ : // [^/]+ ) / [^/]+ / )
+	}ox;
+
+	$ref->{config}->{rm_base} = $+{netroot};
+	$ref->{config}->{sm_base} = $+{root} . '/download/envmaps/';
 
 	$ref->create_post;
 
@@ -428,6 +432,17 @@ sub new_from_xml {
 
 	my $self = { xml_reply => $opt{xml} };
 
+	$self->{config} = {
+		efa_url => $opt{efa_url},
+	};
+
+	$self->{config}->{efa_url} =~ m{
+		(?<netroot> (?<root> [^:]+ : // [^/]+ ) / [^/]+ / )
+	}ox;
+
+	$self->{config}->{rm_base} = $+{netroot};
+	$self->{config}->{sm_base} = $+{root} . '/download/envmaps/';
+
 	bless( $self, $class );
 
 	$self->parse_xml;
@@ -495,6 +510,11 @@ sub parse_xml_part {
 	my $xp_info
 	  = XML::LibXML::XPathExpression->new('./itdInfoTextList/infoTextListElem');
 
+	my $xp_mapitem_rm = XML::LibXML::XPathExpression->new(
+		'./itdMapItemList/itdMapItem[@type="RM"]/itdImage');
+	my $xp_mapitem_sm = XML::LibXML::XPathExpression->new(
+		'./itdMapItemList/itdMapItem[@type="SM"]/itdImage');
+
 	my $xp_fare
 	  = XML::LibXML::XPathExpression->new('./itdFare/itdSingleTicket');
 
@@ -516,22 +536,39 @@ sub parse_xml_part {
 
 	for my $e ( $route->findnodes($xp_route) ) {
 
-		my $e_dep    = ( $e->findnodes($xp_dep) )[0];
-		my $e_arr    = ( $e->findnodes($xp_arr) )[0];
-		my $e_ddate  = ( $e_dep->findnodes($xp_date) )[0];
-		my $e_dtime  = ( $e_dep->findnodes($xp_time) )[0];
-		my $e_dsdate = ( $e_dep->findnodes($xp_sdate) )[0];
-		my $e_dstime = ( $e_dep->findnodes($xp_stime) )[0];
-		my $e_adate  = ( $e_arr->findnodes($xp_date) )[0];
-		my $e_atime  = ( $e_arr->findnodes($xp_time) )[0];
-		my $e_asdate = ( $e_arr->findnodes($xp_sdate) )[0];
-		my $e_astime = ( $e_arr->findnodes($xp_stime) )[0];
-		my $e_mot    = ( $e->findnodes($xp_mot) )[0];
-		my $e_delay  = ( $e->findnodes($xp_delay) )[0];
-		my @e_info   = $e->findnodes($xp_info);
+		my $e_dep     = ( $e->findnodes($xp_dep) )[0];
+		my $e_arr     = ( $e->findnodes($xp_arr) )[0];
+		my $e_ddate   = ( $e_dep->findnodes($xp_date) )[0];
+		my $e_dtime   = ( $e_dep->findnodes($xp_time) )[0];
+		my $e_dsdate  = ( $e_dep->findnodes($xp_sdate) )[0];
+		my $e_dstime  = ( $e_dep->findnodes($xp_stime) )[0];
+		my $e_adate   = ( $e_arr->findnodes($xp_date) )[0];
+		my $e_atime   = ( $e_arr->findnodes($xp_time) )[0];
+		my $e_asdate  = ( $e_arr->findnodes($xp_sdate) )[0];
+		my $e_astime  = ( $e_arr->findnodes($xp_stime) )[0];
+		my $e_mot     = ( $e->findnodes($xp_mot) )[0];
+		my $e_delay   = ( $e->findnodes($xp_delay) )[0];
+		my @e_info    = $e->findnodes($xp_info);
+		my @e_dmap_rm = $e_dep->findnodes($xp_mapitem_rm);
+		my @e_dmap_sm = $e_dep->findnodes($xp_mapitem_sm);
+		my @e_amap_rm = $e_arr->findnodes($xp_mapitem_rm);
+		my @e_amap_sm = $e_arr->findnodes($xp_mapitem_sm);
 
 		my $delay = $e_delay ? $e_delay->getAttribute('delayMinutes') : 0;
 
+		my ( @dep_rms, @dep_sms, @arr_rms, @arr_sms );
+
+		if ( $self->{config}->{rm_base} ) {
+			my $base = $self->{config}->{rm_base};
+			@dep_rms = map { $base . $_->getAttribute('src') } @e_dmap_rm;
+			@arr_rms = map { $base . $_->getAttribute('src') } @e_amap_rm;
+		}
+		if ( $self->{config}->{sm_base} ) {
+			my $base = $self->{config}->{sm_base};
+			@dep_sms = map { $base . $_->getAttribute('src') } @e_dmap_sm;
+			@arr_sms = map { $base . $_->getAttribute('src') } @e_amap_sm;
+		}
+
 		my $hash = {
 			delay              => $delay,
 			departure_date     => $self->itddate_str($e_ddate),
@@ -554,6 +591,11 @@ sub parse_xml_part {
 			$hash->{$key} = decode( 'UTF-8', $hash->{$key} );
 		}
 
+		$hash->{departure_routemaps}   = \@dep_rms;
+		$hash->{departure_stationmaps} = \@dep_sms;
+		$hash->{arrival_routemaps}     = \@arr_rms;
+		$hash->{arrival_stationmaps}   = \@arr_sms;
+
 		for my $ve ( $e->findnodes($xp_via) ) {
 			my $e_vdate = ( $ve->findnodes($xp_date) )[-1];
 			my $e_vtime = ( $ve->findnodes($xp_time) )[-1];
diff --git a/lib/Travel/Routing/DE/EFA/Route/Part.pm b/lib/Travel/Routing/DE/EFA/Route/Part.pm
index 2fd69d2..7ff6bac 100644
--- a/lib/Travel/Routing/DE/EFA/Route/Part.pm
+++ b/lib/Travel/Routing/DE/EFA/Route/Part.pm
@@ -10,10 +10,10 @@ our $VERSION = '2.05';
 
 Travel::Routing::DE::EFA::Route::Part->mk_ro_accessors(
 	qw(arrival_platform arrival_stop
-	  arrival_date arrival_time arrival_sdate arrival_stime
-	  delay departure_platform departure_stop
-	  departure_date departure_time departure_sdate departure_stime
-	  train_line train_destination
+	  arrival_date arrival_time arrival_sdate arrival_stime delay
+	  departure_platform
+	  departure_stop departure_date departure_time departure_sdate
+	  departure_stime train_line train_destination
 	  )
 );
 
@@ -25,6 +25,18 @@ sub new {
 	return bless( $ref, $obj );
 }
 
+sub arrival_routemaps {
+	my ($self) = @_;
+
+	return @{ $self->{arrival_routemaps} };
+}
+
+sub arrival_stationmaps {
+	my ($self) = @_;
+
+	return @{ $self->{arrival_stationmaps} };
+}
+
 sub arrival_stop_and_platform {
 	my ($self) = @_;
 
@@ -35,6 +47,18 @@ sub arrival_stop_and_platform {
 	return $self->arrival_stop;
 }
 
+sub departure_routemaps {
+	my ($self) = @_;
+
+	return @{ $self->{departure_routemaps} };
+}
+
+sub departure_stationmaps {
+	my ($self) = @_;
+
+	return @{ $self->{departure_stationmaps} };
+}
+
 sub departure_stop_and_platform {
 	my ($self) = @_;
 
@@ -134,6 +158,17 @@ Scheduled arrival date in DD.MM.YYYY format
 
 Scheduled arrival time in HH:MM format
 
+=item $part->arrival_routemaps
+
+List of URLs, may be empty. Each URL poinst to a transfer map for the arrival
+station, usually outlining fow to transfer from this train to the next one
+(if applicable).
+
+=item $part->arrival_stationmaps
+
+List of URLs, may be empty. Each URL points to an HTML map of the arrival
+station.
+
 =item $part->delay
 
 delay in minutes, 0 if unknown
@@ -166,6 +201,17 @@ Scheduled departure date in DD.MM.YYYY format
 
 Scheduled departure time in HH:MM format
 
+=item $part->departure_routemaps
+
+List of URLs, may be empty. Each URL points to a PDF a transfer map for the
+departure station, usually outlining fow to transfer from thep previous train
+(if applicable) to this one.
+
+=item $part->departure_stationmaps
+
+List of URLs, may be empty. Each URL poinst to an HTML map of the departure
+station.
+
 =item $part->extra
 
 Additional information about the connection.  Returns a list of