line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Travel::Status::DE::HAFAS; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
# vim:foldmethod=marker |
4
|
|
|
|
|
|
|
|
5
|
1
|
|
|
1
|
|
144417
|
use strict; |
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
30
|
|
6
|
1
|
|
|
1
|
|
7
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
23
|
|
7
|
1
|
|
|
1
|
|
28
|
use 5.014; |
|
1
|
|
|
|
|
4
|
|
8
|
1
|
|
|
1
|
|
7
|
use utf8; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
17
|
|
9
|
|
|
|
|
|
|
|
10
|
1
|
|
|
1
|
|
730
|
no if $] >= 5.018, warnings => 'experimental::smartmatch'; |
|
1
|
|
|
|
|
18
|
|
|
1
|
|
|
|
|
7
|
|
11
|
|
|
|
|
|
|
|
12
|
1
|
|
|
1
|
|
92
|
use Carp qw(confess); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
46
|
|
13
|
1
|
|
|
1
|
|
985
|
use DateTime; |
|
1
|
|
|
|
|
548599
|
|
|
1
|
|
|
|
|
57
|
|
14
|
1
|
|
|
1
|
|
606
|
use DateTime::Format::Strptime; |
|
1
|
|
|
|
|
200421
|
|
|
1
|
|
|
|
|
7
|
|
15
|
1
|
|
|
1
|
|
76
|
use Digest::MD5 qw(md5_hex); |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
60
|
|
16
|
1
|
|
|
1
|
|
731
|
use Encode qw(decode encode); |
|
1
|
|
|
|
|
11057
|
|
|
1
|
|
|
|
|
84
|
|
17
|
1
|
|
|
1
|
|
10
|
use JSON; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
14
|
|
18
|
1
|
|
|
1
|
|
1317
|
use LWP::UserAgent; |
|
1
|
|
|
|
|
51181
|
|
|
1
|
|
|
|
|
44
|
|
19
|
1
|
|
|
1
|
|
502
|
use Travel::Status::DE::HAFAS::Message; |
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
13
|
|
20
|
1
|
|
|
1
|
|
486
|
use Travel::Status::DE::HAFAS::Polyline qw(decode_polyline); |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
62
|
|
21
|
1
|
|
|
1
|
|
498
|
use Travel::Status::DE::HAFAS::Journey; |
|
1
|
|
|
|
|
12
|
|
|
1
|
|
|
|
|
6
|
|
22
|
1
|
|
|
1
|
|
532
|
use Travel::Status::DE::HAFAS::StopFinder; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
35
|
|
23
|
1
|
|
|
1
|
|
7
|
use Travel::Status::DE::HAFAS::Stop; |
|
1
|
|
|
|
|
10
|
|
|
1
|
|
|
|
|
7
|
|
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
our $VERSION = '4.16'; |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
# {{{ Endpoint Definition |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
my %hafas_instance = ( |
30
|
|
|
|
|
|
|
DB => { |
31
|
|
|
|
|
|
|
stopfinder => 'https://reiseauskunft.bahn.de/bin/ajax-getstop.exe', |
32
|
|
|
|
|
|
|
mgate => 'https://reiseauskunft.bahn.de/bin/mgate.exe', |
33
|
|
|
|
|
|
|
name => 'Deutsche Bahn', |
34
|
|
|
|
|
|
|
productbits => [qw[ice ic_ec d regio s bus ferry u tram ondemand]], |
35
|
|
|
|
|
|
|
salt => 'bdI8UVj4' . '0K5fvxwf', |
36
|
|
|
|
|
|
|
request => { |
37
|
|
|
|
|
|
|
client => { |
38
|
|
|
|
|
|
|
id => 'DB', |
39
|
|
|
|
|
|
|
v => '20100000', |
40
|
|
|
|
|
|
|
type => 'IPH', |
41
|
|
|
|
|
|
|
name => 'DB Navigator', |
42
|
|
|
|
|
|
|
}, |
43
|
|
|
|
|
|
|
ext => 'DB.R21.12.a', |
44
|
|
|
|
|
|
|
ver => '1.15', |
45
|
|
|
|
|
|
|
auth => { |
46
|
|
|
|
|
|
|
type => 'AID', |
47
|
|
|
|
|
|
|
aid => 'n91dB8Z77' . 'MLdoR0K' |
48
|
|
|
|
|
|
|
}, |
49
|
|
|
|
|
|
|
}, |
50
|
|
|
|
|
|
|
}, |
51
|
|
|
|
|
|
|
NAHSH => { |
52
|
|
|
|
|
|
|
mgate => 'https://nah.sh.hafas.de/bin/mgate.exe', |
53
|
|
|
|
|
|
|
stopfinder => 'https://nah.sh.hafas.de/bin/ajax-getstop.exe', |
54
|
|
|
|
|
|
|
name => 'Nahverkehrsverbund Schleswig-Holstein', |
55
|
|
|
|
|
|
|
productbits => [qw[ice ice ice regio s bus ferry u tram ondemand]], |
56
|
|
|
|
|
|
|
request => { |
57
|
|
|
|
|
|
|
client => { |
58
|
|
|
|
|
|
|
id => 'NAHSH', |
59
|
|
|
|
|
|
|
v => '3000700', |
60
|
|
|
|
|
|
|
type => 'IPH', |
61
|
|
|
|
|
|
|
name => 'NAHSHPROD', |
62
|
|
|
|
|
|
|
}, |
63
|
|
|
|
|
|
|
ver => '1.16', |
64
|
|
|
|
|
|
|
auth => { |
65
|
|
|
|
|
|
|
type => 'AID', |
66
|
|
|
|
|
|
|
aid => 'r0Ot9FLF' . 'NAFxijLW' |
67
|
|
|
|
|
|
|
}, |
68
|
|
|
|
|
|
|
}, |
69
|
|
|
|
|
|
|
}, |
70
|
|
|
|
|
|
|
NASA => { |
71
|
|
|
|
|
|
|
mgate => 'https://reiseauskunft.insa.de/bin/mgate.exe', |
72
|
|
|
|
|
|
|
stopfinder => 'https://reiseauskunft.insa.de/bin/ajax-getstop.exe', |
73
|
|
|
|
|
|
|
name => 'Nahverkehrsservice Sachsen-Anhalt', |
74
|
|
|
|
|
|
|
productbits => [qw[ice ice regio regio regio tram bus ondemand]], |
75
|
|
|
|
|
|
|
request => { |
76
|
|
|
|
|
|
|
client => { |
77
|
|
|
|
|
|
|
id => 'NASA', |
78
|
|
|
|
|
|
|
v => '4000200', |
79
|
|
|
|
|
|
|
type => 'IPH', |
80
|
|
|
|
|
|
|
name => 'nasaPROD', |
81
|
|
|
|
|
|
|
os => 'iPhone OS 13.1.2', |
82
|
|
|
|
|
|
|
}, |
83
|
|
|
|
|
|
|
ver => '1.18', |
84
|
|
|
|
|
|
|
auth => { |
85
|
|
|
|
|
|
|
type => 'AID', |
86
|
|
|
|
|
|
|
aid => 'nasa-' . 'apps', |
87
|
|
|
|
|
|
|
}, |
88
|
|
|
|
|
|
|
lang => 'deu', |
89
|
|
|
|
|
|
|
}, |
90
|
|
|
|
|
|
|
}, |
91
|
|
|
|
|
|
|
NVV => { |
92
|
|
|
|
|
|
|
mgate => 'https://auskunft.nvv.de/auskunft/bin/app/mgate.exe', |
93
|
|
|
|
|
|
|
stopfinder => |
94
|
|
|
|
|
|
|
'https://auskunft.nvv.de/auskunft/bin/jp/ajax-getstop.exe', |
95
|
|
|
|
|
|
|
name => 'Nordhessischer VerkehrsVerbund', |
96
|
|
|
|
|
|
|
productbits => |
97
|
|
|
|
|
|
|
[qw[ice ic_ec regio s u tram bus bus ferry ondemand regio regio]], |
98
|
|
|
|
|
|
|
request => { |
99
|
|
|
|
|
|
|
client => { |
100
|
|
|
|
|
|
|
id => 'NVV', |
101
|
|
|
|
|
|
|
v => '5000300', |
102
|
|
|
|
|
|
|
type => 'IPH', |
103
|
|
|
|
|
|
|
name => 'NVVMobilPROD_APPSTORE', |
104
|
|
|
|
|
|
|
os => 'iOS 13.1.2', |
105
|
|
|
|
|
|
|
}, |
106
|
|
|
|
|
|
|
ext => 'NVV.6.0', |
107
|
|
|
|
|
|
|
ver => '1.18', |
108
|
|
|
|
|
|
|
auth => { |
109
|
|
|
|
|
|
|
type => 'AID', |
110
|
|
|
|
|
|
|
aid => 'Kt8eNOH7' . 'qjVeSxNA', |
111
|
|
|
|
|
|
|
}, |
112
|
|
|
|
|
|
|
lang => 'deu', |
113
|
|
|
|
|
|
|
}, |
114
|
|
|
|
|
|
|
}, |
115
|
|
|
|
|
|
|
'ÖBB' => { |
116
|
|
|
|
|
|
|
mgate => 'https://fahrplan.oebb.at/bin/mgate.exe', |
117
|
|
|
|
|
|
|
stopfinder => 'https://fahrplan.oebb.at/bin/ajax-getstop.exe', |
118
|
|
|
|
|
|
|
name => 'Österreichische Bundesbahnen', |
119
|
|
|
|
|
|
|
productbits => |
120
|
|
|
|
|
|
|
[qw[ice ice ice regio regio s bus ferry u tram ice ondemand ice]], |
121
|
|
|
|
|
|
|
request => { |
122
|
|
|
|
|
|
|
client => { |
123
|
|
|
|
|
|
|
id => 'OEBB', |
124
|
|
|
|
|
|
|
v => '6030600', |
125
|
|
|
|
|
|
|
type => 'IPH', |
126
|
|
|
|
|
|
|
name => 'oebbPROD-ADHOC', |
127
|
|
|
|
|
|
|
}, |
128
|
|
|
|
|
|
|
ver => '1.41', |
129
|
|
|
|
|
|
|
auth => { |
130
|
|
|
|
|
|
|
type => 'AID', |
131
|
|
|
|
|
|
|
aid => 'OWDL4fE4' . 'ixNiPBBm', |
132
|
|
|
|
|
|
|
}, |
133
|
|
|
|
|
|
|
lang => 'deu', |
134
|
|
|
|
|
|
|
}, |
135
|
|
|
|
|
|
|
}, |
136
|
|
|
|
|
|
|
VBB => { |
137
|
|
|
|
|
|
|
mgate => 'https://fahrinfo.vbb.de/bin/mgate.exe', |
138
|
|
|
|
|
|
|
stopfinder => 'https://fahrinfo.vbb.de/bin/ajax-getstop.exe', |
139
|
|
|
|
|
|
|
name => 'Verkehrsverbund Berlin-Brandenburg', |
140
|
|
|
|
|
|
|
productbits => [qw[s u tram bus ferry ice regio]], |
141
|
|
|
|
|
|
|
request => { |
142
|
|
|
|
|
|
|
client => { |
143
|
|
|
|
|
|
|
id => 'VBB', |
144
|
|
|
|
|
|
|
type => 'WEB', |
145
|
|
|
|
|
|
|
name => 'VBB WebApp', |
146
|
|
|
|
|
|
|
l => 'vs_webapp_vbb', |
147
|
|
|
|
|
|
|
}, |
148
|
|
|
|
|
|
|
ext => 'VBB.1', |
149
|
|
|
|
|
|
|
ver => '1.33', |
150
|
|
|
|
|
|
|
auth => { |
151
|
|
|
|
|
|
|
type => 'AID', |
152
|
|
|
|
|
|
|
aid => 'hafas-vb' . 'b-webapp', |
153
|
|
|
|
|
|
|
}, |
154
|
|
|
|
|
|
|
lang => 'deu', |
155
|
|
|
|
|
|
|
}, |
156
|
|
|
|
|
|
|
}, |
157
|
|
|
|
|
|
|
VBN => { |
158
|
|
|
|
|
|
|
mgate => 'https://fahrplaner.vbn.de/bin/mgate.exe', |
159
|
|
|
|
|
|
|
stopfinder => 'https://fahrplaner.vbn.de/hafas/ajax-getstop.exe', |
160
|
|
|
|
|
|
|
name => 'Verkehrsverbund Bremen/Niedersachsen', |
161
|
|
|
|
|
|
|
productbits => [qw[ice ice regio regio s bus ferry u tram ondemand]], |
162
|
|
|
|
|
|
|
salt => 'SP31mBu' . 'fSyCLmNxp', |
163
|
|
|
|
|
|
|
micmac => 1, |
164
|
|
|
|
|
|
|
request => { |
165
|
|
|
|
|
|
|
client => { |
166
|
|
|
|
|
|
|
id => 'VBN', |
167
|
|
|
|
|
|
|
v => '6000000', |
168
|
|
|
|
|
|
|
type => 'IPH', |
169
|
|
|
|
|
|
|
name => 'vbn', |
170
|
|
|
|
|
|
|
}, |
171
|
|
|
|
|
|
|
ver => '1.42', |
172
|
|
|
|
|
|
|
auth => { |
173
|
|
|
|
|
|
|
type => 'AID', |
174
|
|
|
|
|
|
|
aid => 'kaoxIXLn' . '03zCr2KR', |
175
|
|
|
|
|
|
|
}, |
176
|
|
|
|
|
|
|
lang => 'deu', |
177
|
|
|
|
|
|
|
}, |
178
|
|
|
|
|
|
|
}, |
179
|
|
|
|
|
|
|
); |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
# }}} |
182
|
|
|
|
|
|
|
# {{{ Constructors |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
sub new { |
185
|
1
|
|
|
1
|
1
|
3146
|
my ( $obj, %conf ) = @_; |
186
|
1
|
|
|
|
|
7
|
my $service = $conf{service}; |
187
|
|
|
|
|
|
|
|
188
|
1
|
|
|
|
|
4
|
my $ua = $conf{user_agent}; |
189
|
|
|
|
|
|
|
|
190
|
1
|
50
|
|
|
|
6
|
if ( not $ua ) { |
191
|
1
|
|
50
|
|
|
3
|
my %lwp_options = %{ $conf{lwp_options} // { timeout => 10 } }; |
|
1
|
|
|
|
|
12
|
|
192
|
1
|
|
|
|
|
15
|
$ua = LWP::UserAgent->new(%lwp_options); |
193
|
1
|
|
|
|
|
3191
|
$ua->env_proxy; |
194
|
|
|
|
|
|
|
} |
195
|
|
|
|
|
|
|
|
196
|
1
|
0
|
33
|
|
|
4505
|
if ( |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
197
|
|
|
|
|
|
|
not( $conf{station} |
198
|
|
|
|
|
|
|
or $conf{journey} |
199
|
|
|
|
|
|
|
or $conf{geoSearch} |
200
|
|
|
|
|
|
|
or $conf{locationSearch} ) |
201
|
|
|
|
|
|
|
) |
202
|
|
|
|
|
|
|
{ |
203
|
0
|
|
|
|
|
0
|
confess( |
204
|
|
|
|
|
|
|
'station / journey / geoSearch / locationSearch must be specified'); |
205
|
|
|
|
|
|
|
} |
206
|
|
|
|
|
|
|
|
207
|
1
|
50
|
|
|
|
5
|
if ( not defined $service ) { |
208
|
0
|
|
|
|
|
0
|
$service = $conf{service} = 'DB'; |
209
|
|
|
|
|
|
|
} |
210
|
|
|
|
|
|
|
|
211
|
1
|
50
|
33
|
|
|
11
|
if ( defined $service and not exists $hafas_instance{$service} ) { |
212
|
0
|
|
|
|
|
0
|
confess("The service '$service' is not supported"); |
213
|
|
|
|
|
|
|
} |
214
|
|
|
|
|
|
|
|
215
|
1
|
|
|
|
|
9
|
my $now = DateTime->now( time_zone => 'Europe/Berlin' ); |
216
|
|
|
|
|
|
|
my $self = { |
217
|
|
|
|
|
|
|
active_service => $service, |
218
|
|
|
|
|
|
|
arrivals => $conf{arrivals}, |
219
|
|
|
|
|
|
|
cache => $conf{cache}, |
220
|
|
|
|
|
|
|
developer_mode => $conf{developer_mode}, |
221
|
|
|
|
|
|
|
exclusive_mots => $conf{exclusive_mots}, |
222
|
|
|
|
|
|
|
excluded_mots => $conf{excluded_mots}, |
223
|
|
|
|
|
|
|
messages => [], |
224
|
|
|
|
|
|
|
results => [], |
225
|
|
|
|
|
|
|
station => $conf{station}, |
226
|
1
|
|
|
|
|
15959
|
ua => $ua, |
227
|
|
|
|
|
|
|
now => $now, |
228
|
|
|
|
|
|
|
}; |
229
|
|
|
|
|
|
|
|
230
|
1
|
|
|
|
|
6
|
bless( $self, $obj ); |
231
|
|
|
|
|
|
|
|
232
|
1
|
|
|
|
|
2
|
my $req; |
233
|
|
|
|
|
|
|
|
234
|
1
|
50
|
|
|
|
10
|
if ( $conf{journey} ) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
235
|
|
|
|
|
|
|
$req = { |
236
|
|
|
|
|
|
|
svcReqL => [ |
237
|
|
|
|
|
|
|
{ |
238
|
|
|
|
|
|
|
meth => 'JourneyDetails', |
239
|
|
|
|
|
|
|
req => { |
240
|
|
|
|
|
|
|
jid => $conf{journey}{id}, |
241
|
|
|
|
|
|
|
name => $conf{journey}{name} // '0', |
242
|
|
|
|
|
|
|
getPolyline => $conf{with_polyline} ? \1 : \0, |
243
|
|
|
|
|
|
|
}, |
244
|
|
|
|
|
|
|
} |
245
|
|
|
|
|
|
|
], |
246
|
0
|
0
|
0
|
|
|
0
|
%{ $hafas_instance{$service}{request} } |
|
0
|
|
|
|
|
0
|
|
247
|
|
|
|
|
|
|
}; |
248
|
|
|
|
|
|
|
} |
249
|
|
|
|
|
|
|
elsif ( $conf{geoSearch} ) { |
250
|
|
|
|
|
|
|
$req = { |
251
|
|
|
|
|
|
|
svcReqL => [ |
252
|
|
|
|
|
|
|
{ |
253
|
|
|
|
|
|
|
cfg => { polyEnc => 'GPA' }, |
254
|
|
|
|
|
|
|
meth => 'LocGeoPos', |
255
|
|
|
|
|
|
|
req => { |
256
|
|
|
|
|
|
|
ring => { |
257
|
|
|
|
|
|
|
cCrd => { |
258
|
|
|
|
|
|
|
x => int( $conf{geoSearch}{lon} * 1e6 ), |
259
|
|
|
|
|
|
|
y => int( $conf{geoSearch}{lat} * 1e6 ), |
260
|
|
|
|
|
|
|
}, |
261
|
|
|
|
|
|
|
maxDist => -1, |
262
|
|
|
|
|
|
|
minDist => 0, |
263
|
|
|
|
|
|
|
}, |
264
|
|
|
|
|
|
|
locFltrL => [ |
265
|
|
|
|
|
|
|
{ |
266
|
|
|
|
|
|
|
type => "PROD", |
267
|
|
|
|
|
|
|
mode => "INC", |
268
|
|
|
|
|
|
|
value => $self->mot_mask |
269
|
|
|
|
|
|
|
} |
270
|
|
|
|
|
|
|
], |
271
|
|
|
|
|
|
|
getPOIs => \0, |
272
|
|
|
|
|
|
|
getStops => \1, |
273
|
|
|
|
|
|
|
maxLoc => $conf{results} // 30, |
274
|
|
|
|
|
|
|
} |
275
|
|
|
|
|
|
|
} |
276
|
|
|
|
|
|
|
], |
277
|
0
|
|
0
|
|
|
0
|
%{ $hafas_instance{$service}{request} } |
|
0
|
|
|
|
|
0
|
|
278
|
|
|
|
|
|
|
}; |
279
|
|
|
|
|
|
|
} |
280
|
|
|
|
|
|
|
elsif ( $conf{locationSearch} ) { |
281
|
|
|
|
|
|
|
$req = { |
282
|
|
|
|
|
|
|
svcReqL => [ |
283
|
|
|
|
|
|
|
{ |
284
|
|
|
|
|
|
|
cfg => { polyEnc => 'GPA' }, |
285
|
|
|
|
|
|
|
meth => 'LocMatch', |
286
|
|
|
|
|
|
|
req => { |
287
|
|
|
|
|
|
|
input => { |
288
|
|
|
|
|
|
|
loc => { |
289
|
|
|
|
|
|
|
type => 'S', |
290
|
|
|
|
|
|
|
name => $conf{locationSearch}, |
291
|
|
|
|
|
|
|
}, |
292
|
|
|
|
|
|
|
maxLoc => $conf{results} // 30, |
293
|
|
|
|
|
|
|
field => 'S', |
294
|
|
|
|
|
|
|
}, |
295
|
|
|
|
|
|
|
} |
296
|
|
|
|
|
|
|
} |
297
|
|
|
|
|
|
|
], |
298
|
0
|
|
0
|
|
|
0
|
%{ $hafas_instance{$service}{request} } |
|
0
|
|
|
|
|
0
|
|
299
|
|
|
|
|
|
|
}; |
300
|
|
|
|
|
|
|
} |
301
|
|
|
|
|
|
|
else { |
302
|
1
|
|
33
|
|
|
23
|
my $date = ( $conf{datetime} // $now )->strftime('%Y%m%d'); |
303
|
1
|
|
33
|
|
|
111
|
my $time = ( $conf{datetime} // $now )->strftime('%H%M%S'); |
304
|
|
|
|
|
|
|
|
305
|
1
|
|
|
|
|
93
|
my $lid; |
306
|
1
|
50
|
|
|
|
11
|
if ( $self->{station} =~ m{ ^ [0-9]+ $ }x ) { |
307
|
0
|
|
|
|
|
0
|
$lid = 'A=1@L=' . $self->{station} . '@'; |
308
|
|
|
|
|
|
|
} |
309
|
|
|
|
|
|
|
else { |
310
|
1
|
|
|
|
|
6
|
$lid = 'A=1@O=' . $self->{station} . '@'; |
311
|
|
|
|
|
|
|
} |
312
|
|
|
|
|
|
|
|
313
|
1
|
|
50
|
|
|
9
|
my $maxjny = $conf{results} // 30; |
314
|
1
|
|
50
|
|
|
6
|
my $duration = $conf{lookahead} // -1; |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
$req = { |
317
|
|
|
|
|
|
|
svcReqL => [ |
318
|
|
|
|
|
|
|
{ |
319
|
|
|
|
|
|
|
meth => 'StationBoard', |
320
|
|
|
|
|
|
|
req => { |
321
|
|
|
|
|
|
|
type => ( $conf{arrivals} ? 'ARR' : 'DEP' ), |
322
|
|
|
|
|
|
|
stbLoc => { lid => $lid }, |
323
|
|
|
|
|
|
|
dirLoc => undef, |
324
|
|
|
|
|
|
|
maxJny => $maxjny, |
325
|
|
|
|
|
|
|
date => $date, |
326
|
|
|
|
|
|
|
time => $time, |
327
|
|
|
|
|
|
|
dur => $duration, |
328
|
|
|
|
|
|
|
jnyFltrL => [ |
329
|
|
|
|
|
|
|
{ |
330
|
|
|
|
|
|
|
type => "PROD", |
331
|
|
|
|
|
|
|
mode => "INC", |
332
|
|
|
|
|
|
|
value => $self->mot_mask |
333
|
|
|
|
|
|
|
} |
334
|
|
|
|
|
|
|
] |
335
|
|
|
|
|
|
|
}, |
336
|
|
|
|
|
|
|
}, |
337
|
|
|
|
|
|
|
], |
338
|
1
|
50
|
|
|
|
9
|
%{ $hafas_instance{$service}{request} } |
|
1
|
|
|
|
|
7
|
|
339
|
|
|
|
|
|
|
}; |
340
|
|
|
|
|
|
|
} |
341
|
|
|
|
|
|
|
|
342
|
1
|
|
33
|
|
|
18
|
$self->{strptime_obj} //= DateTime::Format::Strptime->new( |
343
|
|
|
|
|
|
|
pattern => '%Y%m%dT%H%M%S', |
344
|
|
|
|
|
|
|
time_zone => 'Europe/Berlin', |
345
|
|
|
|
|
|
|
); |
346
|
|
|
|
|
|
|
|
347
|
1
|
|
|
|
|
2419
|
my $json = $self->{json} = JSON->new->utf8; |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
# The JSON request is the cache key, so if we have a cache we must ensure |
350
|
|
|
|
|
|
|
# that JSON serialization is deterministic. |
351
|
1
|
50
|
|
|
|
4
|
if ( $self->{cache} ) { |
352
|
0
|
|
|
|
|
0
|
$json->canonical; |
353
|
|
|
|
|
|
|
} |
354
|
|
|
|
|
|
|
|
355
|
1
|
|
|
|
|
29
|
$req = $json->encode($req); |
356
|
1
|
|
|
|
|
10
|
$self->{post} = $req; |
357
|
|
|
|
|
|
|
|
358
|
1
|
|
33
|
|
|
7
|
my $url = $conf{url} // $hafas_instance{$service}{mgate}; |
359
|
|
|
|
|
|
|
|
360
|
1
|
50
|
|
|
|
7
|
if ( my $salt = $hafas_instance{$service}{salt} ) { |
361
|
1
|
50
|
|
|
|
3
|
if ( $hafas_instance{$service}{micmac} ) { |
362
|
0
|
|
|
|
|
0
|
my $mic = md5_hex( $self->{post} ); |
363
|
0
|
|
|
|
|
0
|
my $mac = md5_hex( $mic . $salt ); |
364
|
0
|
|
|
|
|
0
|
$url .= "?mic=$mic&mac=$mac"; |
365
|
|
|
|
|
|
|
} |
366
|
|
|
|
|
|
|
else { |
367
|
1
|
|
|
|
|
11
|
$url .= '?checksum=' . md5_hex( $self->{post} . $salt ); |
368
|
|
|
|
|
|
|
} |
369
|
|
|
|
|
|
|
} |
370
|
|
|
|
|
|
|
|
371
|
1
|
50
|
|
|
|
5
|
if ( $conf{async} ) { |
372
|
0
|
|
|
|
|
0
|
$self->{url} = $url; |
373
|
0
|
|
|
|
|
0
|
return $self; |
374
|
|
|
|
|
|
|
} |
375
|
|
|
|
|
|
|
|
376
|
1
|
50
|
|
|
|
4
|
if ( $conf{json} ) { |
377
|
1
|
|
|
|
|
3
|
$self->{raw_json} = $conf{json}; |
378
|
|
|
|
|
|
|
} |
379
|
|
|
|
|
|
|
else { |
380
|
0
|
0
|
|
|
|
0
|
if ( $self->{developer_mode} ) { |
381
|
0
|
|
|
|
|
0
|
say "requesting $req from $url"; |
382
|
|
|
|
|
|
|
} |
383
|
|
|
|
|
|
|
|
384
|
0
|
|
|
|
|
0
|
my ( $content, $error ) = $self->post_with_cache($url); |
385
|
|
|
|
|
|
|
|
386
|
0
|
0
|
|
|
|
0
|
if ($error) { |
387
|
0
|
|
|
|
|
0
|
$self->{errstr} = $error; |
388
|
0
|
|
|
|
|
0
|
return $self; |
389
|
|
|
|
|
|
|
} |
390
|
|
|
|
|
|
|
|
391
|
0
|
0
|
|
|
|
0
|
if ( $self->{developer_mode} ) { |
392
|
0
|
|
|
|
|
0
|
say decode( 'utf-8', $content ); |
393
|
|
|
|
|
|
|
} |
394
|
|
|
|
|
|
|
|
395
|
0
|
|
|
|
|
0
|
$self->{raw_json} = $json->decode($content); |
396
|
|
|
|
|
|
|
} |
397
|
|
|
|
|
|
|
|
398
|
1
|
|
|
|
|
4
|
$self->check_mgate; |
399
|
|
|
|
|
|
|
|
400
|
1
|
50
|
33
|
|
|
8
|
if ( $conf{journey} ) { |
|
|
50
|
|
|
|
|
|
401
|
0
|
|
|
|
|
0
|
$self->parse_journey; |
402
|
|
|
|
|
|
|
} |
403
|
|
|
|
|
|
|
elsif ( $conf{geoSearch} or $conf{locationSearch} ) { |
404
|
0
|
|
|
|
|
0
|
$self->parse_search; |
405
|
|
|
|
|
|
|
} |
406
|
|
|
|
|
|
|
else { |
407
|
1
|
|
|
|
|
4
|
$self->parse_board; |
408
|
|
|
|
|
|
|
} |
409
|
|
|
|
|
|
|
|
410
|
1
|
|
|
|
|
10
|
return $self; |
411
|
|
|
|
|
|
|
} |
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
sub new_p { |
414
|
0
|
|
|
0
|
1
|
0
|
my ( $obj, %conf ) = @_; |
415
|
0
|
|
|
|
|
0
|
my $promise = $conf{promise}->new; |
416
|
|
|
|
|
|
|
|
417
|
0
|
0
|
0
|
|
|
0
|
if ( |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
418
|
|
|
|
|
|
|
not( $conf{station} |
419
|
|
|
|
|
|
|
or $conf{journey} |
420
|
|
|
|
|
|
|
or $conf{geoSearch} |
421
|
|
|
|
|
|
|
or $conf{locationSearch} ) |
422
|
|
|
|
|
|
|
) |
423
|
|
|
|
|
|
|
{ |
424
|
0
|
|
|
|
|
0
|
return $promise->reject('station or journey flag must be passed'); |
425
|
|
|
|
|
|
|
} |
426
|
|
|
|
|
|
|
|
427
|
0
|
|
|
|
|
0
|
my $self = $obj->new( %conf, async => 1 ); |
428
|
0
|
|
|
|
|
0
|
$self->{promise} = $conf{promise}; |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
$self->post_with_cache_p( $self->{url} )->then( |
431
|
|
|
|
|
|
|
sub { |
432
|
0
|
|
|
0
|
|
0
|
my ($content) = @_; |
433
|
0
|
|
|
|
|
0
|
$self->{raw_json} = $self->{json}->decode($content); |
434
|
0
|
|
|
|
|
0
|
$self->check_mgate; |
435
|
0
|
0
|
0
|
|
|
0
|
if ( $conf{journey} ) { |
|
|
0
|
|
|
|
|
|
436
|
0
|
|
|
|
|
0
|
$self->parse_journey; |
437
|
|
|
|
|
|
|
} |
438
|
|
|
|
|
|
|
elsif ( $conf{geoSearch} or $conf{locationSearch} ) { |
439
|
0
|
|
|
|
|
0
|
$self->parse_search; |
440
|
|
|
|
|
|
|
} |
441
|
|
|
|
|
|
|
else { |
442
|
0
|
|
|
|
|
0
|
$self->parse_board; |
443
|
|
|
|
|
|
|
} |
444
|
0
|
0
|
|
|
|
0
|
if ( $self->errstr ) { |
445
|
0
|
|
|
|
|
0
|
$promise->reject( $self->errstr, $self ); |
446
|
|
|
|
|
|
|
} |
447
|
|
|
|
|
|
|
else { |
448
|
0
|
|
|
|
|
0
|
$promise->resolve($self); |
449
|
|
|
|
|
|
|
} |
450
|
0
|
|
|
|
|
0
|
return; |
451
|
|
|
|
|
|
|
} |
452
|
|
|
|
|
|
|
)->catch( |
453
|
|
|
|
|
|
|
sub { |
454
|
0
|
|
|
0
|
|
0
|
my ($err) = @_; |
455
|
0
|
|
|
|
|
0
|
$promise->reject($err); |
456
|
0
|
|
|
|
|
0
|
return; |
457
|
|
|
|
|
|
|
} |
458
|
0
|
|
|
|
|
0
|
)->wait; |
459
|
|
|
|
|
|
|
|
460
|
0
|
|
|
|
|
0
|
return $promise; |
461
|
|
|
|
|
|
|
} |
462
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
# }}} |
464
|
|
|
|
|
|
|
# {{{ Internal Helpers |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
sub mot_mask { |
467
|
1
|
|
|
1
|
0
|
4
|
my ($self) = @_; |
468
|
|
|
|
|
|
|
|
469
|
1
|
|
|
|
|
4
|
my $service = $self->{active_service}; |
470
|
1
|
|
|
|
|
2
|
my $mot_mask = 2**@{ $hafas_instance{$service}{productbits} } - 1; |
|
1
|
|
|
|
|
7
|
|
471
|
|
|
|
|
|
|
|
472
|
1
|
|
|
|
|
3
|
my %mot_pos; |
473
|
1
|
|
|
|
|
3
|
for my $i ( 0 .. $#{ $hafas_instance{$service}{productbits} } ) { |
|
1
|
|
|
|
|
8
|
|
474
|
10
|
|
|
|
|
31
|
$mot_pos{ $hafas_instance{$service}{productbits}[$i] } = $i; |
475
|
|
|
|
|
|
|
} |
476
|
|
|
|
|
|
|
|
477
|
1
|
50
|
50
|
|
|
5
|
if ( my @mots = @{ $self->{exclusive_mots} // [] } ) { |
|
1
|
|
|
|
|
7
|
|
478
|
0
|
|
|
|
|
0
|
$mot_mask = 0; |
479
|
0
|
|
|
|
|
0
|
for my $mot (@mots) { |
480
|
0
|
|
|
|
|
0
|
$mot_mask |= 1 << $mot_pos{$mot}; |
481
|
|
|
|
|
|
|
} |
482
|
|
|
|
|
|
|
} |
483
|
|
|
|
|
|
|
|
484
|
1
|
50
|
50
|
|
|
3
|
if ( my @mots = @{ $self->{excluded_mots} // [] } ) { |
|
1
|
|
|
|
|
7
|
|
485
|
0
|
|
|
|
|
0
|
for my $mot (@mots) { |
486
|
0
|
|
|
|
|
0
|
$mot_mask &= ~( 1 << $mot_pos{$mot} ); |
487
|
|
|
|
|
|
|
} |
488
|
|
|
|
|
|
|
} |
489
|
|
|
|
|
|
|
|
490
|
1
|
|
|
|
|
18
|
return $mot_mask; |
491
|
|
|
|
|
|
|
} |
492
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
sub post_with_cache { |
494
|
0
|
|
|
0
|
0
|
0
|
my ( $self, $url ) = @_; |
495
|
0
|
|
|
|
|
0
|
my $cache = $self->{cache}; |
496
|
|
|
|
|
|
|
|
497
|
0
|
0
|
|
|
|
0
|
if ( $self->{developer_mode} ) { |
498
|
0
|
|
|
|
|
0
|
say "POST $url"; |
499
|
|
|
|
|
|
|
} |
500
|
|
|
|
|
|
|
|
501
|
0
|
0
|
|
|
|
0
|
if ($cache) { |
502
|
0
|
|
|
|
|
0
|
my $content = $cache->thaw( $self->{post} ); |
503
|
0
|
0
|
|
|
|
0
|
if ($content) { |
504
|
0
|
0
|
|
|
|
0
|
if ( $self->{developer_mode} ) { |
505
|
0
|
|
|
|
|
0
|
say ' cache hit'; |
506
|
|
|
|
|
|
|
} |
507
|
0
|
|
|
|
|
0
|
return ( ${$content}, undef ); |
|
0
|
|
|
|
|
0
|
|
508
|
|
|
|
|
|
|
} |
509
|
|
|
|
|
|
|
} |
510
|
|
|
|
|
|
|
|
511
|
0
|
0
|
|
|
|
0
|
if ( $self->{developer_mode} ) { |
512
|
0
|
|
|
|
|
0
|
say ' cache miss'; |
513
|
|
|
|
|
|
|
} |
514
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
my $reply = $self->{ua}->post( |
516
|
|
|
|
|
|
|
$url, |
517
|
|
|
|
|
|
|
'Content-Type' => 'application/json', |
518
|
|
|
|
|
|
|
Content => $self->{post} |
519
|
0
|
|
|
|
|
0
|
); |
520
|
|
|
|
|
|
|
|
521
|
0
|
0
|
|
|
|
0
|
if ( $reply->is_error ) { |
522
|
0
|
|
|
|
|
0
|
return ( undef, $reply->status_line ); |
523
|
|
|
|
|
|
|
} |
524
|
0
|
|
|
|
|
0
|
my $content = $reply->content; |
525
|
|
|
|
|
|
|
|
526
|
0
|
0
|
|
|
|
0
|
if ($cache) { |
527
|
0
|
|
|
|
|
0
|
say "freeeez"; |
528
|
0
|
|
|
|
|
0
|
$cache->freeze( $self->{post}, \$content ); |
529
|
|
|
|
|
|
|
} |
530
|
|
|
|
|
|
|
|
531
|
0
|
|
|
|
|
0
|
return ( $content, undef ); |
532
|
|
|
|
|
|
|
} |
533
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
sub post_with_cache_p { |
535
|
0
|
|
|
0
|
0
|
0
|
my ( $self, $url ) = @_; |
536
|
0
|
|
|
|
|
0
|
my $cache = $self->{cache}; |
537
|
|
|
|
|
|
|
|
538
|
0
|
0
|
|
|
|
0
|
if ( $self->{developer_mode} ) { |
539
|
0
|
|
|
|
|
0
|
say "POST $url"; |
540
|
|
|
|
|
|
|
} |
541
|
|
|
|
|
|
|
|
542
|
0
|
|
|
|
|
0
|
my $promise = $self->{promise}->new; |
543
|
|
|
|
|
|
|
|
544
|
0
|
0
|
|
|
|
0
|
if ($cache) { |
545
|
0
|
|
|
|
|
0
|
my $content = $cache->thaw( $self->{post} ); |
546
|
0
|
0
|
|
|
|
0
|
if ($content) { |
547
|
0
|
0
|
|
|
|
0
|
if ( $self->{developer_mode} ) { |
548
|
0
|
|
|
|
|
0
|
say ' cache hit'; |
549
|
|
|
|
|
|
|
} |
550
|
0
|
|
|
|
|
0
|
return $promise->resolve( ${$content} ); |
|
0
|
|
|
|
|
0
|
|
551
|
|
|
|
|
|
|
} |
552
|
|
|
|
|
|
|
} |
553
|
|
|
|
|
|
|
|
554
|
0
|
0
|
|
|
|
0
|
if ( $self->{developer_mode} ) { |
555
|
0
|
|
|
|
|
0
|
say ' cache miss'; |
556
|
|
|
|
|
|
|
} |
557
|
|
|
|
|
|
|
|
558
|
|
|
|
|
|
|
$self->{ua}->post_p( $url, $self->{post} )->then( |
559
|
|
|
|
|
|
|
sub { |
560
|
0
|
|
|
0
|
|
0
|
my ($tx) = @_; |
561
|
0
|
0
|
|
|
|
0
|
if ( my $err = $tx->error ) { |
562
|
0
|
|
|
|
|
0
|
$promise->reject( |
563
|
|
|
|
|
|
|
"POST $url returned HTTP $err->{code} $err->{message}"); |
564
|
0
|
|
|
|
|
0
|
return; |
565
|
|
|
|
|
|
|
} |
566
|
0
|
|
|
|
|
0
|
my $content = $tx->res->body; |
567
|
0
|
0
|
|
|
|
0
|
if ($cache) { |
568
|
0
|
|
|
|
|
0
|
$cache->freeze( $self->{post}, \$content ); |
569
|
|
|
|
|
|
|
} |
570
|
0
|
|
|
|
|
0
|
$promise->resolve($content); |
571
|
0
|
|
|
|
|
0
|
return; |
572
|
|
|
|
|
|
|
} |
573
|
|
|
|
|
|
|
)->catch( |
574
|
|
|
|
|
|
|
sub { |
575
|
0
|
|
|
0
|
|
0
|
my ($err) = @_; |
576
|
0
|
|
|
|
|
0
|
$promise->reject($err); |
577
|
0
|
|
|
|
|
0
|
return; |
578
|
|
|
|
|
|
|
} |
579
|
0
|
|
|
|
|
0
|
)->wait; |
580
|
|
|
|
|
|
|
|
581
|
0
|
|
|
|
|
0
|
return $promise; |
582
|
|
|
|
|
|
|
} |
583
|
|
|
|
|
|
|
|
584
|
|
|
|
|
|
|
sub check_mgate { |
585
|
1
|
|
|
1
|
0
|
4
|
my ($self) = @_; |
586
|
|
|
|
|
|
|
|
587
|
1
|
50
|
33
|
|
|
12
|
if ( $self->{raw_json}{err} and $self->{raw_json}{err} ne 'OK' ) { |
|
|
50
|
33
|
|
|
|
|
|
|
50
|
33
|
|
|
|
|
|
|
50
|
|
|
|
|
|
588
|
|
|
|
|
|
|
$self->{errstr} = $self->{raw_json}{errTxt} |
589
|
0
|
|
0
|
|
|
0
|
// 'error code is ' . $self->{raw_json}{err}; |
590
|
0
|
|
|
|
|
0
|
$self->{errcode} = $self->{raw_json}{err}; |
591
|
|
|
|
|
|
|
} |
592
|
|
|
|
|
|
|
elsif ( defined $self->{raw_json}{cInfo}{code} |
593
|
|
|
|
|
|
|
and $self->{raw_json}{cInfo}{code} ne 'OK' |
594
|
|
|
|
|
|
|
and $self->{raw_json}{cInfo}{code} ne 'VH' ) |
595
|
|
|
|
|
|
|
{ |
596
|
0
|
|
|
|
|
0
|
$self->{errstr} = 'cInfo code is ' . $self->{raw_json}{cInfo}{code}; |
597
|
0
|
|
|
|
|
0
|
$self->{errcode} = $self->{raw_json}{cInfo}{code}; |
598
|
|
|
|
|
|
|
} |
599
|
1
|
|
50
|
|
|
8
|
elsif ( @{ $self->{raw_json}{svcResL} // [] } == 0 ) { |
600
|
0
|
|
|
|
|
0
|
$self->{errstr} = 'svcResL is empty'; |
601
|
|
|
|
|
|
|
} |
602
|
|
|
|
|
|
|
elsif ( $self->{raw_json}{svcResL}[0]{err} ne 'OK' ) { |
603
|
|
|
|
|
|
|
$self->{errstr} |
604
|
0
|
|
|
|
|
0
|
= 'svcResL[0].err is ' . $self->{raw_json}{svcResL}[0]{err}; |
605
|
0
|
|
|
|
|
0
|
$self->{errcode} = $self->{raw_json}{svcResL}[0]{err}; |
606
|
|
|
|
|
|
|
} |
607
|
|
|
|
|
|
|
|
608
|
1
|
|
|
|
|
3
|
return $self; |
609
|
|
|
|
|
|
|
} |
610
|
|
|
|
|
|
|
|
611
|
|
|
|
|
|
|
sub add_message { |
612
|
1
|
|
|
1
|
0
|
5
|
my ( $self, $json, $is_him ) = @_; |
613
|
|
|
|
|
|
|
|
614
|
1
|
|
|
|
|
4
|
my $short = $json->{txtS}; |
615
|
1
|
|
|
|
|
2
|
my $text = $json->{txtN}; |
616
|
1
|
|
|
|
|
3
|
my $code = $json->{code}; |
617
|
1
|
|
|
|
|
3
|
my $prio = $json->{prio}; |
618
|
|
|
|
|
|
|
|
619
|
1
|
50
|
|
|
|
4
|
if ($is_him) { |
620
|
0
|
|
|
|
|
0
|
$short = $json->{head}; |
621
|
0
|
|
|
|
|
0
|
$text = $json->{text}; |
622
|
0
|
|
|
|
|
0
|
$code = $json->{hid}; |
623
|
|
|
|
|
|
|
} |
624
|
|
|
|
|
|
|
|
625
|
|
|
|
|
|
|
# Some backends use remL for operator information. We don't want that. |
626
|
1
|
50
|
|
|
|
6
|
if ( $code eq 'OPERATOR' ) { |
627
|
0
|
|
|
|
|
0
|
return; |
628
|
|
|
|
|
|
|
} |
629
|
|
|
|
|
|
|
|
630
|
1
|
|
|
|
|
2
|
for my $message ( @{ $self->{messages} } ) { |
|
1
|
|
|
|
|
6
|
|
631
|
0
|
0
|
0
|
|
|
0
|
if ( $code eq $message->{code} and $text eq $message->{text} ) { |
632
|
0
|
|
|
|
|
0
|
$message->{ref_count}++; |
633
|
0
|
|
|
|
|
0
|
return $message; |
634
|
|
|
|
|
|
|
} |
635
|
|
|
|
|
|
|
} |
636
|
|
|
|
|
|
|
|
637
|
1
|
|
|
|
|
15
|
my $message = Travel::Status::DE::HAFAS::Message->new( |
638
|
|
|
|
|
|
|
short => $short, |
639
|
|
|
|
|
|
|
text => $text, |
640
|
|
|
|
|
|
|
code => $code, |
641
|
|
|
|
|
|
|
prio => $prio, |
642
|
|
|
|
|
|
|
is_him => $is_him, |
643
|
|
|
|
|
|
|
ref_count => 1, |
644
|
|
|
|
|
|
|
); |
645
|
1
|
|
|
|
|
2
|
push( @{ $self->{messages} }, $message ); |
|
1
|
|
|
|
|
5
|
|
646
|
1
|
|
|
|
|
4
|
return $message; |
647
|
|
|
|
|
|
|
} |
648
|
|
|
|
|
|
|
|
649
|
|
|
|
|
|
|
sub parse_search { |
650
|
0
|
|
|
0
|
0
|
0
|
my ($self) = @_; |
651
|
|
|
|
|
|
|
|
652
|
0
|
|
|
|
|
0
|
$self->{results} = []; |
653
|
|
|
|
|
|
|
|
654
|
0
|
0
|
|
|
|
0
|
if ( $self->{errstr} ) { |
655
|
0
|
|
|
|
|
0
|
return $self; |
656
|
|
|
|
|
|
|
} |
657
|
|
|
|
|
|
|
|
658
|
0
|
|
0
|
|
|
0
|
my @refLocL = @{ $self->{raw_json}{svcResL}[0]{res}{common}{locL} // [] }; |
|
0
|
|
|
|
|
0
|
|
659
|
0
|
|
0
|
|
|
0
|
my @locL = @{ $self->{raw_json}{svcResL}[0]{res}{locL} // [] }; |
|
0
|
|
|
|
|
0
|
|
660
|
|
|
|
|
|
|
|
661
|
0
|
0
|
|
|
|
0
|
if ( $self->{raw_json}{svcResL}[0]{res}{match} ) { |
662
|
0
|
|
0
|
|
|
0
|
@locL = @{ $self->{raw_json}{svcResL}[0]{res}{match}{locL} // [] }; |
|
0
|
|
|
|
|
0
|
|
663
|
|
|
|
|
|
|
} |
664
|
|
|
|
|
|
|
|
665
|
0
|
|
|
|
|
0
|
for my $loc (@locL) { |
666
|
|
|
|
|
|
|
push( |
667
|
0
|
|
|
|
|
0
|
@{ $self->{results} }, |
|
0
|
|
|
|
|
0
|
|
668
|
|
|
|
|
|
|
Travel::Status::DE::HAFAS::Stop->new( loc => $loc ) |
669
|
|
|
|
|
|
|
); |
670
|
|
|
|
|
|
|
} |
671
|
|
|
|
|
|
|
|
672
|
0
|
|
|
|
|
0
|
return $self; |
673
|
|
|
|
|
|
|
} |
674
|
|
|
|
|
|
|
|
675
|
|
|
|
|
|
|
sub parse_journey { |
676
|
0
|
|
|
0
|
0
|
0
|
my ($self) = @_; |
677
|
|
|
|
|
|
|
|
678
|
0
|
0
|
|
|
|
0
|
if ( $self->{errstr} ) { |
679
|
0
|
|
|
|
|
0
|
return $self; |
680
|
|
|
|
|
|
|
} |
681
|
|
|
|
|
|
|
|
682
|
0
|
|
0
|
|
|
0
|
my @locL = @{ $self->{raw_json}{svcResL}[0]{res}{common}{locL} // [] }; |
|
0
|
|
|
|
|
0
|
|
683
|
0
|
|
|
|
|
0
|
my $journey = $self->{raw_json}{svcResL}[0]{res}{journey}; |
684
|
0
|
|
|
|
|
0
|
my @polyline; |
685
|
|
|
|
|
|
|
|
686
|
0
|
0
|
|
|
|
0
|
if ( $journey->{poly} ) { |
687
|
0
|
|
|
|
|
0
|
@polyline = decode_polyline( $journey->{poly}{crdEncYX} ); |
688
|
0
|
|
0
|
|
|
0
|
for my $ref ( @{ $journey->{poly}{ppLocRefL} // [] } ) { |
|
0
|
|
|
|
|
0
|
|
689
|
0
|
|
|
|
|
0
|
my $poly = $polyline[ $ref->{ppIdx} ]; |
690
|
0
|
|
|
|
|
0
|
my $loc = $locL[ $ref->{locX} ]; |
691
|
|
|
|
|
|
|
|
692
|
0
|
|
|
|
|
0
|
$poly->{name} = $loc->{name}; |
693
|
0
|
|
|
|
|
0
|
$poly->{eva} = $loc->{extId} + 0; |
694
|
|
|
|
|
|
|
} |
695
|
|
|
|
|
|
|
} |
696
|
|
|
|
|
|
|
|
697
|
|
|
|
|
|
|
$self->{result} = Travel::Status::DE::HAFAS::Journey->new( |
698
|
|
|
|
|
|
|
common => $self->{raw_json}{svcResL}[0]{res}{common}, |
699
|
0
|
|
|
|
|
0
|
journey => $journey, |
700
|
|
|
|
|
|
|
polyline => \@polyline, |
701
|
|
|
|
|
|
|
hafas => $self, |
702
|
|
|
|
|
|
|
); |
703
|
|
|
|
|
|
|
|
704
|
0
|
|
|
|
|
0
|
return $self; |
705
|
|
|
|
|
|
|
} |
706
|
|
|
|
|
|
|
|
707
|
|
|
|
|
|
|
sub parse_board { |
708
|
1
|
|
|
1
|
0
|
4
|
my ($self) = @_; |
709
|
|
|
|
|
|
|
|
710
|
1
|
|
|
|
|
4
|
$self->{results} = []; |
711
|
|
|
|
|
|
|
|
712
|
1
|
50
|
|
|
|
3
|
if ( $self->{errstr} ) { |
713
|
0
|
|
|
|
|
0
|
return $self; |
714
|
|
|
|
|
|
|
} |
715
|
|
|
|
|
|
|
|
716
|
1
|
|
50
|
|
|
3
|
my @jnyL = @{ $self->{raw_json}{svcResL}[0]{res}{jnyL} // [] }; |
|
1
|
|
|
|
|
10
|
|
717
|
|
|
|
|
|
|
|
718
|
1
|
|
|
|
|
3
|
for my $result (@jnyL) { |
719
|
|
|
|
|
|
|
push( |
720
|
30
|
|
|
|
|
162
|
@{ $self->{results} }, |
721
|
|
|
|
|
|
|
Travel::Status::DE::HAFAS::Journey->new( |
722
|
|
|
|
|
|
|
common => $self->{raw_json}{svcResL}[0]{res}{common}, |
723
|
30
|
|
|
|
|
58
|
journey => $result, |
724
|
|
|
|
|
|
|
hafas => $self, |
725
|
|
|
|
|
|
|
) |
726
|
|
|
|
|
|
|
); |
727
|
|
|
|
|
|
|
} |
728
|
1
|
|
|
|
|
19
|
return $self; |
729
|
|
|
|
|
|
|
} |
730
|
|
|
|
|
|
|
|
731
|
|
|
|
|
|
|
# }}} |
732
|
|
|
|
|
|
|
# {{{ Public Functions |
733
|
|
|
|
|
|
|
|
734
|
|
|
|
|
|
|
sub errcode { |
735
|
1
|
|
|
1
|
1
|
8
|
my ($self) = @_; |
736
|
|
|
|
|
|
|
|
737
|
1
|
|
|
|
|
16
|
return $self->{errcode}; |
738
|
|
|
|
|
|
|
} |
739
|
|
|
|
|
|
|
|
740
|
|
|
|
|
|
|
sub errstr { |
741
|
1
|
|
|
1
|
1
|
5
|
my ($self) = @_; |
742
|
|
|
|
|
|
|
|
743
|
1
|
|
|
|
|
6
|
return $self->{errstr}; |
744
|
|
|
|
|
|
|
} |
745
|
|
|
|
|
|
|
|
746
|
|
|
|
|
|
|
sub similar_stops { |
747
|
0
|
|
|
0
|
1
|
0
|
my ($self) = @_; |
748
|
|
|
|
|
|
|
|
749
|
0
|
|
|
|
|
0
|
my $service = $self->{active_service}; |
750
|
|
|
|
|
|
|
|
751
|
0
|
0
|
0
|
|
|
0
|
if ( $service and exists $hafas_instance{$service}{stopfinder} ) { |
752
|
|
|
|
|
|
|
|
753
|
|
|
|
|
|
|
my $sf = Travel::Status::DE::HAFAS::StopFinder->new( |
754
|
|
|
|
|
|
|
url => $hafas_instance{$service}{stopfinder}, |
755
|
|
|
|
|
|
|
input => $self->{station}, |
756
|
|
|
|
|
|
|
ua => $self->{ua}, |
757
|
|
|
|
|
|
|
developer_mode => $self->{developer_mode}, |
758
|
0
|
|
|
|
|
0
|
); |
759
|
0
|
0
|
|
|
|
0
|
if ( my $err = $sf->errstr ) { |
760
|
0
|
|
|
|
|
0
|
$self->{errstr} = $err; |
761
|
0
|
|
|
|
|
0
|
return; |
762
|
|
|
|
|
|
|
} |
763
|
0
|
|
|
|
|
0
|
return $sf->results; |
764
|
|
|
|
|
|
|
} |
765
|
0
|
|
|
|
|
0
|
return; |
766
|
|
|
|
|
|
|
} |
767
|
|
|
|
|
|
|
|
768
|
|
|
|
|
|
|
sub similar_stops_p { |
769
|
0
|
|
|
0
|
1
|
0
|
my ( $self, %opt ) = @_; |
770
|
|
|
|
|
|
|
|
771
|
0
|
|
|
|
|
0
|
my $service = $self->{active_service}; |
772
|
|
|
|
|
|
|
|
773
|
0
|
0
|
0
|
|
|
0
|
if ( $service and exists $hafas_instance{$service}{stopfinder} ) { |
774
|
0
|
|
0
|
|
|
0
|
$opt{user_agent} //= $self->{ua}; |
775
|
0
|
|
0
|
|
|
0
|
$opt{promise} //= $self->{promise}; |
776
|
|
|
|
|
|
|
return Travel::Status::DE::HAFAS::StopFinder->new_p( |
777
|
|
|
|
|
|
|
url => $hafas_instance{$service}{stopfinder}, |
778
|
|
|
|
|
|
|
input => $self->{station}, |
779
|
|
|
|
|
|
|
user_agent => $opt{user_agent}, |
780
|
|
|
|
|
|
|
developer_mode => $self->{developer_mode}, |
781
|
|
|
|
|
|
|
promise => $opt{promise}, |
782
|
0
|
|
|
|
|
0
|
); |
783
|
|
|
|
|
|
|
} |
784
|
|
|
|
|
|
|
return $opt{promise} |
785
|
0
|
|
|
|
|
0
|
->reject("stopfinder not available for backend '$service'"); |
786
|
|
|
|
|
|
|
} |
787
|
|
|
|
|
|
|
|
788
|
|
|
|
|
|
|
sub station { |
789
|
0
|
|
|
0
|
1
|
0
|
my ($self) = @_; |
790
|
|
|
|
|
|
|
|
791
|
0
|
0
|
|
|
|
0
|
if ( $self->{station_info} ) { |
792
|
0
|
|
|
|
|
0
|
return $self->{station_info}; |
793
|
|
|
|
|
|
|
} |
794
|
|
|
|
|
|
|
|
795
|
0
|
|
0
|
|
|
0
|
my @locL = @{ $self->{raw_json}{svcResL}[0]{res}{common}{locL} // [] }; |
|
0
|
|
|
|
|
0
|
|
796
|
|
|
|
|
|
|
|
797
|
0
|
|
|
|
|
0
|
my %prefc_by_loc; |
798
|
|
|
|
|
|
|
|
799
|
0
|
|
|
|
|
0
|
for my $i ( 0 .. $#locL ) { |
800
|
0
|
|
|
|
|
0
|
my $loc = $locL[$i]; |
801
|
0
|
0
|
|
|
|
0
|
if ( $loc->{pRefL} ) { |
802
|
0
|
|
|
|
|
0
|
$prefc_by_loc{$i} = $#{ $loc->{pRefL} }; |
|
0
|
|
|
|
|
0
|
|
803
|
|
|
|
|
|
|
} |
804
|
|
|
|
|
|
|
} |
805
|
|
|
|
|
|
|
|
806
|
0
|
|
|
|
|
0
|
my @prefcounts = sort { $b->[0] <=> $a->[0] } |
807
|
0
|
|
|
|
|
0
|
map { [ $_, $prefc_by_loc{$_} ] } keys %prefc_by_loc; |
|
0
|
|
|
|
|
0
|
|
808
|
|
|
|
|
|
|
|
809
|
0
|
|
|
|
|
0
|
my $loc = $locL[ $prefcounts[0][0] ]; |
810
|
|
|
|
|
|
|
|
811
|
0
|
0
|
|
|
|
0
|
if ($loc) { |
812
|
|
|
|
|
|
|
$self->{station_info} = { |
813
|
|
|
|
|
|
|
name => $loc->{name}, |
814
|
|
|
|
|
|
|
eva => $loc->{extId}, |
815
|
0
|
|
|
|
|
0
|
names => [ map { $locL[ $_->[0] ]{name} } @prefcounts ], |
816
|
0
|
|
|
|
|
0
|
evas => [ map { $locL[ $_->[0] ]{extId} } @prefcounts ], |
|
0
|
|
|
|
|
0
|
|
817
|
|
|
|
|
|
|
}; |
818
|
|
|
|
|
|
|
} |
819
|
|
|
|
|
|
|
else { |
820
|
0
|
|
|
|
|
0
|
$self->{station_info} = {}; |
821
|
|
|
|
|
|
|
} |
822
|
|
|
|
|
|
|
|
823
|
0
|
|
|
|
|
0
|
return $self->{station_info}; |
824
|
|
|
|
|
|
|
} |
825
|
|
|
|
|
|
|
|
826
|
|
|
|
|
|
|
sub messages { |
827
|
0
|
|
|
0
|
1
|
0
|
my ($self) = @_; |
828
|
0
|
|
|
|
|
0
|
return @{ $self->{messages} }; |
|
0
|
|
|
|
|
0
|
|
829
|
|
|
|
|
|
|
} |
830
|
|
|
|
|
|
|
|
831
|
|
|
|
|
|
|
sub results { |
832
|
2
|
|
|
2
|
1
|
6
|
my ($self) = @_; |
833
|
2
|
|
|
|
|
5
|
return @{ $self->{results} }; |
|
2
|
|
|
|
|
18
|
|
834
|
|
|
|
|
|
|
} |
835
|
|
|
|
|
|
|
|
836
|
|
|
|
|
|
|
sub result { |
837
|
0
|
|
|
0
|
1
|
0
|
my ($self) = @_; |
838
|
0
|
|
|
|
|
0
|
return $self->{result}; |
839
|
|
|
|
|
|
|
} |
840
|
|
|
|
|
|
|
|
841
|
|
|
|
|
|
|
# static |
842
|
|
|
|
|
|
|
sub get_services { |
843
|
0
|
|
|
0
|
1
|
0
|
my @services; |
844
|
0
|
|
|
|
|
0
|
for my $service ( sort keys %hafas_instance ) { |
845
|
0
|
|
|
|
|
0
|
my %desc = %{ $hafas_instance{$service} }; |
|
0
|
|
|
|
|
0
|
|
846
|
0
|
|
|
|
|
0
|
$desc{shortname} = $service; |
847
|
0
|
|
|
|
|
0
|
push( @services, \%desc ); |
848
|
|
|
|
|
|
|
} |
849
|
0
|
|
|
|
|
0
|
return @services; |
850
|
|
|
|
|
|
|
} |
851
|
|
|
|
|
|
|
|
852
|
|
|
|
|
|
|
# static |
853
|
|
|
|
|
|
|
sub get_service { |
854
|
0
|
|
|
0
|
1
|
0
|
my ($service) = @_; |
855
|
|
|
|
|
|
|
|
856
|
0
|
0
|
0
|
|
|
0
|
if ( defined $service and exists $hafas_instance{$service} ) { |
857
|
0
|
|
|
|
|
0
|
return $hafas_instance{$service}; |
858
|
|
|
|
|
|
|
} |
859
|
0
|
|
|
|
|
0
|
return; |
860
|
|
|
|
|
|
|
} |
861
|
|
|
|
|
|
|
|
862
|
|
|
|
|
|
|
sub get_active_service { |
863
|
1
|
|
|
1
|
1
|
4
|
my ($self) = @_; |
864
|
|
|
|
|
|
|
|
865
|
1
|
50
|
|
|
|
6
|
if ( defined $self->{active_service} ) { |
866
|
1
|
|
|
|
|
7
|
return $hafas_instance{ $self->{active_service} }; |
867
|
|
|
|
|
|
|
} |
868
|
0
|
|
|
|
|
|
return; |
869
|
|
|
|
|
|
|
} |
870
|
|
|
|
|
|
|
|
871
|
|
|
|
|
|
|
# }}} |
872
|
|
|
|
|
|
|
|
873
|
|
|
|
|
|
|
1; |
874
|
|
|
|
|
|
|
|
875
|
|
|
|
|
|
|
__END__ |
876
|
|
|
|
|
|
|
|
877
|
|
|
|
|
|
|
=head1 NAME |
878
|
|
|
|
|
|
|
|
879
|
|
|
|
|
|
|
Travel::Status::DE::HAFAS - Interface to HAFAS-based online arrival/departure |
880
|
|
|
|
|
|
|
monitors |
881
|
|
|
|
|
|
|
|
882
|
|
|
|
|
|
|
=head1 SYNOPSIS |
883
|
|
|
|
|
|
|
|
884
|
|
|
|
|
|
|
use Travel::Status::DE::HAFAS; |
885
|
|
|
|
|
|
|
|
886
|
|
|
|
|
|
|
my $status = Travel::Status::DE::HAFAS->new( |
887
|
|
|
|
|
|
|
station => 'Essen Hbf', |
888
|
|
|
|
|
|
|
); |
889
|
|
|
|
|
|
|
|
890
|
|
|
|
|
|
|
if (my $err = $status->errstr) { |
891
|
|
|
|
|
|
|
die("Request error: ${err}\n"); |
892
|
|
|
|
|
|
|
} |
893
|
|
|
|
|
|
|
|
894
|
|
|
|
|
|
|
for my $departure ($status->results) { |
895
|
|
|
|
|
|
|
printf( |
896
|
|
|
|
|
|
|
"At %s: %s to %s from platform %s\n", |
897
|
|
|
|
|
|
|
$departure->time, |
898
|
|
|
|
|
|
|
$departure->line, |
899
|
|
|
|
|
|
|
$departure->destination, |
900
|
|
|
|
|
|
|
$departure->platform, |
901
|
|
|
|
|
|
|
); |
902
|
|
|
|
|
|
|
} |
903
|
|
|
|
|
|
|
|
904
|
|
|
|
|
|
|
=head1 VERSION |
905
|
|
|
|
|
|
|
|
906
|
|
|
|
|
|
|
version 4.16 |
907
|
|
|
|
|
|
|
|
908
|
|
|
|
|
|
|
=head1 DESCRIPTION |
909
|
|
|
|
|
|
|
|
910
|
|
|
|
|
|
|
Travel::Status::DE::HAFAS is an interface to HAFAS-based |
911
|
|
|
|
|
|
|
arrival/departure monitors using the mgate.exe interface. |
912
|
|
|
|
|
|
|
|
913
|
|
|
|
|
|
|
It can report departures/arrivals at a specific station, search for stations, |
914
|
|
|
|
|
|
|
or provide details about a specific journey. It supports non-blocking operation |
915
|
|
|
|
|
|
|
via promises. |
916
|
|
|
|
|
|
|
|
917
|
|
|
|
|
|
|
=head1 METHODS |
918
|
|
|
|
|
|
|
|
919
|
|
|
|
|
|
|
=over |
920
|
|
|
|
|
|
|
|
921
|
|
|
|
|
|
|
=item my $status = Travel::Status::DE::HAFAS->new(I<%opt>) |
922
|
|
|
|
|
|
|
|
923
|
|
|
|
|
|
|
Requests item(s) as specified by I<opt> and returns a new |
924
|
|
|
|
|
|
|
Travel::Status::DE::HAFAS element with the results. Dies if the wrong |
925
|
|
|
|
|
|
|
I<opt> were passed. |
926
|
|
|
|
|
|
|
|
927
|
|
|
|
|
|
|
I<opt> must contain either a B<station>, B<geoSearch>, B<locationSearch>, or B<journey> flag: |
928
|
|
|
|
|
|
|
|
929
|
|
|
|
|
|
|
=over |
930
|
|
|
|
|
|
|
|
931
|
|
|
|
|
|
|
=item B<station> => I<station> |
932
|
|
|
|
|
|
|
|
933
|
|
|
|
|
|
|
Request station board (arrivals or departures) for I<station>, e.g. "Essen HBf" or |
934
|
|
|
|
|
|
|
"Alfredusbad, Essen (Ruhr)". The station must be specified either by name or by |
935
|
|
|
|
|
|
|
EVA ID (e.g. 8000080 for Dortmund Hbf). |
936
|
|
|
|
|
|
|
Results are available via C<< $status->results >>. |
937
|
|
|
|
|
|
|
|
938
|
|
|
|
|
|
|
=item B<geoSearch> => B<{> B<lat> => I<latitude>, B<lon> => I<longitude> B<}> |
939
|
|
|
|
|
|
|
|
940
|
|
|
|
|
|
|
Search for stations near I<latitude>, I<longitude>. |
941
|
|
|
|
|
|
|
Results are available via C<< $status->results >>. |
942
|
|
|
|
|
|
|
|
943
|
|
|
|
|
|
|
=item B<locationSearch> => I<query> |
944
|
|
|
|
|
|
|
|
945
|
|
|
|
|
|
|
Search for stations whose name is similar to I<query>. |
946
|
|
|
|
|
|
|
Results are available via C<< $status->results >>. |
947
|
|
|
|
|
|
|
|
948
|
|
|
|
|
|
|
=item B<journey> => B<{> B<id> => I<tripid> [, B<name> => I<line> ] B<}> |
949
|
|
|
|
|
|
|
|
950
|
|
|
|
|
|
|
Request details about the journey identified by I<tripid> and I<line>. |
951
|
|
|
|
|
|
|
The result is available via C<< $status->result >>. |
952
|
|
|
|
|
|
|
|
953
|
|
|
|
|
|
|
=back |
954
|
|
|
|
|
|
|
|
955
|
|
|
|
|
|
|
The following optional flags may be set. |
956
|
|
|
|
|
|
|
Values in brackets indicate flags that are only relevant in certain request |
957
|
|
|
|
|
|
|
modes, e.g. geoSearch or journey. |
958
|
|
|
|
|
|
|
|
959
|
|
|
|
|
|
|
=over |
960
|
|
|
|
|
|
|
|
961
|
|
|
|
|
|
|
=item B<arrivals> => I<bool> (station) |
962
|
|
|
|
|
|
|
|
963
|
|
|
|
|
|
|
Request arrivals (if I<bool> is true) rather than departures (if I<bool> is |
964
|
|
|
|
|
|
|
false or B<arrivals> is not specified). |
965
|
|
|
|
|
|
|
|
966
|
|
|
|
|
|
|
=item B<cache> => I<Cache::File object> |
967
|
|
|
|
|
|
|
|
968
|
|
|
|
|
|
|
Store HAFAS replies in the provided cache object. This module works with |
969
|
|
|
|
|
|
|
real-time data, so the object should be configured for an expiry of one to two |
970
|
|
|
|
|
|
|
minutes. |
971
|
|
|
|
|
|
|
|
972
|
|
|
|
|
|
|
=item B<datetime> => I<DateTime object> (station) |
973
|
|
|
|
|
|
|
|
974
|
|
|
|
|
|
|
Date and time to report for. Defaults to now. |
975
|
|
|
|
|
|
|
|
976
|
|
|
|
|
|
|
=item B<excluded_mots> => [I<mot1>, I<mot2>, ...] (geoSearch, station) |
977
|
|
|
|
|
|
|
|
978
|
|
|
|
|
|
|
By default, all modes of transport (trains, trams, buses etc.) are returned. |
979
|
|
|
|
|
|
|
If this option is set, all modes appearing in I<mot1>, I<mot2>, ... will |
980
|
|
|
|
|
|
|
be excluded. The supported modes depend on B<service>, use |
981
|
|
|
|
|
|
|
B<get_services> or B<get_service> to get the supported values. |
982
|
|
|
|
|
|
|
|
983
|
|
|
|
|
|
|
=item B<exclusive_mots> => [I<mot1>, I<mot2>, ...] (geoSearch, station) |
984
|
|
|
|
|
|
|
|
985
|
|
|
|
|
|
|
If this option is set, only the modes of transport appearing in I<mot1>, |
986
|
|
|
|
|
|
|
I<mot2>, ... will be returned. The supported modes depend on B<service>, use |
987
|
|
|
|
|
|
|
B<get_services> or B<get_service> to get the supported values. |
988
|
|
|
|
|
|
|
|
989
|
|
|
|
|
|
|
=item B<lookahead> => I<int> (station) |
990
|
|
|
|
|
|
|
|
991
|
|
|
|
|
|
|
Request arrivals/departures that occur up to I<int> minutes after the specified datetime. |
992
|
|
|
|
|
|
|
Default: -1 (do not limit results by time). |
993
|
|
|
|
|
|
|
|
994
|
|
|
|
|
|
|
=item B<lwp_options> => I<\%hashref> |
995
|
|
|
|
|
|
|
|
996
|
|
|
|
|
|
|
Passed on to C<< LWP::UserAgent->new >>. Defaults to C<< { timeout => 10 } >>, |
997
|
|
|
|
|
|
|
pass an empty hashref to call the LWP::UserAgent constructor without arguments. |
998
|
|
|
|
|
|
|
|
999
|
|
|
|
|
|
|
=item B<results> => I<count> (geoSearch, locationSearch, station) |
1000
|
|
|
|
|
|
|
|
1001
|
|
|
|
|
|
|
Request up to I<count> results. |
1002
|
|
|
|
|
|
|
Default: 30. |
1003
|
|
|
|
|
|
|
|
1004
|
|
|
|
|
|
|
=item B<service> => I<service> |
1005
|
|
|
|
|
|
|
|
1006
|
|
|
|
|
|
|
Request results from I<service>, defaults to "DB". |
1007
|
|
|
|
|
|
|
See B<get_services> (and C<< hafas-m --list >>) for a list of supported |
1008
|
|
|
|
|
|
|
services. |
1009
|
|
|
|
|
|
|
|
1010
|
|
|
|
|
|
|
=item B<with_polyline> => I<bool> (journey) |
1011
|
|
|
|
|
|
|
|
1012
|
|
|
|
|
|
|
Request a polyline (series of geo-coordinates) indicating the train's route. |
1013
|
|
|
|
|
|
|
|
1014
|
|
|
|
|
|
|
=back |
1015
|
|
|
|
|
|
|
|
1016
|
|
|
|
|
|
|
=item my $status_p = Travel::Status::DE::HAFAS->new_p(I<%opt>) |
1017
|
|
|
|
|
|
|
|
1018
|
|
|
|
|
|
|
Returns a promise that resolves into a Travel::Status::DE::HAFAS instance |
1019
|
|
|
|
|
|
|
($status) on success and rejects with an error message on failure. If the |
1020
|
|
|
|
|
|
|
failure occured after receiving a response from the HAFAS backend, the rejected |
1021
|
|
|
|
|
|
|
promise contains a Travel::Status::DE::HAFAS instance as a second argument. |
1022
|
|
|
|
|
|
|
This instance can be used e.g. to call similar_stops_p in case of an ambiguous |
1023
|
|
|
|
|
|
|
location specifier. In addition to the arguments of B<new>, the following |
1024
|
|
|
|
|
|
|
mandatory arguments must be set. |
1025
|
|
|
|
|
|
|
|
1026
|
|
|
|
|
|
|
=over |
1027
|
|
|
|
|
|
|
|
1028
|
|
|
|
|
|
|
=item B<promise> => I<promises module> |
1029
|
|
|
|
|
|
|
|
1030
|
|
|
|
|
|
|
Promises implementation to use for internal promises as well as B<new_p> return |
1031
|
|
|
|
|
|
|
value. Recommended: Mojo::Promise(3pm). |
1032
|
|
|
|
|
|
|
|
1033
|
|
|
|
|
|
|
=item B<user_agent> => I<user agent> |
1034
|
|
|
|
|
|
|
|
1035
|
|
|
|
|
|
|
User agent instance to use for asynchronous requests. The object must implement |
1036
|
|
|
|
|
|
|
a B<post_p> function. Recommended: Mojo::UserAgent(3pm). |
1037
|
|
|
|
|
|
|
|
1038
|
|
|
|
|
|
|
=back |
1039
|
|
|
|
|
|
|
|
1040
|
|
|
|
|
|
|
=item $status->errcode |
1041
|
|
|
|
|
|
|
|
1042
|
|
|
|
|
|
|
In case of an error in the HAFAS backend, returns the corresponding error code |
1043
|
|
|
|
|
|
|
as string. If no backend error occurred, returns undef. |
1044
|
|
|
|
|
|
|
|
1045
|
|
|
|
|
|
|
=item $status->errstr |
1046
|
|
|
|
|
|
|
|
1047
|
|
|
|
|
|
|
In case of an error in the HTTP request or HAFAS backend, returns a string |
1048
|
|
|
|
|
|
|
describing it. If no error occurred, returns undef. |
1049
|
|
|
|
|
|
|
|
1050
|
|
|
|
|
|
|
=item $status->results (geoSearch, locationSearch) |
1051
|
|
|
|
|
|
|
|
1052
|
|
|
|
|
|
|
Returns a list of stations. Each list element is a |
1053
|
|
|
|
|
|
|
Travel::Status::DE::HAFAS::Stop(3pm) object. |
1054
|
|
|
|
|
|
|
|
1055
|
|
|
|
|
|
|
If no matching results were found or the parser / http request failed, returns |
1056
|
|
|
|
|
|
|
an empty list. |
1057
|
|
|
|
|
|
|
|
1058
|
|
|
|
|
|
|
=item $status->results (station) |
1059
|
|
|
|
|
|
|
|
1060
|
|
|
|
|
|
|
Returns a list of arrivals/departures. Each list element is a |
1061
|
|
|
|
|
|
|
Travel::Status::DE::HAFAS::Journey(3pm) object. |
1062
|
|
|
|
|
|
|
|
1063
|
|
|
|
|
|
|
If no matching results were found or the parser / http request failed, returns |
1064
|
|
|
|
|
|
|
undef. |
1065
|
|
|
|
|
|
|
|
1066
|
|
|
|
|
|
|
=item $status->result (journey) |
1067
|
|
|
|
|
|
|
|
1068
|
|
|
|
|
|
|
Returns a single Travel::Status::DE::HAFAS::Journey(3pm) object that describes |
1069
|
|
|
|
|
|
|
the requested journey. |
1070
|
|
|
|
|
|
|
|
1071
|
|
|
|
|
|
|
If no result was found or the parser / http request failed, returns undef. |
1072
|
|
|
|
|
|
|
|
1073
|
|
|
|
|
|
|
=item $status->messages |
1074
|
|
|
|
|
|
|
|
1075
|
|
|
|
|
|
|
Returns a list of Travel::Status::DE::HAFAS::Message(3pm) objects with |
1076
|
|
|
|
|
|
|
service messages. Each message belongs to at least one arrival/departure. |
1077
|
|
|
|
|
|
|
|
1078
|
|
|
|
|
|
|
=item $status->station |
1079
|
|
|
|
|
|
|
|
1080
|
|
|
|
|
|
|
Returns a hashref describing the departure stations in all requested journeys. |
1081
|
|
|
|
|
|
|
The hashref contains four entries: B<names> (station names), B<name> (most |
1082
|
|
|
|
|
|
|
common name), B<evas> (UIC / EVA IDs), and B<eva> (most common UIC / EVA ID). |
1083
|
|
|
|
|
|
|
These are subject to change. |
1084
|
|
|
|
|
|
|
|
1085
|
|
|
|
|
|
|
Note that the most common name and ID may be different from the station for |
1086
|
|
|
|
|
|
|
which departures were requested, as HAFAS uses different identifiers for train |
1087
|
|
|
|
|
|
|
stations, bus stops, and other modes of transit even if they are interlinked. |
1088
|
|
|
|
|
|
|
|
1089
|
|
|
|
|
|
|
Not available in journey mode. |
1090
|
|
|
|
|
|
|
|
1091
|
|
|
|
|
|
|
=item $status->similar_stops |
1092
|
|
|
|
|
|
|
|
1093
|
|
|
|
|
|
|
Returns a list of hashrefs describing stops whose name is similar to the one |
1094
|
|
|
|
|
|
|
requested in the constructor's B<station> parameter. Returns nothing if |
1095
|
|
|
|
|
|
|
the active service does not support this feature. |
1096
|
|
|
|
|
|
|
This is most useful if B<errcode> returns 'LOCATION', which means that the |
1097
|
|
|
|
|
|
|
HAFAS backend could not identify the stop. |
1098
|
|
|
|
|
|
|
|
1099
|
|
|
|
|
|
|
See Travel::Status::DE::HAFAS::StopFinder(3pm)'s B<results> method for details |
1100
|
|
|
|
|
|
|
on the return value. |
1101
|
|
|
|
|
|
|
|
1102
|
|
|
|
|
|
|
=item $status->similar_stops_p(I<%opt>) |
1103
|
|
|
|
|
|
|
|
1104
|
|
|
|
|
|
|
Returns a promise resolving to a list of hashrefs describing stops whose name |
1105
|
|
|
|
|
|
|
is similar to the one requested in the constructor's B<station> parameter. |
1106
|
|
|
|
|
|
|
Returns nothing if the active service does not support this feature. This is |
1107
|
|
|
|
|
|
|
most useful if B<errcode> returns 'LOCATION', which means that the HAFAS |
1108
|
|
|
|
|
|
|
backend could not identify the stop. |
1109
|
|
|
|
|
|
|
|
1110
|
|
|
|
|
|
|
See Travel::Status::DE::HAFAS::StopFinder(3pm)'s B<results> method for details |
1111
|
|
|
|
|
|
|
on the resolved values. |
1112
|
|
|
|
|
|
|
|
1113
|
|
|
|
|
|
|
If $status has been created using B<new_p>, this function does not require |
1114
|
|
|
|
|
|
|
arguments. Otherwise, the caller must specify B<promise> and B<user_agent> |
1115
|
|
|
|
|
|
|
(see B<new_p> above). |
1116
|
|
|
|
|
|
|
|
1117
|
|
|
|
|
|
|
=item $status->get_active_service |
1118
|
|
|
|
|
|
|
|
1119
|
|
|
|
|
|
|
Returns a hashref describing the active service when a service is active and |
1120
|
|
|
|
|
|
|
nothing otherwise. The hashref contains the keys B<url> (URL to the station |
1121
|
|
|
|
|
|
|
board service), B<stopfinder> (URL to the stopfinder service, if supported), |
1122
|
|
|
|
|
|
|
B<name>, and B<productbits> (arrayref describing the supported modes of |
1123
|
|
|
|
|
|
|
transport, may contain duplicates). |
1124
|
|
|
|
|
|
|
|
1125
|
|
|
|
|
|
|
=item Travel::Status::DE::HAFAS::get_services() |
1126
|
|
|
|
|
|
|
|
1127
|
|
|
|
|
|
|
Returns an array containing all supported HAFAS services. Each element is a |
1128
|
|
|
|
|
|
|
hashref and contains all keys mentioned in B<get_active_service>. |
1129
|
|
|
|
|
|
|
It also contains a B<shortname> key, which is the service name used by |
1130
|
|
|
|
|
|
|
the constructor's B<service> parameter. |
1131
|
|
|
|
|
|
|
|
1132
|
|
|
|
|
|
|
=item Travel::Status::DE::HAFAS::get_service(I<$service>) |
1133
|
|
|
|
|
|
|
|
1134
|
|
|
|
|
|
|
Returns a hashref describing the service I<$service>. Returns nothing if |
1135
|
|
|
|
|
|
|
I<$service> is not supported. See B<get_active_service> for the hashref layout. |
1136
|
|
|
|
|
|
|
|
1137
|
|
|
|
|
|
|
=back |
1138
|
|
|
|
|
|
|
|
1139
|
|
|
|
|
|
|
=head1 DIAGNOSTICS |
1140
|
|
|
|
|
|
|
|
1141
|
|
|
|
|
|
|
None. |
1142
|
|
|
|
|
|
|
|
1143
|
|
|
|
|
|
|
=head1 DEPENDENCIES |
1144
|
|
|
|
|
|
|
|
1145
|
|
|
|
|
|
|
=over |
1146
|
|
|
|
|
|
|
|
1147
|
|
|
|
|
|
|
=item * Class::Accessor(3pm) |
1148
|
|
|
|
|
|
|
|
1149
|
|
|
|
|
|
|
=item * DateTime(3pm) |
1150
|
|
|
|
|
|
|
|
1151
|
|
|
|
|
|
|
=item * DateTime::Format::Strptime(3pm) |
1152
|
|
|
|
|
|
|
|
1153
|
|
|
|
|
|
|
=item * LWP::UserAgent(3pm) |
1154
|
|
|
|
|
|
|
|
1155
|
|
|
|
|
|
|
=back |
1156
|
|
|
|
|
|
|
|
1157
|
|
|
|
|
|
|
=head1 BUGS AND LIMITATIONS |
1158
|
|
|
|
|
|
|
|
1159
|
|
|
|
|
|
|
The non-default services (anything other than DB) are not well tested. |
1160
|
|
|
|
|
|
|
|
1161
|
|
|
|
|
|
|
=head1 SEE ALSO |
1162
|
|
|
|
|
|
|
|
1163
|
|
|
|
|
|
|
Travel::Status::DE::HAFAS::Journey(3pm), Travel::Status::DE::HAFAS::StopFinder(3pm). |
1164
|
|
|
|
|
|
|
|
1165
|
|
|
|
|
|
|
=head1 AUTHOR |
1166
|
|
|
|
|
|
|
|
1167
|
|
|
|
|
|
|
Copyright (C) 2015-2022 by Birte Kristina Friesel E<lt>derf@finalrewind.orgE<gt> |
1168
|
|
|
|
|
|
|
|
1169
|
|
|
|
|
|
|
=head1 LICENSE |
1170
|
|
|
|
|
|
|
|
1171
|
|
|
|
|
|
|
This module is licensed under the same terms as Perl itself. |