File Coverage

blib/lib/Travel/Routing/DE/EFA.pm
Criterion Covered Total %
statement 315 389 80.9
branch 65 92 70.6
condition 31 59 52.5
subroutine 33 44 75.0
pod 19 31 61.2
total 463 615 75.2


line stmt bran cond sub pod time code
1             package Travel::Routing::DE::EFA;
2              
3 2     2   141678 use strict;
  2         15  
  2         60  
4 2     2   9 use warnings;
  2         4  
  2         52  
5 2     2   40 use 5.010;
  2         6  
6 2     2   706 use utf8;
  2         17  
  2         19  
7              
8 2     2   808 no if $] >= 5.018, warnings => "experimental::smartmatch";
  2         17  
  2         25  
9              
10 2     2   156 use Carp qw(cluck);
  2         4  
  2         99  
11 2     2   1283 use Encode qw(encode);
  2         30732  
  2         177  
12 2     2   1017 use Travel::Routing::DE::EFA::Route;
  2         6  
  2         11  
13 2     2   995 use Travel::Routing::DE::EFA::Route::Message;
  2         10  
  2         13  
14 2     2   1596 use LWP::UserAgent;
  2         109177  
  2         80  
15 2     2   1424 use XML::LibXML;
  2         72681  
  2         14  
16              
17             use Exception::Class (
18 2         28 'Travel::Routing::DE::EFA::Exception',
19             'Travel::Routing::DE::EFA::Exception::Setup' => {
20             isa => 'Travel::Routing::DE::EFA::Exception',
21             description => 'invalid argument on setup',
22             fields => [ 'option', 'have', 'want' ],
23             },
24             'Travel::Routing::DE::EFA::Exception::Net' => {
25             isa => 'Travel::Routing::DE::EFA::Exception',
26             description => 'could not submit POST request',
27             fields => 'http_response',
28             },
29             'Travel::Routing::DE::EFA::Exception::NoData' => {
30             isa => 'Travel::Routing::DE::EFA::Exception',
31             description => 'backend returned no parsable route',
32             },
33             'Travel::Routing::DE::EFA::Exception::Ambiguous' => {
34             isa => 'Travel::Routing::DE::EFA::Exception',
35             description => 'ambiguous input',
36             fields => [ 'post_key', 'post_value', 'possibilities' ],
37             },
38             'Travel::Routing::DE::EFA::Exception::Other' => {
39             isa => 'Travel::Routing::DE::EFA::Exception',
40             description => 'EFA backend returned an error',
41             fields => ['message'],
42             },
43 2     2   2683 );
  2         18090  
44              
45             our $VERSION = '2.21';
46              
47             sub set_time {
48 4     4 0 23 my ( $self, %conf ) = @_;
49              
50 4         8 my $time;
51              
52 4 100       16 if ( $conf{departure_time} ) {
    50          
53 3         8 $self->{post}->{itdTripDateTimeDepArr} = 'dep';
54 3         8 $time = $conf{departure_time};
55             }
56             elsif ( $conf{arrival_time} ) {
57 1         3 $self->{post}->{itdTripDateTimeDepArr} = 'arr';
58 1         34 $time = $conf{arrival_time};
59             }
60             else {
61 0         0 Travel::Routing::DE::EFA::Exception::Setup->throw(
62             option => 'time',
63             error => 'Specify either departure_time or arrival_time'
64             );
65             }
66              
67 4 100       26 if ( $time !~ / ^ [0-2]? \d : [0-5]? \d $ /x ) {
68 2         35 Travel::Routing::DE::EFA::Exception::Setup->throw(
69             option => 'time',
70             have => $time,
71             want => 'HH:MM',
72             );
73             }
74              
75 2         23 @{ $self->{post} }{ 'itdTimeHour', 'itdTimeMinute' } = split( /:/, $time );
  2         10  
76              
77 2         9 return;
78             }
79              
80             sub departure_time {
81 0     0 1 0 my ( $self, $time ) = @_;
82              
83 0         0 return $self->set_time( departure_time => $time );
84             }
85              
86             sub arrival_time {
87 0     0 1 0 my ( $self, $time ) = @_;
88              
89 0         0 return $self->set_time( arrival_time => $time );
90             }
91              
92             sub date {
93 4     4 1 14 my ( $self, $date ) = @_;
94              
95 4         40 my ( $day, $month, $year ) = split( /[.]/, $date );
96              
97 4 50       36 if ( $date eq 'tomorrow' ) {
98 0         0 ( undef, undef, undef, $day, $month, $year )
99             = localtime( time + 86400 );
100 0         0 $month += 1;
101 0         0 $year += 1900;
102             }
103              
104 4 50 33     47 if (
      33        
      66        
      66        
      100        
      66        
      66        
105             not( defined $day
106             and length($day)
107             and $day >= 1
108             and $day <= 31
109             and defined $month
110             and length($month)
111             and $month >= 1
112             and $month <= 12 )
113             )
114             {
115 2         9 Travel::Routing::DE::EFA::Exception::Setup->throw(
116             option => 'date',
117             have => $date,
118             want => 'DD.MM[.[YYYY]]'
119             );
120             }
121              
122 2 100 66     21 if ( not defined $year or not length($year) ) {
123 1         22 $year = ( localtime(time) )[5] + 1900;
124             }
125              
126 2         8 @{ $self->{post} }{ 'itdDateDay', 'itdDateMonth', 'itdDateYear' }
  2         14  
127             = ( $day, $month, $year );
128              
129 2         6 return;
130             }
131              
132             sub exclude {
133 3     3 1 9 my ( $self, @exclude ) = @_;
134              
135 3         11 my @mapping = qw{
136             zug s-bahn u-bahn stadtbahn tram stadtbus regionalbus
137             schnellbus seilbahn schiff ast sonstige
138             };
139              
140 3         6 foreach my $exclude_type (@exclude) {
141 6         9 my $ok = 0;
142 6         14 for my $map_id ( 0 .. $#mapping ) {
143 72 100       125 if ( $exclude_type eq $mapping[$map_id] ) {
144 5         24 delete $self->{post}->{"inclMOT_${map_id}"};
145 5         10 $ok = 1;
146             }
147             }
148 6 100       15 if ( not $ok ) {
149 1         8 Travel::Routing::DE::EFA::Exception::Setup->throw(
150             option => 'exclude',
151             have => $exclude_type,
152             want => join( ' / ', @mapping ),
153             );
154             }
155             }
156              
157 2         5 return;
158             }
159              
160             sub max_interchanges {
161 1     1 1 6 my ( $self, $max ) = @_;
162              
163 1         4 $self->{post}->{maxChanges} = $max;
164              
165 1         1 return;
166             }
167              
168             sub number_of_trips {
169 0     0 0 0 my ( $self, $num ) = @_;
170              
171 0         0 $self->{post}->{calcNumberOfTrips} = $num;
172              
173 0         0 return;
174             }
175              
176             sub select_interchange_by {
177 4     4 1 14 my ( $self, $prefer ) = @_;
178              
179 4         8 given ($prefer) {
180 4         10 when ('speed') { $self->{post}->{routeType} = 'LEASTTIME' }
  1         3  
181 3         5 when ('waittime') { $self->{post}->{routeType} = 'LEASTINTERCHANGE' }
  1         3  
182 2         11 when ('distance') { $self->{post}->{routeType} = 'LEASTWALKING' }
  1         7  
183 1         2 default {
184 1         6 Travel::Routing::DE::EFA::Exception::Setup->throw(
185             option => 'select_interchange_by',
186             have => $prefer,
187             want => 'speed / waittime / distance',
188             );
189             }
190             }
191              
192 3         6 return;
193             }
194              
195             sub train_type {
196 4     4 1 19 my ( $self, $include ) = @_;
197              
198 4         10 given ($include) {
199 4         20 when ('local') { $self->{post}->{lineRestriction} = 403 }
  1         8  
200 3         8 when ('ic') { $self->{post}->{lineRestriction} = 401 }
  1         3  
201 2         6 when ('ice') { $self->{post}->{lineRestriction} = 400 }
  1         3  
202 1         7 default {
203 1         5 Travel::Routing::DE::EFA::Exception::Setup->throw(
204             option => 'train_type',
205             have => $include,
206             want => 'local / ic / ice',
207             );
208             }
209             }
210              
211 3         5 return;
212             }
213              
214             sub use_near_stops {
215 1     1 1 10 my ( $self, $duration ) = @_;
216              
217 1 50       5 if ($duration) {
218 1         3 $self->{post}->{useProxFootSearch} = 1;
219 1         2 $self->{post}->{trITArrMOTvalue100} = $duration;
220 1         4 $self->{post}->{trITDepMOTvalue100} = $duration;
221             }
222             else {
223 0         0 $self->{post}->{useProxFootSearch} = 0;
224             }
225              
226 1         2 return;
227             }
228              
229             sub walk_speed {
230 2     2 1 5 my ( $self, $walk_speed ) = @_;
231              
232 2 100       9 if ( $walk_speed ~~ [ 'normal', 'fast', 'slow' ] ) {
233 1         3 $self->{post}->{changeSpeed} = $walk_speed;
234             }
235             else {
236 1         7 Travel::Routing::DE::EFA::Exception::Setup->throw(
237             option => 'walk_speed',
238             have => $walk_speed,
239             want => 'normal / fast / slow',
240             );
241             }
242              
243 1         3 return;
244             }
245              
246             sub with_bike {
247 1     1 1 7 my ( $self, $bike ) = @_;
248              
249 1         3 $self->{post}->{bikeTakeAlong} = $bike;
250              
251 1         2 return;
252             }
253              
254             sub without_solid_stairs {
255 0     0 1 0 my ( $self, $opt ) = @_;
256              
257 0         0 $self->{post}->{noSolidStairs} = $opt;
258              
259 0         0 return;
260             }
261              
262             sub without_escalators {
263 0     0 1 0 my ( $self, $opt ) = @_;
264              
265 0         0 $self->{post}->{noEscalators} = $opt;
266              
267 0         0 return;
268             }
269              
270             sub without_elevators {
271 0     0 1 0 my ( $self, $opt ) = @_;
272              
273 0         0 $self->{post}->{noElevators} = $opt;
274              
275 0         0 return;
276             }
277              
278             sub with_low_platform {
279 0     0 1 0 my ( $self, $opt ) = @_;
280              
281 0         0 $self->{post}->{lowPlatformVhcl} = $opt;
282              
283 0         0 return;
284             }
285              
286             sub with_wheelchair {
287 0     0 1 0 my ( $self, $opt ) = @_;
288              
289 0         0 $self->{post}->{wheelchair} = $opt;
290              
291 0         0 return;
292             }
293              
294             sub place {
295 55     55 0 128 my ( $self, $which, $place, $stop, $type ) = @_;
296              
297 55 50 33     252 if ( not( $place and $stop ) ) {
298 0         0 Travel::Routing::DE::EFA::Exception::Setup->throw(
299             option => 'place',
300             error => 'Need >= three elements'
301             );
302             }
303              
304 55   100     189 $type //= 'stop';
305              
306 55         113 @{ $self->{post} }{ "place_${which}", "name_${which}" } = ( $place, $stop );
  55         132  
307              
308 55 50       211 if ( $type ~~ [qw[address poi stop]] ) {
309 55         115 $self->{post}->{"type_${which}"} = $type;
310             }
311              
312 55         119 return;
313             }
314              
315             sub create_post {
316 27     27 0 49 my ($self) = @_;
317              
318 27         42 my $conf = $self->{config};
319 27         793 my @now = localtime( time() );
320              
321             $self->{post} = {
322 27         946 changeSpeed => 'normal',
323             command => q{},
324             execInst => q{},
325             imparedOptionsActive => 1,
326             inclMOT_0 => 'on',
327             inclMOT_1 => 'on',
328             inclMOT_10 => 'on',
329             inclMOT_11 => 'on',
330             inclMOT_2 => 'on',
331             inclMOT_3 => 'on',
332             inclMOT_4 => 'on',
333             inclMOT_5 => 'on',
334             inclMOT_6 => 'on',
335             inclMOT_7 => 'on',
336             inclMOT_8 => 'on',
337             inclMOT_9 => 'on',
338             includedMeans => 'checkbox',
339             itOptionsActive => 1,
340             itdDateDay => $now[3],
341             itdDateMonth => $now[4] + 1,
342             itdDateYear => $now[5] + 1900,
343             itdTimeHour => $now[2],
344             itdTimeMinute => $now[1],
345             itdTripDateTimeDepArr => 'dep',
346             language => 'de',
347             lineRestriction => 403,
348             maxChanges => 9,
349             nameInfo_destination => 'invalid',
350             nameInfo_origin => 'invalid',
351             nameInfo_via => 'invalid',
352             nameState_destination => 'empty',
353             nameState_origin => 'empty',
354             nameState_via => 'empty',
355             name_destination => q{},
356             name_origin => q{},
357             name_via => q{},
358             nextDepsPerLeg => 1,
359             outputFormat => 'XML',
360             placeInfo_destination => 'invalid',
361             placeInfo_origin => 'invalid',
362             placeInfo_via => 'invalid',
363             placeState_destination => 'empty',
364             placeState_origin => 'empty',
365             placeState_via => 'empty',
366             place_destination => q{},
367             place_origin => q{},
368             place_via => q{},
369             ptOptionsActive => 1,
370             requestID => 0,
371             routeType => 'LEASTTIME',
372             sessionID => 0,
373             text => 1993,
374             trITArrMOT => 100,
375             trITArrMOTvalue100 => 10,
376             trITArrMOTvalue101 => 10,
377             trITArrMOTvalue104 => 10,
378             trITArrMOTvalue105 => 10,
379             trITDepMOT => 100,
380             trITDepMOTvalue100 => 10,
381             trITDepMOTvalue101 => 10,
382             trITDepMOTvalue104 => 10,
383             trITDepMOTvalue105 => 10,
384             typeInfo_destination => 'invalid',
385             typeInfo_origin => 'invalid',
386             typeInfo_via => 'invalid',
387             type_destination => 'stop',
388             type_origin => 'stop',
389             type_via => 'stop',
390             useRealtime => 1
391             };
392              
393 27         85 $self->place( 'origin', @{ $conf->{origin} } );
  27         107  
394 27         43 $self->place( 'destination', @{ $conf->{destination} } );
  27         71  
395              
396 27 100       64 if ( $conf->{via} ) {
397 1         5 $self->place( 'via', @{ $conf->{via} } );
  1         17  
398             }
399 27 100 100     101 if ( $conf->{arrival_time} || $conf->{departure_time} ) {
400 4         16 $self->set_time( %{$conf} );
  4         25  
401             }
402 25 100       66 if ( $conf->{date} ) {
403 4         16 $self->date( $conf->{date} );
404             }
405 23 100       46 if ( $conf->{exclude} ) {
406 3         8 $self->exclude( @{ $conf->{exclude} } );
  3         15  
407             }
408 22 100       47 if ( $conf->{max_interchanges} ) {
409 1         14 $self->max_interchanges( $conf->{max_interchanges} );
410             }
411 22 50       39 if ( $conf->{num_results} ) {
412 0         0 $self->number_of_trips( $conf->{num_results} );
413             }
414 22 100       44 if ( $conf->{select_interchange_by} ) {
415 4         23 $self->select_interchange_by( $conf->{select_interchange_by} );
416             }
417 21 100       40 if ( $conf->{use_near_stops} ) {
418 1         10 $self->use_near_stops( $conf->{use_near_stops} );
419             }
420 21 100       48 if ( $conf->{train_type} ) {
421 4         23 $self->train_type( $conf->{train_type} );
422             }
423 20 100       36 if ( $conf->{walk_speed} ) {
424 2         10 $self->walk_speed( $conf->{walk_speed} );
425             }
426 19 100       38 if ( $conf->{with_bike} ) {
427 1         10 $self->with_bike(1);
428             }
429 19 50       51 if ( $conf->{with_low_platform} ) {
430 0         0 $self->with_low_platform(1);
431             }
432 19 50       32 if ( $conf->{with_wheelchair} ) {
433 0         0 $self->with_wheelchair(1);
434             }
435 19 50       35 if ( $conf->{without_solid_stairs} ) {
436 0         0 $self->without_solid_stairs(1);
437             }
438 19 50       35 if ( $conf->{without_escalators} ) {
439 0         0 $self->without_escalators(1);
440             }
441 19 50       37 if ( $conf->{without_elevators} ) {
442 0         0 $self->without_elevators(1);
443             }
444              
445 19         24 for my $val ( values %{ $self->{post} } ) {
  19         161  
446 1309         35303 $val = encode( 'UTF-8', $val );
447             }
448              
449 19         508 return;
450             }
451              
452             sub new {
453 27     27 1 115 my ( $obj, %conf ) = @_;
454              
455 27         81 my $ref = {};
456              
457 27         66 $ref->{config} = \%conf;
458              
459 27         51 bless( $ref, $obj );
460              
461 27 50       78 if ( not $ref->{config}->{efa_url} ) {
462 0         0 Travel::Routing::DE::EFA::Exception::Setup->throw(
463             option => 'efa_url',
464             error => 'must be set'
465             );
466             }
467              
468 27         183 $ref->{config}->{efa_url} =~ m{
469             (? (? [^:]+ : // [^/]+ ) / [^/]+ / )
470             }ox;
471              
472 2     2   9870 $ref->{config}->{rm_base} = $+{netroot};
  2         808  
  2         5501  
  27         193  
473 27         146 $ref->{config}->{sm_base} = $+{root} . '/download/envmaps/';
474              
475 27         97 $ref->create_post;
476              
477 19 50 33     91 if ( not( defined $conf{submit} and $conf{submit} == 0 ) ) {
478 0         0 $ref->submit( %{ $conf{lwp_options} } );
  0         0  
479             }
480              
481 19         98 return $ref;
482             }
483              
484             sub new_from_xml {
485 1     1 0 1217 my ( $class, %opt ) = @_;
486              
487 1         5 my $self = { xml_reply => $opt{xml} };
488              
489             $self->{config} = {
490             efa_url => $opt{efa_url},
491 1         4 };
492              
493 1         10 $self->{config}->{efa_url} =~ m{
494             (? (? [^:]+ : // [^/]+ ) / [^/]+ / )
495             }ox;
496              
497 1         13 $self->{config}->{rm_base} = $+{netroot};
498 1         7 $self->{config}->{sm_base} = $+{root} . '/download/envmaps/';
499              
500 1         4 bless( $self, $class );
501              
502 1         5 $self->parse_xml;
503              
504 1         6 return $self;
505             }
506              
507             sub submit {
508 0     0 1 0 my ( $self, %conf ) = @_;
509              
510 0         0 $self->{ua} = LWP::UserAgent->new(%conf);
511 0         0 $self->{ua}->env_proxy;
512              
513             my $response
514 0         0 = $self->{ua}->post( $self->{config}->{efa_url}, $self->{post} );
515              
516 0 0       0 if ( $response->is_error ) {
517 0         0 Travel::Routing::DE::EFA::Exception::Net->throw(
518             http_response => $response,
519             );
520             }
521              
522 0         0 $self->{xml_reply} = $response->decoded_content;
523              
524 0         0 $self->parse_xml;
525              
526 0         0 return;
527             }
528              
529             sub itddate_str {
530 74     74 0 948 my ( $self, $node ) = @_;
531              
532 74         131 return sprintf( '%02d.%02d.%04d',
533             $node->getAttribute('day'),
534             $node->getAttribute('month'),
535             $node->getAttribute('year') );
536             }
537              
538             sub itdtime_str {
539 74     74 0 1698 my ( $self, $node ) = @_;
540              
541 74         133 return sprintf( '%02d:%02d',
542             $node->getAttribute('hour'),
543             $node->getAttribute('minute') );
544             }
545              
546             sub parse_cur_info {
547 0     0 0 0 my ( $self, $node ) = @_;
548              
549 0         0 my $xp_text = XML::LibXML::XPathExpression->new('./infoLinkText');
550 0         0 my $xp_subject = XML::LibXML::XPathExpression->new('./infoText/subject');
551 0         0 my $xp_subtitle = XML::LibXML::XPathExpression->new('./infoText/subtitle');
552 0         0 my $xp_content = XML::LibXML::XPathExpression->new('./infoText/content');
553              
554 0         0 my $e_text = ( $node->findnodes($xp_text) )[0];
555 0         0 my $e_subject = ( $node->findnodes($xp_subject) )[0];
556 0         0 my $e_subtitle = ( $node->findnodes($xp_subtitle) )[0];
557 0         0 my $e_content = ( $node->findnodes($xp_content) )[0];
558              
559 0         0 my %msg = (
560             summary => $e_text->textContent,
561             subject => $e_subject->textContent,
562             subtitle => $e_subtitle->textContent,
563             raw_content => $e_content->textContent,
564             );
565 0         0 for my $key ( keys %msg ) {
566 0         0 chomp( $msg{$key} );
567             }
568 0         0 return Travel::Routing::DE::EFA::Route::Message->new(%msg);
569             }
570              
571             sub parse_reg_info {
572 5     5 0 11 my ( $self, $node ) = @_;
573              
574 5         31 my %msg = (
575             summary => $node->textContent,
576             );
577              
578 5         31 return Travel::Routing::DE::EFA::Route::Message->new(%msg);
579             }
580              
581             sub parse_xml_part {
582 4     4 0 10 my ( $self, $route ) = @_;
583              
584 4         33 my $xp_route = XML::LibXML::XPathExpression->new(
585             './itdPartialRouteList/itdPartialRoute');
586 4         33 my $xp_dep
587             = XML::LibXML::XPathExpression->new('./itdPoint[@usage="departure"]');
588 4         22 my $xp_arr
589             = XML::LibXML::XPathExpression->new('./itdPoint[@usage="arrival"]');
590 4         19 my $xp_date = XML::LibXML::XPathExpression->new('./itdDateTime/itdDate');
591 4         20 my $xp_time = XML::LibXML::XPathExpression->new('./itdDateTime/itdTime');
592 4         19 my $xp_via = XML::LibXML::XPathExpression->new('./itdStopSeq/itdPoint');
593              
594 4         18 my $xp_sdate
595             = XML::LibXML::XPathExpression->new('./itdDateTimeTarget/itdDate');
596 4         19 my $xp_stime
597             = XML::LibXML::XPathExpression->new('./itdDateTimeTarget/itdTime');
598 4         17 my $xp_mot = XML::LibXML::XPathExpression->new('./itdMeansOfTransport');
599 4         16 my $xp_fp = XML::LibXML::XPathExpression->new('./itdFootPathInfo');
600 4         19 my $xp_fp_e
601             = XML::LibXML::XPathExpression->new('./itdFootPathInfo/itdFootPathElem');
602 4         19 my $xp_delay = XML::LibXML::XPathExpression->new('./itdRBLControlled');
603              
604 4         18 my $xp_sched_info
605             = XML::LibXML::XPathExpression->new('./itdInfoTextList/infoTextListElem');
606 4         17 my $xp_cur_info = XML::LibXML::XPathExpression->new('./infoLink');
607              
608 4         25 my $xp_mapitem_rm = XML::LibXML::XPathExpression->new(
609             './itdMapItemList/itdMapItem[@type="RM"]/itdImage');
610 4         21 my $xp_mapitem_sm = XML::LibXML::XPathExpression->new(
611             './itdMapItemList/itdMapItem[@type="SM"]/itdImage');
612              
613 4         20 my $xp_fare
614             = XML::LibXML::XPathExpression->new('./itdFare/itdSingleTicket');
615              
616 4         7 my @route_parts;
617              
618 4         13 my $info = {
619             duration => $route->getAttribute('publicDuration'),
620             vehicle_time => $route->getAttribute('vehicleTime'),
621             };
622              
623 4         85 my $e_fare = ( $route->findnodes($xp_fare) )[0];
624              
625 4 50       172 if ($e_fare) {
626 4         28 $info->{ticket_type} = $e_fare->getAttribute('unitsAdult');
627 4         50 $info->{fare_adult} = $e_fare->getAttribute('fareAdult');
628 4         35 $info->{fare_child} = $e_fare->getAttribute('fareChild');
629 4         54 $info->{ticket_text} = $e_fare->textContent;
630             }
631              
632 4         13 for my $e ( $route->findnodes($xp_route) ) {
633              
634 10         848 my $e_dep = ( $e->findnodes($xp_dep) )[0];
635 10         296 my $e_arr = ( $e->findnodes($xp_arr) )[0];
636 10         241 my $e_ddate = ( $e_dep->findnodes($xp_date) )[0];
637 10         214 my $e_dtime = ( $e_dep->findnodes($xp_time) )[0];
638 10         203 my $e_dsdate = ( $e_dep->findnodes($xp_sdate) )[0];
639 10         198 my $e_dstime = ( $e_dep->findnodes($xp_stime) )[0];
640 10         200 my $e_adate = ( $e_arr->findnodes($xp_date) )[0];
641 10         200 my $e_atime = ( $e_arr->findnodes($xp_time) )[0];
642 10         220 my $e_asdate = ( $e_arr->findnodes($xp_sdate) )[0];
643 10         232 my $e_astime = ( $e_arr->findnodes($xp_stime) )[0];
644 10         206 my $e_mot = ( $e->findnodes($xp_mot) )[0];
645 10         207 my $e_delay = ( $e->findnodes($xp_delay) )[0];
646 10         196 my $e_fp = ( $e->findnodes($xp_fp) )[0];
647 10         191 my @e_sinfo = $e->findnodes($xp_sched_info);
648 10         252 my @e_cinfo = $e->findnodes($xp_cur_info);
649 10         186 my @e_dmap_rm = $e_dep->findnodes($xp_mapitem_rm);
650 10         255 my @e_dmap_sm = $e_dep->findnodes($xp_mapitem_sm);
651 10         225 my @e_amap_rm = $e_arr->findnodes($xp_mapitem_rm);
652 10         234 my @e_amap_sm = $e_arr->findnodes($xp_mapitem_sm);
653 10         230 my @e_fp_e = $e->findnodes($xp_fp_e);
654              
655             # not all EFA services distinguish between scheduled and realtime
656             # data. Set sdate / stime to date / time when not provided.
657 10   33     215 $e_dsdate //= $e_ddate;
658 10   33     46 $e_dstime //= $e_dtime;
659 10   33     36 $e_asdate //= $e_adate;
660 10   33     39 $e_astime //= $e_atime;
661              
662 10 100       42 my $delay = $e_delay ? $e_delay->getAttribute('delayMinutes') : 0;
663              
664 10         80 my ( @dep_rms, @dep_sms, @arr_rms, @arr_sms );
665              
666 10 50       30 if ( $self->{config}->{rm_base} ) {
667 10         20 my $base = $self->{config}->{rm_base};
668 10         21 @dep_rms = map { $base . $_->getAttribute('src') } @e_dmap_rm;
  10         22  
669 10         124 @arr_rms = map { $base . $_->getAttribute('src') } @e_amap_rm;
  10         23  
670             }
671 10 50       117 if ( $self->{config}->{sm_base} ) {
672 10         22 my $base = $self->{config}->{sm_base};
673 10         13 @dep_sms = map { $base . $_->getAttribute('src') } @e_dmap_sm;
  6         22  
674 10         68 @arr_sms = map { $base . $_->getAttribute('src') } @e_amap_sm;
  10         21  
675             }
676              
677 10         105 my $hash = {
678             delay => $delay,
679             departure_date => $self->itddate_str($e_ddate),
680             departure_time => $self->itdtime_str($e_dtime),
681             departure_sdate => $self->itddate_str($e_dsdate),
682             departure_stime => $self->itdtime_str($e_dstime),
683             departure_stop => $e_dep->getAttribute('name'),
684             departure_platform => $e_dep->getAttribute('platformName'),
685             occupancy => $e_dep->getAttribute('occupancy'),
686             train_line => $e_mot->getAttribute('name'),
687             train_product => $e_mot->getAttribute('productName'),
688             train_destination => $e_mot->getAttribute('destination'),
689             arrival_date => $self->itddate_str($e_adate),
690             arrival_time => $self->itdtime_str($e_atime),
691             arrival_sdate => $self->itddate_str($e_asdate),
692             arrival_stime => $self->itdtime_str($e_astime),
693             arrival_stop => $e_arr->getAttribute('name'),
694             arrival_platform => $e_arr->getAttribute('platformName'),
695             };
696              
697 10 100       371 if ($e_fp) {
698              
699             # Note that position=IDEST footpaths are coupled with a special
700             # "walking" connection, so their duration is already known and
701             # accounted for. However, we still save it here, since
702             # detecting and handling this is the API client's job (for now).
703 5         29 $hash->{footpath_type} = $e_fp->getAttribute('position');
704 5         49 $hash->{footpath_duration} = $e_fp->getAttribute('duration');
705 5         45 for my $e (@e_fp_e) {
706             push(
707 5         8 @{ $hash->{footpath_parts} },
  5         16  
708             [ $e->getAttribute('type'), $e->getAttribute('level') ]
709             );
710             }
711             }
712              
713 10         94 $hash->{departure_routemaps} = \@dep_rms;
714 10         17 $hash->{departure_stationmaps} = \@dep_sms;
715 10         20 $hash->{arrival_routemaps} = \@arr_rms;
716 10         16 $hash->{arrival_stationmaps} = \@arr_sms;
717              
718 10         27 for my $ve ( $e->findnodes($xp_via) ) {
719 62         1865 my $e_vdate = ( $ve->findnodes($xp_date) )[-1];
720 62         1475 my $e_vtime = ( $ve->findnodes($xp_time) )[-1];
721              
722 62 100 33     1570 if ( not( $e_vdate and $e_vtime )
      66        
723             or ( $e_vdate->getAttribute('weekday') == -1 ) )
724             {
725 10         254 next;
726             }
727              
728 52         1258 my $name = $ve->getAttribute('name');
729 52         457 my $platform = $ve->getAttribute('platformName');
730              
731 52 100       522 if ( $name ~~ [ $hash->{departure_stop}, $hash->{arrival_stop} ] ) {
732 18         58 next;
733             }
734              
735             push(
736 34         61 @{ $hash->{via} },
  34         89  
737             [
738             $self->itddate_str($e_vdate),
739             $self->itdtime_str($e_vtime),
740             $name,
741             $platform
742             ]
743             );
744             }
745              
746             $hash->{regular_notes}
747 10         176 = [ map { $self->parse_reg_info($_) } @e_sinfo ];
  5         253  
748 10         229 $hash->{current_notes} = [ map { $self->parse_cur_info($_) } @e_cinfo ];
  0         0  
749              
750 10         40 push( @route_parts, $hash );
751             }
752              
753             push(
754 4         481 @{ $self->{routes} },
  4         91  
755             Travel::Routing::DE::EFA::Route->new( $info, @route_parts )
756             );
757              
758 4         12 return;
759             }
760              
761             sub parse_xml {
762 1     1 0 3 my ($self) = @_;
763              
764             my $tree = $self->{tree} = XML::LibXML->load_xml(
765             string => $self->{xml_reply},
766 1         14 );
767              
768 1 50       6441 if ( $self->{config}->{developer_mode} ) {
769 0         0 say $tree->toString(2);
770             }
771              
772 1         43 my $xp_element = XML::LibXML::XPathExpression->new(
773             '//itdItinerary/itdRouteList/itdRoute');
774 1         31 my $xp_err = XML::LibXML::XPathExpression->new(
775             '//itdTripRequest/itdMessage[@type="error"]');
776 1         8 my $xp_odv = XML::LibXML::XPathExpression->new('//itdOdv');
777              
778 1         15 for my $odv ( $tree->findnodes($xp_odv) ) {
779 3         243 $self->check_ambiguous_xml($odv);
780             }
781              
782 1         26 my $err = ( $tree->findnodes($xp_err) )[0];
783 1 50       161 if ($err) {
784 0         0 Travel::Routing::DE::EFA::Exception::Other->throw(
785             message => $err->textContent );
786             }
787              
788 1         8 for my $part ( $tree->findnodes($xp_element) ) {
789 4         246 $self->parse_xml_part($part);
790             }
791              
792 1 50 33     30 if ( not defined $self->{routes} or @{ $self->{routes} } == 0 ) {
  1         40  
793 0         0 Travel::Routing::DE::EFA::Exception::NoData->throw;
794             }
795              
796 1         6 return 1;
797             }
798              
799             sub check_ambiguous_xml {
800 3     3 0 7 my ( $self, $tree ) = @_;
801              
802 3         21 my $xp_place = XML::LibXML::XPathExpression->new('./itdOdvPlace');
803 3         16 my $xp_name = XML::LibXML::XPathExpression->new('./itdOdvName');
804              
805 3         13 my $xp_place_elem = XML::LibXML::XPathExpression->new('./odvPlaceElem');
806 3         14 my $xp_place_input = XML::LibXML::XPathExpression->new('./odvPlaceInput');
807 3         13 my $xp_name_elem = XML::LibXML::XPathExpression->new('./odvNameElem');
808 3         14 my $xp_name_input = XML::LibXML::XPathExpression->new('./odvNameInput');
809              
810 3         14 my $e_place = ( $tree->findnodes($xp_place) )[0];
811 3         78 my $e_name = ( $tree->findnodes($xp_name) )[0];
812              
813 3 50 33     114 if ( not( $e_place and $e_name ) ) {
814 0         0 cluck('skipping ambiguity check - itdOdvPlace/itdOdvName missing');
815 0         0 return;
816             }
817              
818 3         48 my $s_place = $e_place->getAttribute('state');
819 3         56 my $s_name = $e_name->getAttribute('state');
820              
821 3 50       30 if ( $s_place eq 'list' ) {
822             Travel::Routing::DE::EFA::Exception::Ambiguous->throw(
823             post_key => 'place',
824             post_value =>
825             ( $e_place->findnodes($xp_place_input) )[0]->textContent,
826             possibilities => join( q{ | },
827 0         0 map { $_->textContent }
828 0         0 @{ $e_place->findnodes($xp_place_elem) } )
  0         0  
829             );
830             }
831 3 50       8 if ( $s_name eq 'list' ) {
832             Travel::Routing::DE::EFA::Exception::Ambiguous->throw(
833             post_key => 'name',
834             post_value =>
835             ( $e_name->findnodes($xp_name_input) )[0]->textContent,
836             possibilities => join( q{ | },
837 0         0 map { $_->textContent } @{ $e_name->findnodes($xp_name_elem) } )
  0         0  
  0         0  
838             );
839             }
840              
841 3 50       6 if ( $s_place eq 'notidentified' ) {
842 0         0 Travel::Routing::DE::EFA::Exception::Setup->throw(
843             option => 'place',
844             error => 'unknown place',
845             have => ( $e_place->findnodes($xp_place_input) )[0]->textContent,
846             );
847             }
848 3 50       9 if ( $s_name eq 'notidentified' ) {
849 0         0 Travel::Routing::DE::EFA::Exception::Setup->throw(
850             option => 'name',
851             error => 'unknown name',
852             have => ( $e_name->findnodes($xp_name_input) )[0]->textContent,
853             );
854             }
855              
856             # 'identified' and 'empty' are ok
857              
858 3         10 return;
859             }
860              
861             sub routes {
862 2     2 1 2985 my ($self) = @_;
863              
864 2         4 return @{ $self->{routes} };
  2         7  
865             }
866              
867             # static
868             sub get_efa_urls {
869              
870             # sorted lexically by shortname
871             return (
872             {
873 0     0 1   url => 'https://bsvg.efa.de/bsvagstd/XML_TRIP_REQUEST2',
874             name => 'Braunschweiger Verkehrs-GmbH',
875             shortname => 'BSVG',
876             },
877             {
878             url => 'https://www.ding.eu/ding3/XSLT_TRIP_REQUEST2',
879             name => 'Donau-Iller Nahverkehrsverbund',
880             shortname => 'DING',
881             },
882             {
883             url => 'https://projekte.kvv-efa.de/sl3-alone/XSLT_TRIP_REQUEST2',
884             name => 'Karlsruher Verkehrsverbund',
885             shortname => 'KVV',
886             },
887             {
888             url => 'https://www.linzag.at/static/XSLT_TRIP_REQUEST2',
889             name => 'Linz AG',
890             shortname => 'LinzAG',
891             },
892             {
893             url => 'https://efa.mvv-muenchen.de/mobile/XSLT_TRIP_REQUEST2',
894             name => 'Münchner Verkehrs- und Tarifverbund',
895             shortname => 'MVV',
896             },
897             {
898             url => 'https://www.efa-bw.de/nvbw/XSLT_TRIP_REQUEST2',
899             name => 'Nahverkehrsgesellschaft Baden-Württemberg',
900             shortname => 'NVBW',
901             },
902             {
903             url => 'https://efa.vagfr.de/vagfr3/XSLT_TRIP_REQUEST2',
904             name => 'Freiburger Verkehrs AG',
905             shortname => 'VAG',
906             },
907             {
908             url => 'https://efa.vgn.de/vgnExt_oeffi/XML_TRIP_REQUEST2',
909             name => 'Verkehrsverbund Grossraum Nuernberg',
910             shortname => 'VGN',
911             },
912              
913             # HTTPS: certificate verification fails
914             {
915             url => 'http://efa.vmv-mbh.de/vmv/XML_TRIP_REQUEST2',
916             name => 'Verkehrsgesellschaft Mecklenburg-Vorpommern',
917             shortname => 'VMV',
918             },
919             {
920             url => 'https://www.vrn.de/mngvrn/XML_TRIP_REQUEST2',
921             name => 'Verkehrsverbund Rhein-Neckar',
922             shortname => 'VRN',
923             },
924             {
925             url => 'https://efa.vrr.de/vrr/XSLT_TRIP_REQUEST2',
926             name => 'Verkehrsverbund Rhein-Ruhr',
927             shortname => 'VRR',
928             },
929             {
930             url => 'https://app.vrr.de/vrrstd/XML_TRIP_REQUEST2',
931             name => 'Verkehrsverbund Rhein-Ruhr (alternative)',
932             shortname => 'VRR2',
933             },
934             {
935             url => 'https://efa.vrr.de/rbgstd3/XSLT_TRIP_REQUEST2',
936             name => 'Verkehrsverbund Rhein-Ruhr (alternative alternative)',
937             shortname => 'VRR3',
938             },
939             {
940             url => 'https://efa.vvo-online.de/VMSSL3/XSLT_TRIP_REQUEST2',
941             name => 'Verkehrsverbund Oberelbe',
942             shortname => 'VVO',
943             },
944             {
945             url => 'https://www2.vvs.de/vvs/XSLT_TRIP_REQUEST2',
946             name => 'Verkehrsverbund Stuttgart',
947             shortname => 'VVS',
948             },
949             );
950             }
951              
952             1;
953              
954             __END__