File Coverage

blib/lib/Travel/Routing/DE/EFA.pm
Criterion Covered Total %
statement 303 377 80.3
branch 79 106 74.5
condition 34 62 54.8
subroutine 31 42 73.8
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   187311 use strict;
  2         4  
  2         81  
4 2     2   9 use warnings;
  2         3  
  2         98  
5 2     2   32 use 5.010;
  2         6  
6 2     2   766 use utf8;
  2         313  
  2         16  
7              
8 2     2   78 use Carp qw(cluck);
  2         3  
  2         139  
9 2     2   1516 use Encode qw(encode);
  2         36334  
  2         2872  
10 2     2   1194 use Travel::Routing::DE::EFA::Route;
  2         6  
  2         8  
11 2     2   838 use Travel::Routing::DE::EFA::Route::Message;
  2         4  
  2         8  
12 2     2   1465 use LWP::UserAgent;
  2         110611  
  2         89  
13 2     2   1555 use XML::LibXML;
  2         101435  
  2         18  
14              
15             use Exception::Class (
16 2         55 '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   2195 );
  2         26034  
42              
43             our $VERSION = '2.24';
44              
45             sub set_time {
46 4     4 0 23 my ( $self, %conf ) = @_;
47              
48 4         9 my $time;
49              
50 4 100       16 if ( $conf{departure_time} ) {
    50          
51 3         9 $self->{post}->{itdTripDateTimeDepArr} = 'dep';
52 3         8 $time = $conf{departure_time};
53             }
54             elsif ( $conf{arrival_time} ) {
55 1         4 $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       39 if ( $time !~ / ^ [0-2]? \d : [0-5]? \d $ /x ) {
66 2         29 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         9  
74              
75 2         9 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         40 my ( $day, $month, $year ) = split( /[.]/, $date );
94              
95 4 50       15 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     117 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         9 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     11 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         37  
125             = ( $day, $month, $year );
126              
127 2         8 return;
128             }
129              
130             sub exclude {
131 3     3 1 12 my ( $self, @exclude ) = @_;
132              
133 3         29 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         12 my $ok = 0;
140 6         14 for my $map_id ( 0 .. $#mapping ) {
141 72 100       144 if ( $exclude_type eq $mapping[$map_id] ) {
142 5         21 delete $self->{post}->{"inclMOT_${map_id}"};
143 5         11 $ok = 1;
144             }
145             }
146 6 100       16 if ( not $ok ) {
147 1         7 Travel::Routing::DE::EFA::Exception::Setup->throw(
148             option => 'exclude',
149             have => $exclude_type,
150             want => join( ' / ', @mapping ),
151             );
152             }
153             }
154              
155 2         6 return;
156             }
157              
158             sub max_interchanges {
159 1     1 1 4 my ( $self, $max ) = @_;
160              
161 1         3 $self->{post}->{maxChanges} = $max;
162              
163 1         1 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 11 my ( $self, $prefer ) = @_;
176              
177 4 100       20 if ( $prefer eq 'speed' ) { $self->{post}->{routeType} = 'LEASTTIME' }
  1 100       4  
    100          
178             elsif ( $prefer eq 'waittime' ) {
179 1         7 $self->{post}->{routeType} = 'LEASTINTERCHANGE';
180             }
181             elsif ( $prefer eq 'distance' ) {
182 1         2 $self->{post}->{routeType} = 'LEASTWALKING';
183             }
184             else {
185 1         5 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         11 return;
193             }
194              
195             sub train_type {
196 4     4 1 9 my ( $self, $include ) = @_;
197              
198 4 100       20 if ( $include eq 'local' ) { $self->{post}->{lineRestriction} = 403 }
  1 100       2  
    100          
199 1         3 elsif ( $include eq 'ic' ) { $self->{post}->{lineRestriction} = 401 }
200 1         4 elsif ( $include eq 'ice' ) { $self->{post}->{lineRestriction} = 400 }
201             else {
202 1         4 Travel::Routing::DE::EFA::Exception::Setup->throw(
203             option => 'train_type',
204             have => $include,
205             want => 'local / ic / ice',
206             );
207             }
208              
209 3         4 return;
210             }
211              
212             sub use_near_stops {
213 1     1 1 4 my ( $self, $duration ) = @_;
214              
215 1 50       3 if ($duration) {
216 1         3 $self->{post}->{useProxFootSearch} = 1;
217 1         2 $self->{post}->{trITArrMOTvalue100} = $duration;
218 1         17 $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 8 my ( $self, $walk_speed ) = @_;
229              
230 2 100       10 if ( $walk_speed =~ m{ ^ (?: normal | fast | slow ) $ }x ) {
231 1         3 $self->{post}->{changeSpeed} = $walk_speed;
232             }
233             else {
234 1         11 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 2 my ( $self, $bike ) = @_;
246              
247 1         3 $self->{post}->{bikeTakeAlong} = $bike;
248              
249 1         2 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 127 my ( $self, $which, $place, $stop, $type ) = @_;
294              
295 55 50 33     265 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     194 $type //= 'stop';
303              
304 55         116 @{ $self->{post} }{ "place_${which}", "name_${which}" } = ( $place, $stop );
  55         160  
305              
306 55 50       223 if ( $type =~ m{ ^ (?: address | poi | stop ) $ }x ) {
307 55         113 $self->{post}->{"type_${which}"} = $type;
308             }
309              
310 55         98 return;
311             }
312              
313             sub create_post {
314 27     27 0 62 my ($self) = @_;
315              
316 27         49 my $conf = $self->{config};
317 27         782 my @now = localtime( time() );
318              
319             $self->{post} = {
320 27         1100 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         262  
392 27         38 $self->place( 'destination', @{ $conf->{destination} } );
  27         70  
393              
394 27 100       62 if ( $conf->{via} ) {
395 1         3 $self->place( 'via', @{ $conf->{via} } );
  1         3  
396             }
397 27 100 100     113 if ( $conf->{arrival_time} || $conf->{departure_time} ) {
398 4         7 $self->set_time( %{$conf} );
  4         59  
399             }
400 25 100       57 if ( $conf->{date} ) {
401 4         24 $self->date( $conf->{date} );
402             }
403 23 100       49 if ( $conf->{exclude} ) {
404 3         7 $self->exclude( @{ $conf->{exclude} } );
  3         19  
405             }
406 22 100       46 if ( $conf->{max_interchanges} ) {
407 1         9 $self->max_interchanges( $conf->{max_interchanges} );
408             }
409 22 50       58 if ( $conf->{num_results} ) {
410 0         0 $self->number_of_trips( $conf->{num_results} );
411             }
412 22 100       72 if ( $conf->{select_interchange_by} ) {
413 4         25 $self->select_interchange_by( $conf->{select_interchange_by} );
414             }
415 21 100       50 if ( $conf->{use_near_stops} ) {
416 1         10 $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       46 if ( $conf->{walk_speed} ) {
422 2         14 $self->walk_speed( $conf->{walk_speed} );
423             }
424 19 100       42 if ( $conf->{with_bike} ) {
425 1         8 $self->with_bike(1);
426             }
427 19 50       39 if ( $conf->{with_low_platform} ) {
428 0         0 $self->with_low_platform(1);
429             }
430 19 50       43 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       42 if ( $conf->{without_escalators} ) {
437 0         0 $self->without_escalators(1);
438             }
439 19 50       47 if ( $conf->{without_elevators} ) {
440 0         0 $self->without_elevators(1);
441             }
442              
443 19         31 for my $val ( values %{ $self->{post} } ) {
  19         112  
444 1309         34863 $val = encode( 'UTF-8', $val );
445             }
446              
447 19         465 return;
448             }
449              
450             sub new {
451 27     27 1 107 my ( $obj, %conf ) = @_;
452              
453 27         48 my $ref = {};
454              
455 27         68 $ref->{config} = \%conf;
456              
457 27         55 bless( $ref, $obj );
458              
459 27 50       92 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         229 $ref->{config}->{efa_url} =~ m{
467             (? (? [^:]+ : // [^/]+ ) / [^/]+ / )
468             }ox;
469              
470 27         242 $ref->{config}->{rm_base} = $+{netroot};
471 27         279 $ref->{config}->{sm_base} = $+{root} . '/download/envmaps/';
472              
473 27         487 $ref->create_post;
474              
475 19 50 33     133 if ( not( defined $conf{submit} and $conf{submit} == 0 ) ) {
476 0         0 $ref->submit( %{ $conf{lwp_options} } );
  0         0  
477             }
478              
479 19         119 return $ref;
480             }
481              
482             sub new_from_xml {
483 1     1 0 251417 my ( $class, %opt ) = @_;
484              
485 1         24 my $self = { xml_reply => $opt{xml} };
486              
487             $self->{config} = {
488             efa_url => $opt{efa_url},
489 1         5 };
490              
491 1         12 $self->{config}->{efa_url} =~ m{
492             (? (? [^:]+ : // [^/]+ ) / [^/]+ / )
493             }ox;
494              
495 1         14 $self->{config}->{rm_base} = $+{netroot};
496 1         7 $self->{config}->{sm_base} = $+{root} . '/download/envmaps/';
497              
498 1         5 bless( $self, $class );
499              
500 1         7 $self->parse_xml;
501              
502 1         10 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 1062 my ( $self, $node ) = @_;
529              
530 74         156 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 1943 my ( $self, $node ) = @_;
538              
539 74         174 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 12 my ( $self, $node ) = @_;
571              
572 5         34 my %msg = (
573             summary => $node->textContent,
574             );
575              
576 5         39 return Travel::Routing::DE::EFA::Route::Message->new(%msg);
577             }
578              
579             sub parse_xml_part {
580 4     4 0 10 my ( $self, $route ) = @_;
581              
582 4         57 my $xp_route = XML::LibXML::XPathExpression->new(
583             './itdPartialRouteList/itdPartialRoute');
584 4         33 my $xp_dep
585             = XML::LibXML::XPathExpression->new('./itdPoint[@usage="departure"]');
586 4         25 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         20 my $xp_time = XML::LibXML::XPathExpression->new('./itdDateTime/itdTime');
590 4         19 my $xp_via = XML::LibXML::XPathExpression->new('./itdStopSeq/itdPoint');
591              
592 4         20 my $xp_sdate
593             = XML::LibXML::XPathExpression->new('./itdDateTimeTarget/itdDate');
594 4         21 my $xp_stime
595             = XML::LibXML::XPathExpression->new('./itdDateTimeTarget/itdTime');
596 4         19 my $xp_mot = XML::LibXML::XPathExpression->new('./itdMeansOfTransport');
597 4         18 my $xp_fp = XML::LibXML::XPathExpression->new('./itdFootPathInfo');
598 4         23 my $xp_fp_e
599             = XML::LibXML::XPathExpression->new('./itdFootPathInfo/itdFootPathElem');
600 4         21 my $xp_delay = XML::LibXML::XPathExpression->new('./itdRBLControlled');
601              
602 4         37 my $xp_sched_info
603             = XML::LibXML::XPathExpression->new('./itdInfoTextList/infoTextListElem');
604 4         18 my $xp_cur_info = XML::LibXML::XPathExpression->new('./infoLink');
605              
606 4         52 my $xp_mapitem_rm = XML::LibXML::XPathExpression->new(
607             './itdMapItemList/itdMapItem[@type="RM"]/itdImage');
608 4         25 my $xp_mapitem_sm = XML::LibXML::XPathExpression->new(
609             './itdMapItemList/itdMapItem[@type="SM"]/itdImage');
610              
611 4         22 my $xp_fare
612             = XML::LibXML::XPathExpression->new('./itdFare/itdSingleTicket');
613              
614 4         10 my @route_parts;
615              
616 4         17 my $info = {
617             duration => $route->getAttribute('publicDuration'),
618             vehicle_time => $route->getAttribute('vehicleTime'),
619             };
620              
621 4         124 my $e_fare = ( $route->findnodes($xp_fare) )[0];
622              
623 4 50       97 if ($e_fare) {
624 4         31 $info->{ticket_type} = $e_fare->getAttribute('unitsAdult');
625 4         52 $info->{fare_adult} = $e_fare->getAttribute('fareAdult');
626 4         41 $info->{fare_child} = $e_fare->getAttribute('fareChild');
627 4         63 $info->{ticket_text} = $e_fare->textContent;
628             }
629              
630 4         14 for my $e ( $route->findnodes($xp_route) ) {
631              
632 10         846 my $e_dep = ( $e->findnodes($xp_dep) )[0];
633 10         273 my $e_arr = ( $e->findnodes($xp_arr) )[0];
634 10         162 my $e_ddate = ( $e_dep->findnodes($xp_date) )[0];
635 10         134 my $e_dtime = ( $e_dep->findnodes($xp_time) )[0];
636 10         116 my $e_dsdate = ( $e_dep->findnodes($xp_sdate) )[0];
637 10         141 my $e_dstime = ( $e_dep->findnodes($xp_stime) )[0];
638 10         142 my $e_adate = ( $e_arr->findnodes($xp_date) )[0];
639 10         127 my $e_atime = ( $e_arr->findnodes($xp_time) )[0];
640 10         113 my $e_asdate = ( $e_arr->findnodes($xp_sdate) )[0];
641 10         140 my $e_astime = ( $e_arr->findnodes($xp_stime) )[0];
642 10         124 my $e_mot = ( $e->findnodes($xp_mot) )[0];
643 10         140 my $e_delay = ( $e->findnodes($xp_delay) )[0];
644 10         136 my $e_fp = ( $e->findnodes($xp_fp) )[0];
645 10         139 my @e_sinfo = $e->findnodes($xp_sched_info);
646 10         121 my @e_cinfo = $e->findnodes($xp_cur_info);
647 10         108 my @e_dmap_rm = $e_dep->findnodes($xp_mapitem_rm);
648 10         180 my @e_dmap_sm = $e_dep->findnodes($xp_mapitem_sm);
649 10         151 my @e_amap_rm = $e_arr->findnodes($xp_mapitem_rm);
650 10         155 my @e_amap_sm = $e_arr->findnodes($xp_mapitem_sm);
651 10         181 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     126 $e_dsdate //= $e_ddate;
656 10   33     22 $e_dstime //= $e_dtime;
657 10   33     21 $e_asdate //= $e_adate;
658 10   33     28 $e_astime //= $e_atime;
659              
660 10 100       30 my $delay = $e_delay ? $e_delay->getAttribute('delayMinutes') : 0;
661 10 100       142 my $delay_arr
662             = $e_delay ? $e_delay->getAttribute('delayMinutesArr') : 0;
663              
664 10         103 my ( @dep_rms, @dep_sms, @arr_rms, @arr_sms );
665              
666 10 50       79 if ( $self->{config}->{rm_base} ) {
667 10         29 my $base = $self->{config}->{rm_base};
668 10         22 @dep_rms = map { $base . $_->getAttribute('src') } @e_dmap_rm;
  10         32  
669 10         153 @arr_rms = map { $base . $_->getAttribute('src') } @e_amap_rm;
  10         65  
670             }
671 10 50       132 if ( $self->{config}->{sm_base} ) {
672 10         19 my $base = $self->{config}->{sm_base};
673 10         19 @dep_sms = map { $base . $_->getAttribute('src') } @e_dmap_sm;
  6         15  
674 10         66 @arr_sms = map { $base . $_->getAttribute('src') } @e_amap_sm;
  10         23  
675             }
676              
677 10         142 my $hash = {
678             departure_date => $self->itddate_str($e_ddate),
679             departure_delay => $delay,
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_delay => $delay_arr,
691             arrival_time => $self->itdtime_str($e_atime),
692             arrival_sdate => $self->itddate_str($e_asdate),
693             arrival_stime => $self->itdtime_str($e_astime),
694             arrival_stop => $e_arr->getAttribute('name'),
695             arrival_platform => $e_arr->getAttribute('platformName'),
696             };
697              
698 10 100       479 if ($e_fp) {
699              
700             # Note that position=IDEST footpaths are coupled with a special
701             # "walking" connection, so their duration is already known and
702             # accounted for. However, we still save it here, since
703             # detecting and handling this is the API client's job (for now).
704 5         37 $hash->{footpath_type} = $e_fp->getAttribute('position');
705 5         65 $hash->{footpath_duration} = $e_fp->getAttribute('duration');
706 5         48 for my $e (@e_fp_e) {
707             push(
708 5         7 @{ $hash->{footpath_parts} },
  5         17  
709             [ $e->getAttribute('type'), $e->getAttribute('level') ]
710             );
711             }
712             }
713              
714 10         120 $hash->{departure_routemaps} = \@dep_rms;
715 10         21 $hash->{departure_stationmaps} = \@dep_sms;
716 10         30 $hash->{arrival_routemaps} = \@arr_rms;
717 10         31 $hash->{arrival_stationmaps} = \@arr_sms;
718              
719 10         42 for my $ve ( $e->findnodes($xp_via) ) {
720 62         2092 my $e_vdate = ( $ve->findnodes($xp_date) )[0];
721 62         1176 my $e_vtime = ( $ve->findnodes($xp_time) )[0];
722              
723 62 100 33     1222 if ( not( $e_vdate and $e_vtime )
      66        
724             or ( $e_vdate->getAttribute('weekday') == -1 ) )
725             {
726 10         317 next;
727             }
728              
729 52         1524 my $name = $ve->getAttribute('name');
730 52         533 my $platform = $ve->getAttribute('platformName');
731 52         484 my $arr_delay = $ve->getAttribute('arrDelay');
732              
733 52 100 100     631 if ( $name eq $hash->{departure_stop}
734             or $name eq $hash->{arrival_stop} )
735             {
736 18         64 next;
737             }
738              
739             push(
740 34         83 @{ $hash->{via} },
  34         119  
741             [
742             $self->itddate_str($e_vdate),
743             $self->itdtime_str($e_vtime),
744             $name,
745             $platform,
746             $arr_delay,
747             ]
748             );
749             }
750              
751             $hash->{regular_notes}
752 10         192 = [ map { $self->parse_reg_info($_) } @e_sinfo ];
  5         309  
753 10         258 $hash->{current_notes} = [ map { $self->parse_cur_info($_) } @e_cinfo ];
  0         0  
754              
755 10         40 push( @route_parts, $hash );
756             }
757              
758             push(
759 4         722 @{ $self->{routes} },
  4         114  
760             Travel::Routing::DE::EFA::Route->new( $info, @route_parts )
761             );
762              
763 4         19 return;
764             }
765              
766             sub parse_xml {
767 1     1 0 4 my ($self) = @_;
768              
769             my $tree = $self->{tree} = XML::LibXML->load_xml(
770             string => $self->{xml_reply},
771 1         23 );
772              
773 1 50       8386 if ( $self->{config}->{developer_mode} ) {
774 0         0 say $tree->toString(2);
775             }
776              
777 1         49 my $xp_element = XML::LibXML::XPathExpression->new(
778             '//itdItinerary/itdRouteList/itdRoute');
779 1         13 my $xp_err = XML::LibXML::XPathExpression->new(
780             '//itdTripRequest/itdMessage[@type="error"]');
781 1         4 my $xp_odv = XML::LibXML::XPathExpression->new('//itdOdv');
782              
783 1         10 for my $odv ( $tree->findnodes($xp_odv) ) {
784 3         220 $self->check_ambiguous_xml($odv);
785             }
786              
787 1         13 my $err = ( $tree->findnodes($xp_err) )[0];
788 1 50       237 if ($err) {
789 0         0 Travel::Routing::DE::EFA::Exception::Other->throw(
790             message => $err->textContent );
791             }
792              
793 1         5 for my $part ( $tree->findnodes($xp_element) ) {
794 4         331 $self->parse_xml_part($part);
795             }
796              
797 1 50 33     42 if ( not defined $self->{routes} or @{ $self->{routes} } == 0 ) {
  1         49  
798 0         0 Travel::Routing::DE::EFA::Exception::NoData->throw;
799             }
800              
801 1         11 return 1;
802             }
803              
804             sub check_ambiguous_xml {
805 3     3 0 5 my ( $self, $tree ) = @_;
806              
807 3         12 my $xp_place = XML::LibXML::XPathExpression->new('./itdOdvPlace');
808 3         15 my $xp_name = XML::LibXML::XPathExpression->new('./itdOdvName');
809              
810 3         8 my $xp_place_elem = XML::LibXML::XPathExpression->new('./odvPlaceElem');
811 3         9 my $xp_place_input = XML::LibXML::XPathExpression->new('./odvPlaceInput');
812 3         8 my $xp_name_elem = XML::LibXML::XPathExpression->new('./odvNameElem');
813 3         8 my $xp_name_input = XML::LibXML::XPathExpression->new('./odvNameInput');
814              
815 3         10 my $e_place = ( $tree->findnodes($xp_place) )[0];
816 3         32 my $e_name = ( $tree->findnodes($xp_name) )[0];
817              
818 3 50 33     64 if ( not( $e_place and $e_name ) ) {
819 0         0 cluck('skipping ambiguity check - itdOdvPlace/itdOdvName missing');
820 0         0 return;
821             }
822              
823 3         30 my $s_place = $e_place->getAttribute('state');
824 3         38 my $s_name = $e_name->getAttribute('state');
825              
826 3 50       17 if ( $s_place eq 'list' ) {
827             Travel::Routing::DE::EFA::Exception::Ambiguous->throw(
828             post_key => 'place',
829             post_value =>
830             ( $e_place->findnodes($xp_place_input) )[0]->textContent,
831             possibilities => join( q{ | },
832 0         0 map { $_->textContent }
833 0         0 @{ $e_place->findnodes($xp_place_elem) } )
  0         0  
834             );
835             }
836 3 50       7 if ( $s_name eq 'list' ) {
837             Travel::Routing::DE::EFA::Exception::Ambiguous->throw(
838             post_key => 'name',
839             post_value =>
840             ( $e_name->findnodes($xp_name_input) )[0]->textContent,
841             possibilities => join( q{ | },
842 0         0 map { $_->textContent } @{ $e_name->findnodes($xp_name_elem) } )
  0         0  
  0         0  
843             );
844             }
845              
846 3 50       6 if ( $s_place eq 'notidentified' ) {
847 0         0 Travel::Routing::DE::EFA::Exception::Setup->throw(
848             option => 'place',
849             error => 'unknown place',
850             have => ( $e_place->findnodes($xp_place_input) )[0]->textContent,
851             );
852             }
853 3 50       6 if ( $s_name eq 'notidentified' ) {
854 0         0 Travel::Routing::DE::EFA::Exception::Setup->throw(
855             option => 'name',
856             error => 'unknown name',
857             have => ( $e_name->findnodes($xp_name_input) )[0]->textContent,
858             );
859             }
860              
861             # 'identified' and 'empty' are ok
862              
863 3         7 return;
864             }
865              
866             sub routes {
867 2     2 1 3787 my ($self) = @_;
868              
869 2         5 return @{ $self->{routes} };
  2         10  
870             }
871              
872             # static
873             sub get_efa_urls {
874              
875             # sorted lexically by shortname
876             return (
877             {
878 0     0 1   url => 'https://bsvg.efa.de/bsvagstd/XML_TRIP_REQUEST2',
879             name => 'Braunschweiger Verkehrs-GmbH',
880             shortname => 'BSVG',
881             },
882             {
883             url => 'https://www.ding.eu/ding3/XSLT_TRIP_REQUEST2',
884             name => 'Donau-Iller Nahverkehrsverbund',
885             shortname => 'DING',
886             },
887             {
888             url => 'https://projekte.kvv-efa.de/sl3-alone/XSLT_TRIP_REQUEST2',
889             name => 'Karlsruher Verkehrsverbund',
890             shortname => 'KVV',
891             },
892             {
893             url => 'https://www.linzag.at/static/XSLT_TRIP_REQUEST2',
894             name => 'Linz AG',
895             shortname => 'LinzAG',
896             },
897             {
898             url => 'https://efa.mvv-muenchen.de/mobile/XSLT_TRIP_REQUEST2',
899             name => 'Münchner Verkehrs- und Tarifverbund',
900             shortname => 'MVV',
901             },
902             {
903             url => 'https://www.efa-bw.de/nvbw/XSLT_TRIP_REQUEST2',
904             name => 'Nahverkehrsgesellschaft Baden-Württemberg',
905             shortname => 'NVBW',
906             },
907             {
908             url => 'https://efa.vagfr.de/vagfr3/XSLT_TRIP_REQUEST2',
909             name => 'Freiburger Verkehrs AG',
910             shortname => 'VAG',
911             },
912             {
913             url => 'https://efa.vgn.de/vgnExt_oeffi/XML_TRIP_REQUEST2',
914             name => 'Verkehrsverbund Grossraum Nuernberg',
915             shortname => 'VGN',
916             },
917              
918             # HTTPS: certificate verification fails
919             {
920             url => 'http://efa.vmv-mbh.de/vmv/XML_TRIP_REQUEST2',
921             name => 'Verkehrsgesellschaft Mecklenburg-Vorpommern',
922             shortname => 'VMV',
923             },
924             {
925             url => 'https://www.vrn.de/mngvrn/XML_TRIP_REQUEST2',
926             name => 'Verkehrsverbund Rhein-Neckar',
927             shortname => 'VRN',
928             },
929             {
930             url => 'https://app.vrr.de/vrrstd/XML_TRIP_REQUEST2',
931             name => 'Verkehrsverbund Rhein-Ruhr',
932             shortname => 'VRR',
933             },
934             {
935             url => 'https://efa.vrr.de/rbgstd3/XSLT_TRIP_REQUEST2',
936             name => 'Verkehrsverbund Rhein-Ruhr (alternative)',
937             shortname => 'VRR2',
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__