File Coverage

blib/lib/Travel/Routing/DE/EFA.pm
Criterion Covered Total %
statement 304 378 80.4
branch 77 104 74.0
condition 34 62 54.8
subroutine 32 43 74.4
pod 19 31 61.2
total 466 618 75.4


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