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   161462 use strict;
  2         22  
  2         94  
4 2     2   15 use warnings;
  2         6  
  2         63  
5 2     2   82 use 5.010;
  2         11  
6 2     2   1104 use utf8;
  2         27  
  2         23  
7              
8 2     2   108 use Carp qw(cluck);
  2         6  
  2         189  
9 2     2   1560 use Encode qw(encode);
  2         32078  
  2         148  
10 2     2   1630 use Travel::Routing::DE::EFA::Route;
  2         6  
  2         13  
11 2     2   1836 use Travel::Routing::DE::EFA::Route::Message;
  2         6  
  2         17  
12 2     2   4362 use LWP::UserAgent;
  2         132771  
  2         80  
13 2     2   3193 use XML::LibXML;
  2         90443  
  2         15  
14              
15             use Exception::Class (
16 2         31 '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   2947 );
  2         26545  
42              
43             our $VERSION = '2.23';
44              
45             sub set_time {
46 4     4 0 24 my ( $self, %conf ) = @_;
47              
48 4         8 my $time;
49              
50 4 100       17 if ( $conf{departure_time} ) {
    50          
51 3         7 $self->{post}->{itdTripDateTimeDepArr} = 'dep';
52 3         5 $time = $conf{departure_time};
53             }
54             elsif ( $conf{arrival_time} ) {
55 1         14 $self->{post}->{itdTripDateTimeDepArr} = 'arr';
56 1         2 $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       20 if ( $time !~ / ^ [0-2]? \d : [0-5]? \d $ /x ) {
66 2         30 Travel::Routing::DE::EFA::Exception::Setup->throw(
67             option => 'time',
68             have => $time,
69             want => 'HH:MM',
70             );
71             }
72              
73 2         11 @{ $self->{post} }{ 'itdTimeHour', 'itdTimeMinute' } = split( /:/, $time );
  2         5  
74              
75 2         6 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 10 my ( $self, $date ) = @_;
92              
93 4         20 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     68 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         7 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     35 if ( not defined $year or not length($year) ) {
121 1         23 $year = ( localtime(time) )[5] + 1900;
122             }
123              
124 2         7 @{ $self->{post} }{ 'itdDateDay', 'itdDateMonth', 'itdDateYear' }
  2         8  
125             = ( $day, $month, $year );
126              
127 2         22 return;
128             }
129              
130             sub exclude {
131 3     3 1 10 my ( $self, @exclude ) = @_;
132              
133 3         18 my @mapping = qw{
134             zug s-bahn u-bahn stadtbahn tram stadtbus regionalbus
135             schnellbus seilbahn schiff ast sonstige
136             };
137              
138 3         8 foreach my $exclude_type (@exclude) {
139 6         12 my $ok = 0;
140 6         15 for my $map_id ( 0 .. $#mapping ) {
141 72 100       177 if ( $exclude_type eq $mapping[$map_id] ) {
142 5         23 delete $self->{post}->{"inclMOT_${map_id}"};
143 5         12 $ok = 1;
144             }
145             }
146 6 100       19 if ( not $ok ) {
147 1         12 Travel::Routing::DE::EFA::Exception::Setup->throw(
148             option => 'exclude',
149             have => $exclude_type,
150             want => join( ' / ', @mapping ),
151             );
152             }
153             }
154              
155 2         5 return;
156             }
157              
158             sub max_interchanges {
159 1     1 1 4 my ( $self, $max ) = @_;
160              
161 1         2 $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 24 my ( $self, $prefer ) = @_;
176              
177 4 100       30 if ( $prefer eq 'speed' ) { $self->{post}->{routeType} = 'LEASTTIME' }
  1 100       3  
    100          
178             elsif ( $prefer eq 'waittime' ) {
179 1         3 $self->{post}->{routeType} = 'LEASTINTERCHANGE';
180             }
181             elsif ( $prefer eq 'distance' ) {
182 1         3 $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         7 return;
193             }
194              
195             sub train_type {
196 4     4 1 12 my ( $self, $include ) = @_;
197              
198 4 100       20 if ( $include eq 'local' ) { $self->{post}->{lineRestriction} = 403 }
  1 100       4  
    100          
199 1         2 elsif ( $include eq 'ic' ) { $self->{post}->{lineRestriction} = 401 }
200 1         3 elsif ( $include eq 'ice' ) { $self->{post}->{lineRestriction} = 400 }
201             else {
202 1         15 Travel::Routing::DE::EFA::Exception::Setup->throw(
203             option => 'train_type',
204             have => $include,
205             want => 'local / ic / ice',
206             );
207             }
208              
209 3         6 return;
210             }
211              
212             sub use_near_stops {
213 1     1 1 4 my ( $self, $duration ) = @_;
214              
215 1 50       4 if ($duration) {
216 1         3 $self->{post}->{useProxFootSearch} = 1;
217 1         2 $self->{post}->{trITArrMOTvalue100} = $duration;
218 1         3 $self->{post}->{trITDepMOTvalue100} = $duration;
219             }
220             else {
221 0         0 $self->{post}->{useProxFootSearch} = 0;
222             }
223              
224 1         2 return;
225             }
226              
227             sub walk_speed {
228 2     2 1 7 my ( $self, $walk_speed ) = @_;
229              
230 2 100       11 if ( $walk_speed =~ m{ ^ (?: normal | fast | slow ) $ }x ) {
231 1         3 $self->{post}->{changeSpeed} = $walk_speed;
232             }
233             else {
234 1         7 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         2 return;
242             }
243              
244             sub with_bike {
245 1     1 1 4 my ( $self, $bike ) = @_;
246              
247 1         3 $self->{post}->{bikeTakeAlong} = $bike;
248              
249 1         3 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 113 my ( $self, $which, $place, $stop, $type ) = @_;
294              
295 55 50 33     214 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     191 $type //= 'stop';
303              
304 55         117 @{ $self->{post} }{ "place_${which}", "name_${which}" } = ( $place, $stop );
  55         134  
305              
306 55 50       227 if ( $type =~ m{ ^ (?: address | poi | stop ) $ }x ) {
307 55         121 $self->{post}->{"type_${which}"} = $type;
308             }
309              
310 55         98 return;
311             }
312              
313             sub create_post {
314 27     27 0 47 my ($self) = @_;
315              
316 27         50 my $conf = $self->{config};
317 27         708 my @now = localtime( time() );
318              
319             $self->{post} = {
320 27         906 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         61 $self->place( 'origin', @{ $conf->{origin} } );
  27         106  
392 27         54 $self->place( 'destination', @{ $conf->{destination} } );
  27         73  
393              
394 27 100       64 if ( $conf->{via} ) {
395 1         3 $self->place( 'via', @{ $conf->{via} } );
  1         3  
396             }
397 27 100 100     103 if ( $conf->{arrival_time} || $conf->{departure_time} ) {
398 4         10 $self->set_time( %{$conf} );
  4         27  
399             }
400 25 100       73 if ( $conf->{date} ) {
401 4         21 $self->date( $conf->{date} );
402             }
403 23 100       46 if ( $conf->{exclude} ) {
404 3         11 $self->exclude( @{ $conf->{exclude} } );
  3         17  
405             }
406 22 100       47 if ( $conf->{max_interchanges} ) {
407 1         10 $self->max_interchanges( $conf->{max_interchanges} );
408             }
409 22 50       43 if ( $conf->{num_results} ) {
410 0         0 $self->number_of_trips( $conf->{num_results} );
411             }
412 22 100       43 if ( $conf->{select_interchange_by} ) {
413 4         19 $self->select_interchange_by( $conf->{select_interchange_by} );
414             }
415 21 100       58 if ( $conf->{use_near_stops} ) {
416 1         8 $self->use_near_stops( $conf->{use_near_stops} );
417             }
418 21 100       69 if ( $conf->{train_type} ) {
419 4         18 $self->train_type( $conf->{train_type} );
420             }
421 20 100       40 if ( $conf->{walk_speed} ) {
422 2         29 $self->walk_speed( $conf->{walk_speed} );
423             }
424 19 100       36 if ( $conf->{with_bike} ) {
425 1         12 $self->with_bike(1);
426             }
427 19 50       38 if ( $conf->{with_low_platform} ) {
428 0         0 $self->with_low_platform(1);
429             }
430 19 50       35 if ( $conf->{with_wheelchair} ) {
431 0         0 $self->with_wheelchair(1);
432             }
433 19 50       35 if ( $conf->{without_solid_stairs} ) {
434 0         0 $self->without_solid_stairs(1);
435             }
436 19 50       34 if ( $conf->{without_escalators} ) {
437 0         0 $self->without_escalators(1);
438             }
439 19 50       34 if ( $conf->{without_elevators} ) {
440 0         0 $self->without_elevators(1);
441             }
442              
443 19         29 for my $val ( values %{ $self->{post} } ) {
  19         153  
444 1309         34768 $val = encode( 'UTF-8', $val );
445             }
446              
447 19         500 return;
448             }
449              
450             sub new {
451 27     27 1 110 my ( $obj, %conf ) = @_;
452              
453 27         53 my $ref = {};
454              
455 27         59 $ref->{config} = \%conf;
456              
457 27         51 bless( $ref, $obj );
458              
459 27 50       74 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         187 $ref->{config}->{efa_url} =~ m{
467             (? (? [^:]+ : // [^/]+ ) / [^/]+ / )
468             }ox;
469              
470 2     2   10697 $ref->{config}->{rm_base} = $+{netroot};
  2         908  
  2         5547  
  27         237  
471 27         140 $ref->{config}->{sm_base} = $+{root} . '/download/envmaps/';
472              
473 27         92 $ref->create_post;
474              
475 19 50 33     89 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 3400 my ( $class, %opt ) = @_;
484              
485 1         4 my $self = { xml_reply => $opt{xml} };
486              
487             $self->{config} = {
488             efa_url => $opt{efa_url},
489 1         5 };
490              
491 1         10 $self->{config}->{efa_url} =~ m{
492             (? (? [^:]+ : // [^/]+ ) / [^/]+ / )
493             }ox;
494              
495 1         15 $self->{config}->{rm_base} = $+{netroot};
496 1         8 $self->{config}->{sm_base} = $+{root} . '/download/envmaps/';
497              
498 1         3 bless( $self, $class );
499              
500 1         4 $self->parse_xml;
501              
502 1         4 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 922 my ( $self, $node ) = @_;
529              
530 74         131 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 1777 my ( $self, $node ) = @_;
538              
539 74         136 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 13 my ( $self, $node ) = @_;
571              
572 5         32 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 9 my ( $self, $route ) = @_;
581              
582 4         34 my $xp_route = XML::LibXML::XPathExpression->new(
583             './itdPartialRouteList/itdPartialRoute');
584 4         31 my $xp_dep
585             = XML::LibXML::XPathExpression->new('./itdPoint[@usage="departure"]');
586 4         21 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         16 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         15 my $xp_stime
595             = XML::LibXML::XPathExpression->new('./itdDateTimeTarget/itdTime');
596 4         17 my $xp_mot = XML::LibXML::XPathExpression->new('./itdMeansOfTransport');
597 4         16 my $xp_fp = XML::LibXML::XPathExpression->new('./itdFootPathInfo');
598 4         18 my $xp_fp_e
599             = XML::LibXML::XPathExpression->new('./itdFootPathInfo/itdFootPathElem');
600 4         17 my $xp_delay = XML::LibXML::XPathExpression->new('./itdRBLControlled');
601              
602 4         19 my $xp_sched_info
603             = XML::LibXML::XPathExpression->new('./itdInfoTextList/infoTextListElem');
604 4         16 my $xp_cur_info = XML::LibXML::XPathExpression->new('./infoLink');
605              
606 4         23 my $xp_mapitem_rm = XML::LibXML::XPathExpression->new(
607             './itdMapItemList/itdMapItem[@type="RM"]/itdImage');
608 4         22 my $xp_mapitem_sm = XML::LibXML::XPathExpression->new(
609             './itdMapItemList/itdMapItem[@type="SM"]/itdImage');
610              
611 4         20 my $xp_fare
612             = XML::LibXML::XPathExpression->new('./itdFare/itdSingleTicket');
613              
614 4         7 my @route_parts;
615              
616 4         11 my $info = {
617             duration => $route->getAttribute('publicDuration'),
618             vehicle_time => $route->getAttribute('vehicleTime'),
619             };
620              
621 4         84 my $e_fare = ( $route->findnodes($xp_fare) )[0];
622              
623 4 50       202 if ($e_fare) {
624 4         27 $info->{ticket_type} = $e_fare->getAttribute('unitsAdult');
625 4         54 $info->{fare_adult} = $e_fare->getAttribute('fareAdult');
626 4         40 $info->{fare_child} = $e_fare->getAttribute('fareChild');
627 4         53 $info->{ticket_text} = $e_fare->textContent;
628             }
629              
630 4         14 for my $e ( $route->findnodes($xp_route) ) {
631              
632 10         937 my $e_dep = ( $e->findnodes($xp_dep) )[0];
633 10         340 my $e_arr = ( $e->findnodes($xp_arr) )[0];
634 10         260 my $e_ddate = ( $e_dep->findnodes($xp_date) )[0];
635 10         215 my $e_dtime = ( $e_dep->findnodes($xp_time) )[0];
636 10         218 my $e_dsdate = ( $e_dep->findnodes($xp_sdate) )[0];
637 10         201 my $e_dstime = ( $e_dep->findnodes($xp_stime) )[0];
638 10         198 my $e_adate = ( $e_arr->findnodes($xp_date) )[0];
639 10         205 my $e_atime = ( $e_arr->findnodes($xp_time) )[0];
640 10         196 my $e_asdate = ( $e_arr->findnodes($xp_sdate) )[0];
641 10         244 my $e_astime = ( $e_arr->findnodes($xp_stime) )[0];
642 10         209 my $e_mot = ( $e->findnodes($xp_mot) )[0];
643 10         211 my $e_delay = ( $e->findnodes($xp_delay) )[0];
644 10         211 my $e_fp = ( $e->findnodes($xp_fp) )[0];
645 10         197 my @e_sinfo = $e->findnodes($xp_sched_info);
646 10         275 my @e_cinfo = $e->findnodes($xp_cur_info);
647 10         214 my @e_dmap_rm = $e_dep->findnodes($xp_mapitem_rm);
648 10         242 my @e_dmap_sm = $e_dep->findnodes($xp_mapitem_sm);
649 10         229 my @e_amap_rm = $e_arr->findnodes($xp_mapitem_rm);
650 10         224 my @e_amap_sm = $e_arr->findnodes($xp_mapitem_sm);
651 10         225 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     216 $e_dsdate //= $e_ddate;
656 10   33     45 $e_dstime //= $e_dtime;
657 10   33     41 $e_asdate //= $e_adate;
658 10   33     38 $e_astime //= $e_atime;
659              
660 10 100       41 my $delay = $e_delay ? $e_delay->getAttribute('delayMinutes') : 0;
661              
662 10         83 my ( @dep_rms, @dep_sms, @arr_rms, @arr_sms );
663              
664 10 50       30 if ( $self->{config}->{rm_base} ) {
665 10         18 my $base = $self->{config}->{rm_base};
666 10         21 @dep_rms = map { $base . $_->getAttribute('src') } @e_dmap_rm;
  10         24  
667 10         127 @arr_rms = map { $base . $_->getAttribute('src') } @e_amap_rm;
  10         26  
668             }
669 10 50       107 if ( $self->{config}->{sm_base} ) {
670 10         21 my $base = $self->{config}->{sm_base};
671 10         21 @dep_sms = map { $base . $_->getAttribute('src') } @e_dmap_sm;
  6         13  
672 10         63 @arr_sms = map { $base . $_->getAttribute('src') } @e_amap_sm;
  10         20  
673             }
674              
675 10         109 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       383 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         29 $hash->{footpath_type} = $e_fp->getAttribute('position');
702 5         50 $hash->{footpath_duration} = $e_fp->getAttribute('duration');
703 5         43 for my $e (@e_fp_e) {
704             push(
705 5         8 @{ $hash->{footpath_parts} },
  5         13  
706             [ $e->getAttribute('type'), $e->getAttribute('level') ]
707             );
708             }
709             }
710              
711 10         90 $hash->{departure_routemaps} = \@dep_rms;
712 10         21 $hash->{departure_stationmaps} = \@dep_sms;
713 10         20 $hash->{arrival_routemaps} = \@arr_rms;
714 10         14 $hash->{arrival_stationmaps} = \@arr_sms;
715              
716 10         27 for my $ve ( $e->findnodes($xp_via) ) {
717 62         1873 my $e_vdate = ( $ve->findnodes($xp_date) )[-1];
718 62         1469 my $e_vtime = ( $ve->findnodes($xp_time) )[-1];
719              
720 62 100 33     1551 if ( not( $e_vdate and $e_vtime )
      66        
721             or ( $e_vdate->getAttribute('weekday') == -1 ) )
722             {
723 10         232 next;
724             }
725              
726 52         1223 my $name = $ve->getAttribute('name');
727 52         443 my $platform = $ve->getAttribute('platformName');
728              
729 52 100 100     506 if ( $name eq $hash->{departure_stop}
730             or $name eq $hash->{arrival_stop} )
731             {
732 18         46 next;
733             }
734              
735             push(
736 34         50 @{ $hash->{via} },
  34         85  
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         182 = [ map { $self->parse_reg_info($_) } @e_sinfo ];
  5         268  
748 10         258 $hash->{current_notes} = [ map { $self->parse_cur_info($_) } @e_cinfo ];
  0         0  
749              
750 10         49 push( @route_parts, $hash );
751             }
752              
753             push(
754 4         493 @{ $self->{routes} },
  4         92  
755             Travel::Routing::DE::EFA::Route->new( $info, @route_parts )
756             );
757              
758 4         13 return;
759             }
760              
761             sub parse_xml {
762 1     1 0 4 my ($self) = @_;
763              
764             my $tree = $self->{tree} = XML::LibXML->load_xml(
765             string => $self->{xml_reply},
766 1         10 );
767              
768 1 50       7632 if ( $self->{config}->{developer_mode} ) {
769 0         0 say $tree->toString(2);
770             }
771              
772 1         51 my $xp_element = XML::LibXML::XPathExpression->new(
773             '//itdItinerary/itdRouteList/itdRoute');
774 1         36 my $xp_err = XML::LibXML::XPathExpression->new(
775             '//itdTripRequest/itdMessage[@type="error"]');
776 1         7 my $xp_odv = XML::LibXML::XPathExpression->new('//itdOdv');
777              
778 1         11 for my $odv ( $tree->findnodes($xp_odv) ) {
779 3         250 $self->check_ambiguous_xml($odv);
780             }
781              
782 1         23 my $err = ( $tree->findnodes($xp_err) )[0];
783 1 50       170 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         249 $self->parse_xml_part($part);
790             }
791              
792 1 50 33     31 if ( not defined $self->{routes} or @{ $self->{routes} } == 0 ) {
  1         37  
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 12 my ( $self, $tree ) = @_;
801              
802 3         23 my $xp_place = XML::LibXML::XPathExpression->new('./itdOdvPlace');
803 3         13 my $xp_name = XML::LibXML::XPathExpression->new('./itdOdvName');
804              
805 3         13 my $xp_place_elem = XML::LibXML::XPathExpression->new('./odvPlaceElem');
806 3         15 my $xp_place_input = XML::LibXML::XPathExpression->new('./odvPlaceInput');
807 3         14 my $xp_name_elem = XML::LibXML::XPathExpression->new('./odvNameElem');
808 3         13 my $xp_name_input = XML::LibXML::XPathExpression->new('./odvNameInput');
809              
810 3         14 my $e_place = ( $tree->findnodes($xp_place) )[0];
811 3         81 my $e_name = ( $tree->findnodes($xp_name) )[0];
812              
813 3 50 33     113 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         45 my $s_place = $e_place->getAttribute('state');
819 3         42 my $s_name = $e_name->getAttribute('state');
820              
821 3 50       34 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       15 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       7 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 2959 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://app.vrr.de/vrrstd/XML_TRIP_REQUEST2',
926             name => 'Verkehrsverbund Rhein-Ruhr',
927             shortname => 'VRR',
928             },
929             {
930             url => 'https://efa.vrr.de/rbgstd3/XSLT_TRIP_REQUEST2',
931             name => 'Verkehrsverbund Rhein-Ruhr (alternative)',
932             shortname => 'VRR2',
933             },
934             {
935             url => 'https://efa.vvo-online.de/VMSSL3/XSLT_TRIP_REQUEST2',
936             name => 'Verkehrsverbund Oberelbe',
937             shortname => 'VVO',
938             },
939             {
940             url => 'https://www2.vvs.de/vvs/XSLT_TRIP_REQUEST2',
941             name => 'Verkehrsverbund Stuttgart',
942             shortname => 'VVS',
943             },
944             );
945             }
946              
947             1;
948              
949             __END__