| … | |
… | |
| 57 | |
57 | |
| 58 | =item port => $port |
58 | =item port => $port |
| 59 | |
59 | |
| 60 | The port to connect to, default is C<2947>. |
60 | The port to connect to, default is C<2947>. |
| 61 | |
61 | |
|
|
62 | =item min_speed => $speed_in_m_per_s |
|
|
63 | |
|
|
64 | Sets the mininum speed (default: 0) that is considered real for the |
|
|
65 | purposes of replay compression or estimate. Speeds below this value will |
|
|
66 | be considered 0. |
|
|
67 | |
| 62 | =item on_error => $cb->($gps) |
68 | =item on_error => $cb->($gps) |
| 63 | |
69 | |
| 64 | Called on every connection or protocol failure, reason is in C<$!> |
70 | Called on every connection or protocol failure, reason is in C<$!> |
| 65 | (protocl errors are signalled via EBADMSG). Can be used to bail out if you |
71 | (protocl errors are signalled via EBADMSG). Can be used to bail out if you |
| 66 | are not interested in retries. |
72 | are not interested in retries. |
| … | |
… | |
| 88 | |
94 | |
| 89 | C<snr> contains the signal strength in decibals (28+ is usually the |
95 | C<snr> contains the signal strength in decibals (28+ is usually the |
| 90 | minimum value for a good fix). |
96 | minimum value for a good fix). |
| 91 | |
97 | |
| 92 | C<fix> contains either C<1> to indicate that this satellite was used for |
98 | C<fix> contains either C<1> to indicate that this satellite was used for |
| 93 | the last position fix, C<0> otherwise. EGNOS/WAAS etc. satellites will |
99 | the last position fix, C<0> otherwise. EGNOS/WAAS etc. satellites will |
| 94 | always show as C<0>, even if their correction info was used. |
100 | always show as C<0>, even if their correction info was used. |
| 95 | |
101 | |
|
|
102 | The passed hash references are read-only. |
|
|
103 | |
| 96 | =item on_fix => $cb->({point}) |
104 | =item on_fix => $cb->({point}) |
| 97 | |
105 | |
| 98 | Called regularly. The C<{point}> hash contains at least the following |
106 | Called regularly (usually about once/second), even when there is no |
| 99 | members: |
107 | connection to the GPSD (so is useful to update your idea of the current |
|
|
108 | position). The passed hash reference must I<not> be modified in any way. |
|
|
109 | |
|
|
110 | If C<mode> is C<2> or C<3>, then the C<{point}> hash contains at least the |
|
|
111 | following members, otherwise it is undefined which members exist. Members |
|
|
112 | whose values are not known are C<undef> (usually the error values, speed |
|
|
113 | and so on). |
| 100 | |
114 | |
| 101 | time when this fix was received (s) |
115 | time when this fix was received (s) |
| 102 | |
116 | |
| 103 | lat latitude (S -90..90 N) |
117 | lat latitude (S -90..90 N) |
| 104 | lon longitude (W -180..180 E) |
118 | lon longitude (W -180..180 E) |
| … | |
… | |
| 122 | |
136 | |
| 123 | sub new { |
137 | sub new { |
| 124 | my $class = shift; |
138 | my $class = shift; |
| 125 | my $self = bless { |
139 | my $self = bless { |
| 126 | @_, |
140 | @_, |
|
|
141 | interval => 1, |
|
|
142 | fix => { time => AnyEvent->now, mode => 1 }, |
| 127 | }, $class; |
143 | }, $class; |
| 128 | |
144 | |
|
|
145 | $self->interval_timer; |
| 129 | $self->connect; |
146 | $self->connect; |
| 130 | |
147 | |
| 131 | $self |
148 | $self |
|
|
149 | } |
|
|
150 | |
|
|
151 | sub DESTROY { |
|
|
152 | my ($self) = @_; |
|
|
153 | |
|
|
154 | $self->record_log; |
| 132 | } |
155 | } |
| 133 | |
156 | |
| 134 | sub event { |
157 | sub event { |
| 135 | my $event = splice @_, 1, 1, (); |
158 | my $event = splice @_, 1, 1, (); |
| 136 | |
159 | |
| 137 | warn "event<$event,@_>\n";#d# |
160 | #warn "event<$event,@_>\n";#d# |
| 138 | if ($event = $_[0]{"on_$event"}) { |
161 | if ($event = $_[0]{"on_$event"}) { |
| 139 | &$event; |
162 | &$event; |
| 140 | } |
163 | } |
| 141 | } |
164 | } |
| 142 | |
165 | |
| 143 | sub retry { |
166 | sub retry { |
| 144 | my ($self) = @_; |
167 | my ($self) = @_; |
| 145 | |
168 | |
| 146 | delete $self->{fh}; |
169 | delete $self->{fh}; |
|
|
170 | delete $self->{command}; |
| 147 | |
171 | |
| 148 | Scalar::Util::weaken $self; |
172 | Scalar::Util::weaken $self; |
| 149 | $self->{retry_w} = AnyEvent->timer (after => 1, cb => sub { |
173 | $self->{retry_w} = AnyEvent->timer (after => 1, cb => sub { |
| 150 | delete $self->{retry_w}; |
174 | delete $self->{retry_w}; |
| 151 | $self->connect; |
175 | $self->connect; |
| 152 | }); |
176 | }); |
|
|
177 | } |
|
|
178 | |
|
|
179 | # make sure we send "no fix" updates when we lose connectivity |
|
|
180 | sub interval_timer { |
|
|
181 | my ($self) = @_; |
|
|
182 | |
|
|
183 | $self->{interval_w} = AnyEvent->timer (after => $self->{interval}, cb => sub { |
|
|
184 | if (AnyEvent->now - $self->{fix}{time} > $self->{interval} * 1.9) { |
|
|
185 | $self->{fix}{mode} = 1; |
|
|
186 | $self->event (fix => $self->{fix}); |
|
|
187 | } |
|
|
188 | |
|
|
189 | $self->interval_timer; |
|
|
190 | }); |
|
|
191 | |
|
|
192 | Scalar::Util::weaken $self; |
| 153 | } |
193 | } |
| 154 | |
194 | |
| 155 | sub connect { |
195 | sub connect { |
| 156 | my ($self) = @_; |
196 | my ($self) = @_; |
| 157 | |
197 | |
| … | |
… | |
| 177 | on_error => sub { |
217 | on_error => sub { |
| 178 | $self->event ("error"); |
218 | $self->event ("error"); |
| 179 | $self->retry; |
219 | $self->retry; |
| 180 | }, |
220 | }, |
| 181 | on_eof => sub { |
221 | on_eof => sub { |
| 182 | $! = &Errno::EBADMSG; |
222 | $! = &Errno::EPIPE; |
| 183 | $self->event ("error"); |
223 | $self->event ("error"); |
|
|
224 | $self->log ("disconnect"); |
| 184 | $self->retry; |
225 | $self->retry; |
| 185 | }, |
226 | }, |
| 186 | on_read => sub { |
227 | on_read => sub { |
| 187 | $_[0]{rbuf} =~ s/^([^\015\012]*)\015\012// |
228 | $_[0]{rbuf} =~ s/^([^\015\012]*)\015\012// |
| 188 | or return; |
229 | or return; |
| 189 | |
230 | |
| 190 | $self->feed ($1); |
231 | $self->feed ($1) |
|
|
232 | unless $self->{replay_cb}; |
| 191 | }, |
233 | }, |
| 192 | ; |
234 | ; |
| 193 | |
235 | |
| 194 | $self->send ("w"); |
236 | $self->send ("w"); |
| 195 | $self->send ("o"); |
237 | $self->send ("o"); |
| 196 | $self->send ("y"); |
238 | $self->send ("y"); |
|
|
239 | $self->send ("c"); |
| 197 | |
240 | |
| 198 | $self->event ("connect"); |
241 | $self->event ("connect"); |
|
|
242 | $self->log ("connect"); |
| 199 | } else { |
243 | } else { |
| 200 | $self->event ("error"); |
244 | $self->event ("error"); |
| 201 | } |
245 | } |
| 202 | }; |
246 | }; |
| 203 | |
247 | |
| … | |
… | |
| 223 | sub feed { |
267 | sub feed { |
| 224 | my ($self, $line) = @_; |
268 | my ($self, $line) = @_; |
| 225 | |
269 | |
| 226 | $self->{now} = AnyEvent->now; |
270 | $self->{now} = AnyEvent->now; |
| 227 | |
271 | |
|
|
272 | $self->log (raw => $line) |
|
|
273 | if $self->{logfh}; |
|
|
274 | |
| 228 | unless ($line =~ /^GPSD,(.)=(.*)$/) { |
275 | unless ($line =~ /^GPSD,(.)=(.*)$/) { |
| 229 | $! = &Errno::EBADMSG; |
276 | $! = &Errno::EBADMSG; |
| 230 | $self->event ("error"); |
277 | $self->event ("error"); |
| 231 | return $self->retry; |
278 | return $self->retry; |
| 232 | } |
279 | } |
| 233 | |
280 | |
| 234 | my ($type, $data) = ($1, $2); |
281 | my ($type, $data) = ($1, $2); |
| 235 | |
282 | |
|
|
283 | #warn "$type=$data\n";#d# |
|
|
284 | |
| 236 | $self->{state}{$type} = [$data => $self->{now}]; |
285 | $self->{state}{$type} = [$data => $self->{now}]; |
| 237 | |
286 | |
| 238 | if ($type eq "O") { |
287 | if ($type eq "O") { |
| 239 | my @data = split /\s+/, $data; |
288 | my @data = split /\s+/, $data; |
|
|
289 | |
|
|
290 | my $fix = $self->{fix}; |
|
|
291 | |
| 240 | my %fix = (time => $self->{now}); |
292 | $fix->{time} = $self->{now}; |
| 241 | |
293 | |
| 242 | if (@data > 3) { |
294 | if (@data > 3) { |
| 243 | # the gpsd time is virtually useless as it is truncated :/ |
295 | # the gpsd time is virtually useless as it is truncated :/ |
| 244 | $fix{$_} = shift @data for qw(tag _time _terr lat lon alt herr verr bearing speed vspeed berr serr vserr mode); |
296 | for (qw(tag _time _terr lat lon alt herr verr bearing speed vspeed berr serr vserr mode)) { |
|
|
297 | $type = shift @data; |
|
|
298 | $fix->{$_} = $type eq "?" ? undef : $type; |
|
|
299 | } |
| 245 | |
300 | |
|
|
301 | if (my $s = $self->{stretch}) { |
|
|
302 | $s = 1 / $s; |
|
|
303 | |
|
|
304 | $fix->{herr} *= $s; # ? |
|
|
305 | $fix->{verr} *= $s; # ? |
|
|
306 | $fix->{berr} *= $s; # ? |
|
|
307 | $fix->{serr} *= $s; # ? |
|
|
308 | $fix->{vserr} *= $s; # ? |
|
|
309 | |
|
|
310 | $fix->{speed} *= $s; |
|
|
311 | $fix->{vspeed} *= $s; |
|
|
312 | } |
|
|
313 | |
| 246 | $fix{mode} = 2 if $fix{mode} eq "?"; # arbitrary choice |
314 | $fix->{mode} = 2 if $fix->{mode} eq "?"; # arbitrary choice |
| 247 | } else { |
315 | } else { |
| 248 | $fix{mode} = 1; |
316 | $fix->{mode} = 1; |
| 249 | } |
317 | } |
| 250 | |
318 | |
| 251 | $self->{fix} = \%fix; |
|
|
| 252 | $self->event (fix => \%fix); |
319 | $self->event (fix => $fix); |
| 253 | |
320 | |
| 254 | } elsif ($type eq "Y") { |
321 | } elsif ($type eq "Y") { |
| 255 | my (undef, @sats) = split /:/, $data; |
322 | my (undef, @sats) = split /:/, $data; |
| 256 | |
323 | |
| 257 | $self->{satellite_info} = [map { |
324 | $self->{satellite_info} = [map { |
| … | |
… | |
| 264 | fix => $sat[4], |
331 | fix => $sat[4], |
| 265 | } |
332 | } |
| 266 | } @sats]; |
333 | } @sats]; |
| 267 | |
334 | |
| 268 | $self->event (satellite_update => $self->{satellite_info}); |
335 | $self->event (satellite_update => $self->{satellite_info}); |
|
|
336 | |
|
|
337 | } elsif ($type eq "C") { |
|
|
338 | $self->{interval} = $data >= 1 ? $data * 1 : 1; |
| 269 | } |
339 | } |
| 270 | |
340 | |
| 271 | # we (wrongly) assume that gpsd responses are always in response |
341 | # we (wrongly) assume that gpsd responses are always in response |
| 272 | # to an earlier command |
342 | # to an earlier command |
| 273 | |
343 | |
| … | |
… | |
| 278 | } |
348 | } |
| 279 | |
349 | |
| 280 | =item ($lat, $lon) = $gps->estimate ([$max_seconds]) |
350 | =item ($lat, $lon) = $gps->estimate ([$max_seconds]) |
| 281 | |
351 | |
| 282 | This returns an estimate of the current position based on the last fix and |
352 | This returns an estimate of the current position based on the last fix and |
| 283 | the time passed since then. Useful for interactive applications where you |
353 | the time passed since then. |
| 284 | want more frequent updates, but not very useful to store, as the next fix |
|
|
| 285 | might well be totally off. |
|
|
| 286 | |
354 | |
|
|
355 | Useful for interactive applications where you want more frequent updates, |
|
|
356 | but not very useful to store, as the next fix might well be totally |
|
|
357 | off. For example, when displaying a real-time map, you could simply call |
|
|
358 | C<estimate> ten times a second and update the cursor or map position, but |
|
|
359 | you should use C<on_fix> to actually gather data to plot the course itself. |
|
|
360 | |
| 287 | If the fix is older then C<$max_seconds> (default: C<1.9>) or if no fix is |
361 | If the fix is older then C<$max_seconds> (default: C<1.9> times the update |
| 288 | available, returns the empty list. |
362 | interval, i.e. usually C<1.9> seconds) or if no fix is available, returns |
|
|
363 | the empty list. |
| 289 | |
364 | |
| 290 | =cut |
365 | =cut |
| 291 | |
366 | |
| 292 | sub estimate { |
367 | sub estimate { |
| 293 | my ($self, $max) = @_; |
368 | my ($self, $max) = @_; |
| 294 | |
369 | |
| 295 | $max ||= 1.9 unless defined $max; |
370 | $max ||= 1.9 * $self->{interval} unless defined $max; |
| 296 | |
371 | |
| 297 | my $geo = $self->{geo_forward} ||= new Geo::Forward; |
372 | my $geo = $self->{geo_forward} ||= new Geo::Forward; |
| 298 | |
373 | |
| 299 | my $fix = $self->{fix} or return; |
374 | my $fix = $self->{fix} or return; |
| 300 | $fix->{mode} >= 2 or return; |
375 | $fix->{mode} >= 2 or return; |
| 301 | |
376 | |
| 302 | my $diff = AnyEvent->time - $fix->{time}; |
377 | my $diff = AnyEvent->time - $fix->{time}; |
| 303 | |
378 | |
| 304 | $diff <= $max or return; |
379 | $diff <= $max or return; |
| 305 | |
380 | |
| 306 | if ($fix->{speed} > $fix->{serr}) { |
381 | if ($fix->{speed} >= $self->{min_speed}) { |
| 307 | my ($lat, $lon) = $geo->forward ($fix->{lat}, $fix->{lon}, $fix->{bearing}, $fix->{speed} * $diff); |
382 | my ($lat, $lon) = $geo->forward ($fix->{lat}, $fix->{lon}, $fix->{bearing}, $fix->{speed} * $diff); |
| 308 | ($lat, $lon) |
383 | ($lat, $lon) |
| 309 | |
384 | |
| 310 | } else { |
385 | } else { |
| 311 | # if we likely have zero speed, return the point itself |
386 | # if we likely have zero speed, return the point itself |
| 312 | ($fix->{lat}, $fix->{lon}) |
387 | ($fix->{lat}, $fix->{lon}) |
| 313 | } |
388 | } |
| 314 | } |
389 | } |
| 315 | |
390 | |
|
|
391 | sub log { |
|
|
392 | my ($self, @arg) = @_; |
|
|
393 | |
|
|
394 | syswrite $self->{logfh}, JSON::encode_json ([AnyEvent->time, @arg]) . "\n" |
|
|
395 | if $self->{logfh}; |
|
|
396 | } |
|
|
397 | |
|
|
398 | =item $gps->record_log ($path) |
|
|
399 | |
|
|
400 | If C<$path> is defined, then that file will be created or truncated and a |
|
|
401 | log of all (raw) packets received will be written to it. This log file can |
|
|
402 | later be replayed by calling C<< $gps->replay_log ($path) >>. |
|
|
403 | |
|
|
404 | If C<$path> is undefined then the log will be closed. |
|
|
405 | |
|
|
406 | =cut |
|
|
407 | |
|
|
408 | sub record_log { |
|
|
409 | my ($self, $path) = @_; |
|
|
410 | |
|
|
411 | if (defined $path) { |
|
|
412 | $self->record_log; |
|
|
413 | |
|
|
414 | require JSON; |
|
|
415 | |
|
|
416 | open $self->{logfh}, ">:perlio", $path |
|
|
417 | or Carp::croak "$path: $!"; |
|
|
418 | |
|
|
419 | $self->log (start => $VERSION, 0, 0, { interval => $self->{interval} }); |
|
|
420 | } elsif ($self->{logfh}) { |
|
|
421 | $self->log ("stop"); |
|
|
422 | delete $self->{logfh}; |
|
|
423 | } |
|
|
424 | } |
|
|
425 | |
|
|
426 | =item $gps->replay_log ($path, %options) |
|
|
427 | |
|
|
428 | Replays a log file written using C<record_log> (or stops replaying when |
|
|
429 | C<$path> is undefined). While the log file replays, real GPS events will |
|
|
430 | be ignored. This comes in handy when testing. |
|
|
431 | |
|
|
432 | Please note that replaying a log will change configuration options that |
|
|
433 | will not be restored, so it's best not to reuse a gpsd object after a |
|
|
434 | replay. |
|
|
435 | |
|
|
436 | The C<AnyEvent::GPSD> distribution comes with an example log |
|
|
437 | (F<eg/example.aegps>) that you can replay for testing or enjoyment |
|
|
438 | purposes. |
|
|
439 | |
|
|
440 | The options include: |
|
|
441 | |
|
|
442 | =over 4 |
|
|
443 | |
|
|
444 | =item compress => 1 |
|
|
445 | |
|
|
446 | If set to a true value (default: false), then passages without fix will be |
|
|
447 | replayed much faster than passages with fix. The same happens for passages |
|
|
448 | without much movement. |
|
|
449 | |
|
|
450 | =item stretch => $factor |
|
|
451 | |
|
|
452 | Multiplies all times by the given factor. Values < 1 make the log replay |
|
|
453 | faster, values > 1 slower. Note that the frequency of fixes will not be |
|
|
454 | increased, o stretch factors > 1 do not work well. |
|
|
455 | |
|
|
456 | A stretch factor of zero is not allowed, but if you want to replay a log |
|
|
457 | instantly you may speicfy a very low value (e.g. 1e-10). |
|
|
458 | |
|
|
459 | =back |
|
|
460 | |
|
|
461 | =cut |
|
|
462 | |
|
|
463 | sub replay_log { |
|
|
464 | my ($self, $path, %option) = @_; |
|
|
465 | |
|
|
466 | if (defined $path) { |
|
|
467 | $self->replay_log; |
|
|
468 | |
|
|
469 | require JSON; |
|
|
470 | |
|
|
471 | open my $fh, "<:perlio", $path |
|
|
472 | or Carp::croak "$path: $!"; |
|
|
473 | |
|
|
474 | $self->{stretch} = $option{stretch} || 1; |
|
|
475 | $self->{compress} = $option{compress}; |
|
|
476 | |
|
|
477 | $self->{imterval} /= $self->{stretch}; |
|
|
478 | |
|
|
479 | Scalar::Util::weaken $self; |
|
|
480 | |
|
|
481 | $self->{replay_cb} = sub { |
|
|
482 | my $line = <$fh>; |
|
|
483 | |
|
|
484 | if (2 > length $line) { |
|
|
485 | $self->replay_log; |
|
|
486 | } else { |
|
|
487 | my ($time, $type, @data) = @{ JSON::decode_json ($line) }; |
|
|
488 | |
|
|
489 | $time *= $self->{stretch}; |
|
|
490 | |
|
|
491 | if ($type eq "start") { |
|
|
492 | my ($module_version, $major_version, $minor_version, $args) = @data; |
|
|
493 | |
|
|
494 | $self->{interval} = ($args->{interval} || 1) / $self->{stretch}; |
|
|
495 | } |
|
|
496 | |
|
|
497 | if ( |
|
|
498 | $type eq "start" |
|
|
499 | or ($self->{compress} |
|
|
500 | and $self->{fix} && ($self->{fix}{mode} < 2 || $self->{fix}{speed} < $self->{min_speed})) |
|
|
501 | ) { |
|
|
502 | $self->{replay_now} = $time; |
|
|
503 | } |
|
|
504 | |
|
|
505 | $self->{replay_timer} = AnyEvent->timer (after => $time - $self->{replay_now}, cb => sub { |
|
|
506 | $self->{replay_now} = $time; |
|
|
507 | $self->{command} = []; # no can do |
|
|
508 | $self->feed ($data[0]) if $type eq "raw"; |
|
|
509 | $self->{replay_cb}(); |
|
|
510 | }); |
|
|
511 | } |
|
|
512 | }; |
|
|
513 | |
|
|
514 | $self->{replay_cb}(); |
|
|
515 | |
|
|
516 | } else { |
|
|
517 | delete $self->{stretch}; |
|
|
518 | delete $self->{compress}; |
|
|
519 | delete $self->{replay_timer}; |
|
|
520 | delete $self->{replay_cb}; |
|
|
521 | } |
|
|
522 | } |
|
|
523 | |
| 316 | =back |
524 | =back |
| 317 | |
525 | |
| 318 | =head1 SEE ALSO |
526 | =head1 SEE ALSO |
| 319 | |
527 | |
| 320 | L<AnyEvent>. |
528 | L<AnyEvent>. |
