File Coverage

blib/lib/Travel/Status/DE/EFA.pm
Criterion Covered Total %
statement 143 350 40.8
branch 36 128 28.1
condition 26 81 32.1
subroutine 27 44 61.3
pod 13 22 59.0
total 245 625 39.2


line stmt bran cond sub pod time code
1             package Travel::Status::DE::EFA;
2              
3 2     2   995 use strict;
  2         4  
  2         53  
4 2     2   5 use warnings;
  2         2  
  2         63  
5 2     2   22 use 5.010;
  2         5  
6 2     2   11 use utf8;
  2         3  
  2         18  
7              
8             our $VERSION = '3.19';
9              
10 2     2   94 use Carp qw(confess cluck);
  2         2  
  2         128  
11 2     2   1964 use DateTime;
  2         1418212  
  2         126  
12 2     2   1892 use DateTime::Format::Strptime;
  2         166377  
  2         13  
13 2     2   1009 use Encode qw(encode);
  2         16150  
  2         192  
14 2     2   2246 use IO::Socket::SSL;
  2         235339  
  2         25  
15 2     2   503 use JSON;
  2         6  
  2         26  
16 2     2   1779 use Travel::Status::DE::EFA::Departure;
  2         10  
  2         18  
17 2     2   1467 use Travel::Status::DE::EFA::Info;
  2         8  
  2         14  
18 2     2   1234 use Travel::Status::DE::EFA::Line;
  2         9  
  2         14  
19 2     2   1965 use Travel::Status::DE::EFA::Services;
  2         20  
  2         143  
20 2     2   26 use Travel::Status::DE::EFA::Stop;
  2         5  
  2         26  
21 2     2   1524 use Travel::Status::DE::EFA::Trip;
  2         8  
  2         15  
22 2     2   1994 use LWP::UserAgent;
  2         115339  
  2         144  
23 2     2   44 use URI::Escape qw(uri_escape);
  2         19  
  2         8436  
24              
25             sub new_p {
26 0     0 1 0 my ( $class, %opt ) = @_;
27 0         0 my $promise = $opt{promise}->new;
28              
29 0         0 my $self;
30              
31 0         0 eval { $self = $class->new( %opt, async => 1 ); };
  0         0  
32 0 0       0 if ($@) {
33 0         0 return $promise->reject($@);
34             }
35              
36 0         0 $self->{promise} = $opt{promise};
37              
38             $self->post_with_cache_p->then(
39             sub {
40 0     0   0 my ($content) = @_;
41 0         0 $self->{response} = $self->{json}->decode($content);
42              
43 0 0       0 if ( $self->{developer_mode} ) {
44 0         0 say $self->{json}->pretty->encode( $self->{response} );
45             }
46              
47 0         0 $self->check_for_ambiguous;
48 0         0 $self->check_for_error;
49              
50 0 0       0 if ( $self->{errstr} ) {
51 0         0 $promise->reject( $self->{errstr}, $self );
52 0         0 return;
53             }
54              
55 0         0 $promise->resolve($self);
56 0         0 return;
57             }
58             )->catch(
59             sub {
60 0     0   0 my ( $err, $self ) = @_;
61 0         0 $promise->reject($err);
62 0         0 return;
63             }
64 0         0 )->wait;
65              
66 0         0 return $promise;
67             }
68              
69             sub new {
70 2     2 1 8 my ( $class, %opt ) = @_;
71              
72 2         4 my $encoding = 'UTF-8';
73 2         4 my $tls_insecure = 0;
74 2   50     14 $opt{timeout} //= 10;
75 2 50       6 if ( $opt{timeout} <= 0 ) {
76 0         0 delete $opt{timeout};
77             }
78              
79 2 50 33     26 if (
      33        
      33        
      33        
80             not( $opt{coord}
81             or $opt{name}
82             or $opt{stopfinder}
83             or $opt{stopseq}
84             or $opt{from_json} )
85             )
86             {
87 0         0 confess('You must specify a name');
88             }
89 2 50 33     8 if ( $opt{type}
90             and not( $opt{type} =~ m{ ^ (?: stop | stopID | address | poi ) $ }x ) )
91             {
92 0         0 confess('type must be stop, stopID, address, or poi');
93             }
94              
95 2 50       5 if ( $opt{service} ) {
96 0 0       0 if ( my $service
97             = Travel::Status::DE::EFA::Services::get_service( $opt{service} ) )
98             {
99 0         0 $opt{efa_url} = $service->{url};
100 0 0       0 if ( $opt{coord} ) {
    0          
    0          
101 0         0 $opt{efa_url} .= '/XML_COORD_REQUEST';
102             }
103             elsif ( $opt{stopfinder} ) {
104 0         0 $opt{efa_url} .= '/XML_STOPFINDER_REQUEST';
105             }
106             elsif ( $opt{stopseq} ) {
107 0         0 $opt{efa_url} .= '/XML_STOPSEQCOORD_REQUEST';
108             }
109             else {
110 0         0 $opt{efa_url} .= '/XML_DM_REQUEST';
111             }
112 0   0     0 $opt{time_zone} //= $service->{time_zone};
113 0 0       0 if ( not $service->{tls_verify} ) {
114 0         0 $tls_insecure = 1;
115             }
116 0 0       0 if ( $service->{encoding} ) {
117 0         0 $encoding = $service->{encoding};
118             }
119             }
120             }
121              
122 2   50     13 $opt{time_zone} //= 'Europe/Berlin';
123              
124 2 50       5 if ( not $opt{efa_url} ) {
125 0         0 confess('service or efa_url must be specified');
126             }
127 2   33     22 my $dt = $opt{datetime} // DateTime->now( time_zone => $opt{time_zone} );
128              
129             ## no critic (RegularExpressions::ProhibitUnusedCapture)
130             ## no critic (Variables::ProhibitPunctuationVars)
131              
132 2 50 33     32368 if ( $opt{time}
    50          
133             and $opt{time} =~ m{ ^ (?<hour> \d\d? ) : (?<minute> \d\d ) $ }x )
134             {
135             $dt->set(
136             hour => $+{hour},
137             minute => $+{minute}
138 0         0 );
139             }
140             elsif ( $opt{time} ) {
141 0         0 confess('Invalid time specified');
142             }
143              
144 2 50 33     19 if (
    50          
145             $opt{date}
146             and $opt{date} =~ m{ ^ (?<day> \d\d? ) [.] (?<month> \d\d? ) [.]
147             (?<year> \d{4} )? $ }x
148             )
149             {
150 0 0       0 if ( $+{year} ) {
151             $dt->set(
152             day => $+{day},
153             month => $+{month},
154             year => $+{year}
155 0         0 );
156             }
157             else {
158             $dt->set(
159             day => $+{day},
160             month => $+{month}
161 0         0 );
162             }
163             }
164             elsif ( $opt{date} ) {
165 0         0 confess('Invalid date specified');
166             }
167              
168             my $self = {
169             cache => $opt{cache},
170             response => $opt{from_json},
171             developer_mode => $opt{developer_mode},
172             efa_url => $opt{efa_url},
173             service => $opt{service},
174             tls_insecure => $tls_insecure,
175             strp_stopseq => DateTime::Format::Strptime->new(
176             pattern => '%Y%m%d %H:%M',
177             time_zone => $opt{time_zone},
178             ),
179             strp_stopseq_s => DateTime::Format::Strptime->new(
180             pattern => '%Y%m%d %H:%M:%S',
181             time_zone => $opt{time_zone},
182 2         36 ),
183              
184             json => JSON->new->utf8,
185             };
186              
187 2 50       9293 if ( $opt{coord} ) {
    50          
    50          
188              
189             # outputFormat => 'JSON' returns invalid JSON
190             $self->{post} = {
191             coord => sprintf( '%.7f:%.7f:%s',
192 0         0 $opt{coord}{lon}, $opt{coord}{lat}, 'WGS84[DD.ddddd]' ),
193             radius_1 => 1320,
194             type_1 => 'STOP',
195             coordListOutputFormat => 'list',
196             max => 30,
197             inclFilter => 1,
198             outputFormat => 'rapidJson',
199             };
200             }
201             elsif ( $opt{stopfinder} ) {
202              
203             # filter: 2 (stop) | 4 (street) | 8 (address) | 16 (crossing) | 32 (poi) | 64 (postcod)
204             $self->{post} = {
205             locationServerActive => 1,
206             type_sf => 'any',
207             name_sf => $opt{stopfinder}{name},
208 0         0 anyObjFilter_sf => 2,
209             coordOutputFormat => 'WGS84[DD.DDDDD]',
210             outputFormat => 'JSON',
211             };
212             }
213             elsif ( $opt{stopseq} ) {
214              
215             # outputFormat => 'JSON' also works; leads to different output
216             $self->{post} = {
217             line => $opt{stopseq}{stateless},
218             stop => $opt{stopseq}{stop_id},
219             tripCode => $opt{stopseq}{key},
220             date => $opt{stopseq}{date},
221             time => $opt{stopseq}{time},
222 0         0 coordOutputFormat => 'WGS84[DD.DDDDD]',
223             outputFormat => 'rapidJson',
224             useRealtime => '1',
225             };
226             }
227             else {
228             $self->{post} = {
229             language => 'de',
230             mode => 'direct',
231             outputFormat => 'JSON',
232             type_dm => $opt{type} // 'stop',
233             useProxFootSearch => $opt{proximity_search} ? '1' : '0',
234             useRealtime => '1',
235             itdDateDay => $dt->day,
236             itdDateMonth => $dt->month,
237             itdDateYear => $dt->year,
238             itdTimeHour => $dt->hour,
239             itdTimeMinute => $dt->minute,
240             limit => $opt{num_results} // 40,
241             name_dm =>
242 2 50 50     30 uri_escape( encode( $encoding, $opt{name} ), '^A-Za-z0-9-._~ ' ),
      50        
243             };
244             }
245              
246 2 50       278 if ( $opt{place} ) {
247 0         0 $self->{post}{placeInfo_dm} = 'invalid';
248 0         0 $self->{post}{placeState_dm} = 'empty';
249             $self->{post}{place_dm}
250 0         0 = uri_escape( encode( $encoding, $opt{place} ), '^A-Za-z0-9-._~ ' );
251             }
252              
253 2 50       9 if ( $opt{full_routes} ) {
254 0         0 $self->{post}->{depType} = 'stopEvents';
255 0         0 $self->{post}->{includeCompleteStopSeq} = 1;
256 0         0 $self->{want_full_routes} = 1;
257             }
258              
259 2         18 bless( $self, $class );
260              
261 2 50       11 if ( $opt{user_agent} ) {
262 0         0 $self->{ua} = $opt{user_agent};
263             }
264             else {
265 2   50     8 my %lwp_options = %{ $opt{lwp_options} // { timeout => 10 } };
  2         55  
266 2 50       12 if ($tls_insecure) {
267             $lwp_options{ssl_opts}{SSL_verify_mode}
268 0         0 = IO::Socket::SSL::SSL_VERIFY_NONE;
269 0         0 $lwp_options{ssl_opts}{verify_hostname} = 0;
270             }
271              
272 2         28 $self->{ua} = LWP::UserAgent->new(%lwp_options);
273 2         6738 $self->{ua}->env_proxy;
274             }
275              
276 2 50       10092 if ( $self->{cache} ) {
277             $self->{cache_key}
278             = $self->{efa_url} . '?'
279             . join( '&',
280 0         0 map { $_ . '=' . $self->{post}{$_} } sort keys %{ $self->{post} } );
  0         0  
  0         0  
281             }
282              
283 2 50       10 if ( $opt{async} ) {
284 0         0 return $self;
285             }
286              
287 2 50       10 if ( $self->{developer_mode} ) {
288 0         0 say 'POST ' . $self->{efa_url};
289 0         0 while ( my ( $key, $value ) = each %{ $self->{post} } ) {
  0         0  
290 0         0 printf( "%30s = %s\n", $key, $value );
291             }
292             }
293              
294 2 50       11 if ( not $self->{response} ) {
295 0         0 my ( $response, $error ) = $self->post_with_cache;
296              
297 0 0       0 if ($error) {
298 0         0 $self->{errstr} = $error;
299 0         0 return $self;
300             }
301              
302 0         0 $self->{response} = $self->{json}->decode($response);
303             }
304              
305 2 50       10 if ( $self->{developer_mode} ) {
306 0         0 say $self->{json}->pretty->encode( $self->{response} );
307             }
308              
309 2         32 $self->check_for_ambiguous;
310 2         23 $self->check_for_error;
311              
312 2         52 return $self;
313             }
314              
315             sub post_with_cache {
316 0     0 0 0 my ($self) = @_;
317 0         0 my $cache = $self->{cache};
318 0         0 my $url = $self->{efa_url};
319              
320 0 0       0 if ( $self->{developer_mode} ) {
321 0   0     0 say 'POST ' . ( $self->{cache_key} // $url );
322             }
323              
324 0 0       0 if ($cache) {
325 0         0 my $content = $cache->thaw( $self->{cache_key} );
326 0 0       0 if ($content) {
327 0 0       0 if ( $self->{developer_mode} ) {
328 0         0 say ' cache hit';
329             }
330 0         0 return ( ${$content}, undef );
  0         0  
331             }
332             }
333              
334 0 0       0 if ( $self->{developer_mode} ) {
335 0         0 say ' cache miss';
336             }
337              
338 0         0 my $reply = $self->{ua}->post( $url, $self->{post} );
339              
340 0 0       0 if ( $reply->is_error ) {
341 0         0 return ( undef, $reply->status_line );
342             }
343 0         0 my $content = $reply->content;
344              
345 0 0       0 if ($cache) {
346 0         0 $cache->freeze( $self->{cache_key}, \$content );
347             }
348              
349 0         0 return ( $content, undef );
350             }
351              
352             sub post_with_cache_p {
353 0     0 0 0 my ($self) = @_;
354 0         0 my $cache = $self->{cache};
355 0         0 my $url = $self->{efa_url};
356              
357 0 0       0 if ( $self->{developer_mode} ) {
358 0   0     0 say 'POST ' . ( $self->{cache_key} // $url );
359             }
360              
361 0         0 my $promise = $self->{promise}->new;
362              
363 0 0       0 if ($cache) {
364 0         0 my $content = $cache->thaw( $self->{cache_key} );
365 0 0       0 if ($content) {
366 0 0       0 if ( $self->{developer_mode} ) {
367 0         0 say ' cache hit';
368             }
369 0         0 return $promise->resolve( ${$content} );
  0         0  
370             }
371             }
372              
373 0 0       0 if ( $self->{developer_mode} ) {
374 0         0 say ' cache miss';
375             }
376              
377 0 0       0 if ( $self->{tls_insecure} ) {
378 0         0 $self->{ua}->insecure(1);
379             }
380              
381             $self->{ua}->post_p( $url, form => $self->{post} )->then(
382             sub {
383 0     0   0 my ($tx) = @_;
384 0 0       0 if ( my $err = $tx->error ) {
385 0         0 $promise->reject(
386             "POST $url returned HTTP $err->{code} $err->{message}");
387 0         0 return;
388             }
389 0         0 my $content = $tx->res->body;
390 0 0       0 if ($cache) {
391 0         0 $cache->freeze( $self->{cache_key}, \$content );
392             }
393 0         0 $promise->resolve($content);
394 0         0 return;
395             }
396             )->catch(
397             sub {
398 0     0   0 my ($err) = @_;
399 0         0 $promise->reject($err);
400 0         0 return;
401             }
402 0         0 )->wait;
403              
404 0         0 return $promise;
405             }
406              
407             sub errstr {
408 2     2 1 1159 my ($self) = @_;
409              
410 2         16 return $self->{errstr};
411             }
412              
413             sub name_candidates {
414 1     1 1 3 my ($self) = @_;
415              
416 1 50       3 if ( $self->{name_candidates} ) {
417 1         2 return @{ $self->{name_candidates} };
  1         3  
418             }
419 0         0 return;
420             }
421              
422             sub place_candidates {
423 1     1 1 4 my ($self) = @_;
424              
425 1 50       5 if ( $self->{place_candidates} ) {
426 0         0 return @{ $self->{place_candidates} };
  0         0  
427             }
428 1         7 return;
429             }
430              
431             sub check_for_error {
432 2     2 0 5 my ($self) = @_;
433              
434 2         6 my $json = $self->{response};
435              
436 2         4 my %kv;
437 2   100     5 for my $m ( @{ $json->{dm}{message} // [] } ) {
  2         15  
438 4         20 $kv{ $m->{name} } = $m->{value};
439             }
440              
441 2 100       10 if ( $kv{error} ) {
442 1         4 $self->{errstr} = "Backend error: $kv{error}";
443             }
444              
445 2         8 return;
446             }
447              
448             sub check_for_ambiguous {
449 3     3 0 1484 my ($self) = @_;
450              
451 3         9 my $json = $self->{response};
452              
453 3 100       16 if ( $json->{departureList} ) {
454 1         2 return;
455             }
456              
457 2   50     4 for my $m ( @{ $json->{dm}{message} // [] } ) {
  2         13  
458 4 100 66     25 if ( $m->{name} eq 'error' and $m->{value} eq 'name list' ) {
459 2         10 $self->{errstr} = "ambiguous name parameter";
460 2         28 $self->{name_candidates} = [];
461 2   50     6 for my $point ( @{ $json->{dm}{points} // [] } ) {
  2         9  
462 6         19 my $place = $point->{ref}{place};
463             push(
464 6         124 @{ $self->{name_candidates} },
465             Travel::Status::DE::EFA::Stop->new(
466             place => $place,
467             full_name => $point->{name},
468             name => $point->{name} =~ s{\Q$place\E,? ?}{}r,
469             id_num => $point->{ref}{id},
470             )
471 6         11 );
472             }
473 2         8 return;
474             }
475 2 50 33     10 if ( $m->{name} eq 'error' and $m->{value} eq 'place list' ) {
476 0         0 $self->{errstr} = "ambiguous name parameter";
477 0         0 $self->{place_candidates} = [];
478 0   0     0 for my $point ( @{ $json->{dm}{points} // [] } ) {
  0         0  
479 0         0 my $place = $point->{ref}{place};
480             push(
481 0         0 @{ $self->{place_candidates} },
482             Travel::Status::DE::EFA::Stop->new(
483             place => $place,
484             full_name => $point->{name},
485             name => $point->{name} =~ s{\Q$place\E,? ?}{}r,
486             id_num => $point->{ref}{id},
487             )
488 0         0 );
489             }
490 0         0 return;
491             }
492             }
493              
494 0         0 return;
495             }
496              
497             sub stop {
498 0     0 1 0 my ($self) = @_;
499 0 0       0 if ( $self->{stop} ) {
500 0         0 return $self->{stop};
501             }
502              
503 0         0 my $point = $self->{response}{dm}{points}{point};
504 0         0 my $place = $point->{ref}{place};
505              
506             $self->{stop} = Travel::Status::DE::EFA::Stop->new(
507             place => $place,
508             full_name => $point->{name},
509             name => $point->{name} =~ s{\Q$place\E,? ?}{}r,
510             id_num => $point->{ref}{id},
511             id_code => $point->{ref}{gid},
512 0         0 );
513              
514 0         0 return $self->{stop};
515             }
516              
517             sub stops {
518 0     0 1 0 my ($self) = @_;
519              
520 0 0       0 if ( $self->{stops} ) {
521 0         0 return @{ $self->{stops} };
  0         0  
522             }
523              
524 0   0     0 my $stops = $self->{response}{dm}{itdOdvAssignedStops} // [];
525              
526 0 0       0 if ( ref($stops) eq 'HASH' ) {
527 0         0 $stops = [$stops];
528             }
529              
530 0         0 my @stops;
531 0         0 for my $stop ( @{$stops} ) {
  0         0  
532             push(
533             @stops,
534             Travel::Status::DE::EFA::Stop->new(
535             place => $stop->{place},
536             name => $stop->{name},
537             full_name => $stop->{nameWithPlace},
538             id_num => $stop->{stopID},
539             id_code => $stop->{gid},
540             )
541 0         0 );
542             }
543              
544 0         0 $self->{stops} = \@stops;
545 0         0 return @stops;
546             }
547              
548             sub infos {
549 0     0 0 0 my ($self) = @_;
550              
551 0 0       0 if ( $self->{infos} ) {
552 0         0 return @{ $self->{infos} };
  0         0  
553             }
554              
555 0   0     0 for my $info ( @{ $self->{response}{dm}{points}{point}{infos} // [] } ) {
  0         0  
556             push(
557 0         0 @{ $self->{infos} },
  0         0  
558             Travel::Status::DE::EFA::Info->new( json => $info )
559             );
560             }
561              
562 0   0     0 return @{ $self->{infos} // [] };
  0         0  
563             }
564              
565             sub lines {
566 1     1 1 825 my ($self) = @_;
567              
568 1 50       5 if ( $self->{lines} ) {
569 0         0 return @{ $self->{lines} };
  0         0  
570             }
571              
572 1   50     2 for my $line ( @{ $self->{response}{servingLines}{lines} // [] } ) {
  1         8  
573 0         0 push( @{ $self->{lines} }, $self->parse_line($line) );
  0         0  
574             }
575              
576 1   50     2 return @{ $self->{lines} // [] };
  1         7  
577             }
578              
579             sub parse_line {
580 0     0 0 0 my ( $self, $line ) = @_;
581              
582 0   0     0 my $mode = $line->{mode} // {};
583              
584             return Travel::Status::DE::EFA::Line->new(
585             type => $mode->{product},
586             name => $mode->{name},
587             number => $mode->{number},
588             direction => $mode->{destination},
589             valid => $mode->{timetablePeriod},
590             mot => $mode->{product},
591             operator => $mode->{diva}{operator},
592             identifier => $mode->{diva}{globalId},
593              
594 0         0 );
595             }
596              
597             sub results {
598 2     2 1 9 my ($self) = @_;
599              
600 2 50       11 if ( $self->{results} ) {
601 0         0 return @{ $self->{results} };
  0         0  
602             }
603              
604 2 50       16 if ( $self->{post}{coord} ) {
    50          
605 0         0 return $self->results_coord;
606             }
607             elsif ( $self->{post}{name_sf} ) {
608 0         0 return $self->results_stopfinder;
609             }
610             else {
611 2         20 return $self->results_dm;
612             }
613             }
614              
615             sub results_coord {
616 0     0 0 0 my ($self) = @_;
617 0         0 my $json = $self->{response};
618              
619 0         0 my @results;
620 0   0     0 for my $stop ( @{ $json->{locations} // [] } ) {
  0         0  
621             push(
622             @results,
623             Travel::Status::DE::EFA::Stop->new(
624             place => $stop->{parent}{name},
625             full_name => $stop->{properties}{STOP_NAME_WITH_PLACE},
626             distance_m => $stop->{properties}{distance},
627             name => $stop->{name},
628             id_code => $stop->{id},
629             )
630 0         0 );
631             }
632              
633 0         0 $self->{results} = \@results;
634              
635 0         0 return @results;
636             }
637              
638             sub results_stopfinder {
639 0     0 0 0 my ($self) = @_;
640 0         0 my $json = $self->{response};
641              
642 0         0 my @results;
643              
644             # Edge case: there is just a single result.
645             # Oh EFA, you so silly.
646 0 0 0     0 if ( ref( $json->{stopFinder}{points} ) eq 'HASH'
647             and exists $json->{stopFinder}{points}{point} )
648             {
649 0         0 $json->{stopFinder}{points} = [ $json->{stopFinder}{points}{point} ];
650             }
651              
652 0   0     0 for my $stop ( @{ $json->{stopFinder}{points} // [] } ) {
  0         0  
653             push(
654             @results,
655             Travel::Status::DE::EFA::Stop->new(
656             place => $stop->{ref}{place},
657             full_name => $stop->{name},
658             name => $stop->{object},
659             id_num => $stop->{ref}{id},
660             id_code => $stop->{ref}{gid},
661             )
662 0         0 );
663             }
664              
665 0         0 $self->{results} = \@results;
666              
667 0         0 return @results;
668             }
669              
670             sub results_dm {
671 2     2 0 6 my ($self) = @_;
672 2         6 my $json = $self->{response};
673              
674             # Oh EFA, you so silly
675 2 50 66     15 if ( $json->{departureList} and ref( $json->{departureList} ) eq 'HASH' ) {
676 0         0 $json->{departureList} = [ $json->{departureList}{departure} ];
677             }
678              
679 2         5 my @results;
680 2   100     5 for my $departure ( @{ $json->{departureList} // [] } ) {
  2         14  
681             push(
682             @results,
683             Travel::Status::DE::EFA::Departure->new(
684             json => $departure,
685             strp_stopseq => $self->{strp_stopseq},
686             strp_stopseq_s => $self->{strp_stopseq_s}
687             )
688 40         143 );
689             }
690              
691 40         43 @results = map { $_->[0] }
692 75         128 sort { $a->[1] <=> $b->[1] }
693 2         7 map { [ $_, $_->countdown ] } @results;
  40         310  
694              
695 2         10 $self->{results} = \@results;
696              
697 2         17 return @results;
698             }
699              
700             sub result {
701 0     0 1   my ($self) = @_;
702              
703 0           return Travel::Status::DE::EFA::Trip->new( json => $self->{response} );
704             }
705              
706             # static
707             sub get_service_ids {
708 0     0 1   return Travel::Status::DE::EFA::Services::get_service_ids(@_);
709             }
710              
711             sub get_services {
712 0     0 1   my @services;
713 0           for my $service ( Travel::Status::DE::EFA::Services::get_service_ids() ) {
714             my %desc
715 0           = %{ Travel::Status::DE::EFA::Services::get_service($service) };
  0            
716 0           $desc{shortname} = $service;
717 0           push( @services, \%desc );
718             }
719 0           return @services;
720             }
721              
722             # static
723             sub get_service {
724 0     0 1   return Travel::Status::DE::EFA::Services::get_service(@_);
725             }
726              
727             1;
728              
729             __END__
730              
731             =head1 NAME
732              
733             Travel::Status::DE::EFA - unofficial EFA departure monitor
734              
735             =head1 SYNOPSIS
736              
737             use Travel::Status::DE::EFA;
738              
739             my $status = Travel::Status::DE::EFA->new(
740             service => 'VRR',
741             name => 'Essen Helenenstr'
742             );
743              
744             for my $d ($status->results) {
745             printf(
746             "%s %-8s %-5s %s\n",
747             $d->datetime->strftime('%H:%M'),
748             $d->platform_name, $d->line, $d->destination
749             );
750             }
751              
752             =head1 VERSION
753              
754             version 3.19
755              
756             =head1 DESCRIPTION
757              
758             Travel::Status::DE::EFA is an unofficial interface to EFA-based departure
759             monitors.
760              
761             It can serve as a departure monitor, request details about a specific
762             trip/journey, and look up public transport stops by name or geolocation.
763             The operating mode depends on its constructor arguments.
764              
765             =head1 METHODS
766              
767             =over
768              
769             =item my $status = Travel::Status::DE::EFA->new(I<%opt>)
770              
771             Requests data as specified by I<opts> and returns a new Travel::Status::DE::EFA
772             object. B<service> and exactly one of B<coord>, B<stopfinder>, B<stopseq> or
773             B<name> are mandatory. Dies if the wrong I<opts> were passed.
774              
775             Arguments:
776              
777             =over
778              
779             =item B<service> => I<name>
780              
781             EFA service. See C<< efa-m --list >> for known services.
782             If you found a service not listed there, please notify
783             E<lt>derf+efa@finalrewind.orgE<gt>.
784              
785             =item B<coord> => I<hashref>
786              
787             Look up stops in the vicinity of the given coordinates. I<hashref> must
788             contain a B<lon> and a B<lat> element providing WGS84 longitude/latitude.
789              
790             =item B<stopfinder> => { B<name> => I<name> }
791              
792             Look up stops matching I<name>.
793              
794             =item B<stopseq> => I<hashref>
795              
796             Look up trip details. I<hashref> must provide B<stateless> (line ID),
797             B<stop_id> (stop ID used as start for the reported route), B<key> (line trip
798             number), and B<date> (departure date as YYYYMMDD string).
799              
800             =item B<name> => I<name>
801              
802             List departure for address / point of interest / stop I<name>.
803              
804             =item B<place> => I<place>
805              
806             Name of the place/city
807              
808             =item B<type> => B<address>|B<poi>|B<stop>|B<stopID>
809              
810             Type of the following I<name>. B<poi> means "point of interest". Defaults to
811             B<stop> (stop/station name).
812              
813             =item B<datetime> => I<DateTime object>
814              
815             Request departures for the date/time specified by I<DateTime object>.
816             Default: now.
817              
818             =item B<num_results> => I<n>
819              
820             Request up to I<n> departures. Default: 40.
821              
822             =item B<full_routes> => B<0>|B<1>
823              
824             If true: Request full routes for all departures from the backend. This
825             enables the B<route_pre>, B<route_post> and B<route_interesting> accessors in
826             Travel::Status::DE::EFA::Departure(3pm).
827              
828             =item B<proximity_search> => B<0>|B<1>
829              
830             If true: Show departures for stops in the proximity of the requested place
831             as well.
832              
833             =item B<timeout> => I<seconds>
834              
835             Request timeout, the argument is passed on to LWP::UserAgent(3pm).
836             Default: 10 seconds. Set to 0 or a negative value to disable it.
837              
838             =back
839              
840             =item my $status_p = Travel::Status::DE::EFA->new_p(I<%opt>)
841              
842             Returns a promise that resolves into a Travel::Status::DE::EFA instance
843             ($status) on success and rejects with an error message on failure. In case
844             the error occured after construction of the Travel::Status::DE::EFA object
845             (e.g. due to an ambiguous name/place parameter), the second argument of the
846             rejected promise holds a Travel::Status::DE::EFA instance that can be used
847             to query place/name candidates (see name_candidates and place_candidates).
848              
849             In addition to the arguments of B<new>, the following mandatory arguments must
850             be set.
851              
852             =over
853              
854             =item B<promise> => I<promises module>
855              
856             Promises implementation to use for internal promises as well as B<new_p> return
857             value. Recommended: Mojo::Promise(3pm).
858              
859             =item B<user_agent> => I<user agent>
860              
861             User agent instance to use for asynchronous requests. The object must implement
862             a B<post_p> function. Recommended: Mojo::UserAgent(3pm).
863              
864             =back
865              
866             =item $status->errstr
867              
868             In case of an HTTP request or EFA error, returns a string describing it. If
869             none occured, returns undef.
870              
871             =item $status->lines
872              
873             Returns a list of Travel::Status::DE::EFA::Line(3pm) objects, each one
874             describing one line servicing the selected station.
875              
876             =item $status->name_candidates
877              
878             Returns a list of B<name> candidates if I<name> is ambiguous. Returns
879             nothing (undef / empty list) otherwise.
880              
881             =item $status->place_candidates
882              
883             Returns a list of B<place> candidates if I<place> is ambiguous. Returns
884             nothing (undef / empty list) otherwise.
885              
886             =item $status->stop
887              
888             Returns a Travel::Status::DE::EFA::Stop(3pm) instance describing the requested
889             stop.
890              
891             =item $status->stops
892              
893             In case the requested place/name is served by multiple stops and the backend
894             provides a list of those: returns a list of Travel::Status::DE::EFA::Stop(3pm)
895             instances describing each of them. Returns an empty list otherwise.
896              
897             =item $status->results
898              
899             In departure monitor mode: returns a list of
900             Travel::Status::DE::EFA::Departure(3pm) objects, each one describing one
901             departure.
902              
903             In coord or stopfinder mode: returns a list of
904             Travel::Status::DE::EFA::Stop(3pm) objects.
905              
906             =item $status->result
907              
908             In stopseq mode: Returns a Travel::Status::DE::EFA::Trip(3pm) object.
909              
910             =item Travel::Status::DE::EFA::get_service_ids()
911              
912             Returns the list of supported services (backends).
913              
914             =item Travel::Status::DE::EFA::get_service(I<service>)
915              
916             Returns a hashref describing the requested I<service> ID with the following keys.
917              
918             =over
919              
920             =item B<name> => I<string>
921              
922             Provider name, e.g. Verkehrsverbund Oberelbe.
923              
924             =item B<url> => I<string>
925              
926             Backend base URL.
927              
928             =item B<homepage> => I<string> (optional)
929              
930             Provider homepage.
931              
932             =item B<languages> => I<arrayref> (optional)
933              
934             Supportde languages, e.g. de, en.
935              
936             =item B<coverage> => I<hashref>
937              
938             Area in which the service provides near-optimal coverage. Typically, this
939             means a (nearly) complete list of departures and real-time data. The
940             hashref contains two optional keys: B<area> (GeoJSON) and B<regions> (list of
941             strings, e.g. "DE" or "CH-BE").
942              
943             =back
944              
945             =item Travel::Status::DE::EFA::get_services()
946              
947             Returns a list of hashrefs describing all supported services. In addition
948             to the keys listed above, each service contains a B<shortname> (service ID).
949              
950             =back
951              
952             =head1 DIAGNOSTICS
953              
954             None.
955              
956             =head1 DEPENDENCIES
957              
958             =over
959              
960             =item * Class::Accessor(3pm)
961              
962             =item * DateTime(3pm)
963              
964             =item * DateTime::Format::Strptime(3pm)
965              
966             =item * JSON(3pm)
967              
968             =item * LWP::UserAgent(3pm)
969              
970             =back
971              
972             =head1 BUGS AND LIMITATIONS
973              
974             The API is not exposed completely.
975              
976             =head1 SEE ALSO
977              
978             efa-m(1), Travel::Status::DE::EFA::Departure(3pm).
979              
980             =head1 AUTHOR
981              
982             Copyright (C) 2011-2026 Birte Kristina Friesel E<lt>derf@finalrewind.orgE<gt>
983              
984             =head1 LICENSE
985              
986             This module is licensed under the same terms as Perl itself.