… | |
… | |
88 | |
88 | |
89 | C<snr> contains the signal strength in decibals (28+ is usually the |
89 | C<snr> contains the signal strength in decibals (28+ is usually the |
90 | minimum value for a good fix). |
90 | minimum value for a good fix). |
91 | |
91 | |
92 | C<fix> contains either C<1> to indicate that this satellite was used for |
92 | 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 |
93 | 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. |
94 | always show as C<0>, even if their correction info was used. |
|
|
95 | |
|
|
96 | The passed hash references are read-only. |
95 | |
97 | |
96 | =item on_fix => $cb->({point}) |
98 | =item on_fix => $cb->({point}) |
97 | |
99 | |
98 | Called regularly (usually about once/second), even when there is no |
100 | Called regularly (usually about once/second), even when there is no |
99 | connection to the GPSD (so is useful to update your idea of the current |
101 | connection to the GPSD (so is useful to update your idea of the current |
… | |
… | |
138 | $self->connect; |
140 | $self->connect; |
139 | |
141 | |
140 | $self |
142 | $self |
141 | } |
143 | } |
142 | |
144 | |
|
|
145 | sub DESTROY { |
|
|
146 | my ($self) = @_; |
|
|
147 | |
|
|
148 | $self->record_log; |
|
|
149 | } |
|
|
150 | |
143 | sub event { |
151 | sub event { |
144 | my $event = splice @_, 1, 1, (); |
152 | my $event = splice @_, 1, 1, (); |
145 | |
153 | |
146 | warn "event<$event,@_>\n";#d# |
154 | #warn "event<$event,@_>\n";#d# |
147 | if ($event = $_[0]{"on_$event"}) { |
155 | if ($event = $_[0]{"on_$event"}) { |
148 | &$event; |
156 | &$event; |
149 | } |
157 | } |
150 | } |
158 | } |
151 | |
159 | |
152 | sub retry { |
160 | sub retry { |
153 | my ($self) = @_; |
161 | my ($self) = @_; |
154 | |
162 | |
155 | delete $self->{fh}; |
163 | delete $self->{fh}; |
|
|
164 | delete $self->{command}; |
156 | |
165 | |
157 | Scalar::Util::weaken $self; |
166 | Scalar::Util::weaken $self; |
158 | $self->{retry_w} = AnyEvent->timer (after => 1, cb => sub { |
167 | $self->{retry_w} = AnyEvent->timer (after => 1, cb => sub { |
159 | delete $self->{retry_w}; |
168 | delete $self->{retry_w}; |
160 | $self->connect; |
169 | $self->connect; |
… | |
… | |
204 | $self->retry; |
213 | $self->retry; |
205 | }, |
214 | }, |
206 | on_eof => sub { |
215 | on_eof => sub { |
207 | $! = &Errno::EPIPE; |
216 | $! = &Errno::EPIPE; |
208 | $self->event ("error"); |
217 | $self->event ("error"); |
|
|
218 | $self->log ("disconnect"); |
209 | $self->retry; |
219 | $self->retry; |
210 | }, |
220 | }, |
211 | on_read => sub { |
221 | on_read => sub { |
212 | $_[0]{rbuf} =~ s/^([^\015\012]*)\015\012// |
222 | $_[0]{rbuf} =~ s/^([^\015\012]*)\015\012// |
213 | or return; |
223 | or return; |
214 | |
224 | |
215 | $self->feed ($1); |
225 | $self->feed ($1) |
|
|
226 | unless $self->{replay_cb}; |
216 | }, |
227 | }, |
217 | ; |
228 | ; |
218 | |
229 | |
219 | $self->send ("w"); |
230 | $self->send ("w"); |
220 | $self->send ("o"); |
231 | $self->send ("o"); |
221 | $self->send ("y"); |
232 | $self->send ("y"); |
222 | $self->send ("c"); |
233 | $self->send ("c"); |
223 | |
234 | |
224 | $self->event ("connect"); |
235 | $self->event ("connect"); |
|
|
236 | $self->log ("connect"); |
225 | } else { |
237 | } else { |
226 | $self->event ("error"); |
238 | $self->event ("error"); |
227 | } |
239 | } |
228 | }; |
240 | }; |
229 | |
241 | |
… | |
… | |
249 | sub feed { |
261 | sub feed { |
250 | my ($self, $line) = @_; |
262 | my ($self, $line) = @_; |
251 | |
263 | |
252 | $self->{now} = AnyEvent->now; |
264 | $self->{now} = AnyEvent->now; |
253 | |
265 | |
|
|
266 | $self->log (raw => $line) |
|
|
267 | if $self->{logfh}; |
|
|
268 | |
254 | unless ($line =~ /^GPSD,(.)=(.*)$/) { |
269 | unless ($line =~ /^GPSD,(.)=(.*)$/) { |
255 | $! = &Errno::EBADMSG; |
270 | $! = &Errno::EBADMSG; |
256 | $self->event ("error"); |
271 | $self->event ("error"); |
257 | return $self->retry; |
272 | return $self->retry; |
258 | } |
273 | } |
259 | |
274 | |
260 | my ($type, $data) = ($1, $2); |
275 | my ($type, $data) = ($1, $2); |
|
|
276 | |
|
|
277 | #warn "$type=$data\n";#d# |
261 | |
278 | |
262 | $self->{state}{$type} = [$data => $self->{now}]; |
279 | $self->{state}{$type} = [$data => $self->{now}]; |
263 | |
280 | |
264 | if ($type eq "O") { |
281 | if ($type eq "O") { |
265 | my @data = split /\s+/, $data; |
282 | my @data = split /\s+/, $data; |
… | |
… | |
271 | if (@data > 3) { |
288 | if (@data > 3) { |
272 | # the gpsd time is virtually useless as it is truncated :/ |
289 | # the gpsd time is virtually useless as it is truncated :/ |
273 | for (qw(tag _time _terr lat lon alt herr verr bearing speed vspeed berr serr vserr mode)) { |
290 | for (qw(tag _time _terr lat lon alt herr verr bearing speed vspeed berr serr vserr mode)) { |
274 | $type = shift @data; |
291 | $type = shift @data; |
275 | $fix->{$_} = $type eq "?" ? undef : $type; |
292 | $fix->{$_} = $type eq "?" ? undef : $type; |
|
|
293 | } |
|
|
294 | |
|
|
295 | if (my $s = $self->{stretch}) { |
|
|
296 | $s = 1 / $s; |
|
|
297 | |
|
|
298 | $fix->{herr} *= $s; # ? |
|
|
299 | $fix->{verr} *= $s; # ? |
|
|
300 | $fix->{berr} *= $s; # ? |
|
|
301 | $fix->{serr} *= $s; # ? |
|
|
302 | $fix->{vserr} *= $s; # ? |
|
|
303 | |
|
|
304 | $fix->{speed} *= $s; |
|
|
305 | $fix->{vspeed} *= $s; |
276 | } |
306 | } |
277 | |
307 | |
278 | $fix->{mode} = 2 if $fix->{mode} eq "?"; # arbitrary choice |
308 | $fix->{mode} = 2 if $fix->{mode} eq "?"; # arbitrary choice |
279 | } else { |
309 | } else { |
280 | $fix->{mode} = 1; |
310 | $fix->{mode} = 1; |
… | |
… | |
316 | This returns an estimate of the current position based on the last fix and |
346 | This returns an estimate of the current position based on the last fix and |
317 | the time passed since then. Useful for interactive applications where you |
347 | the time passed since then. Useful for interactive applications where you |
318 | want more frequent updates, but not very useful to store, as the next fix |
348 | want more frequent updates, but not very useful to store, as the next fix |
319 | might well be totally off. |
349 | might well be totally off. |
320 | |
350 | |
321 | If the fix is older then C<$max_seconds> (default: C<1.9>) or if no fix is |
351 | If the fix is older then C<$max_seconds> (default: C<1.9> times the update |
322 | available, returns the empty list. |
352 | interval, i.e. usually C<1.9> seconds) or if no fix is available, returns |
|
|
353 | the empty list. |
323 | |
354 | |
324 | =cut |
355 | =cut |
325 | |
356 | |
326 | sub estimate { |
357 | sub estimate { |
327 | my ($self, $max) = @_; |
358 | my ($self, $max) = @_; |
328 | |
359 | |
329 | $max ||= 1.9 unless defined $max; |
360 | $max ||= 1.9 * $self->{interval} unless defined $max; |
330 | |
361 | |
331 | my $geo = $self->{geo_forward} ||= new Geo::Forward; |
362 | my $geo = $self->{geo_forward} ||= new Geo::Forward; |
332 | |
363 | |
333 | my $fix = $self->{fix} or return; |
364 | my $fix = $self->{fix} or return; |
334 | $fix->{mode} >= 2 or return; |
365 | $fix->{mode} >= 2 or return; |
… | |
… | |
345 | # if we likely have zero speed, return the point itself |
376 | # if we likely have zero speed, return the point itself |
346 | ($fix->{lat}, $fix->{lon}) |
377 | ($fix->{lat}, $fix->{lon}) |
347 | } |
378 | } |
348 | } |
379 | } |
349 | |
380 | |
|
|
381 | sub log { |
|
|
382 | my ($self, @arg) = @_; |
|
|
383 | |
|
|
384 | syswrite $self->{logfh}, JSON::encode_json ([AnyEvent->time, @arg]) . "\n" |
|
|
385 | if $self->{logfh}; |
|
|
386 | } |
|
|
387 | |
|
|
388 | =item $gps->record_log ($path) |
|
|
389 | |
|
|
390 | If C<$path> is defined, then that file will be created or truncated and a |
|
|
391 | log of all (raw) packets received will be written to it. This log file can |
|
|
392 | later be replayed by calling C<< $gps->replay_log ($path) >>. |
|
|
393 | |
|
|
394 | If C<$path> is undefined then the log will be closed. |
|
|
395 | |
|
|
396 | =cut |
|
|
397 | |
|
|
398 | sub record_log { |
|
|
399 | my ($self, $path) = @_; |
|
|
400 | |
|
|
401 | if (defined $path) { |
|
|
402 | $self->record_log; |
|
|
403 | |
|
|
404 | require JSON; |
|
|
405 | |
|
|
406 | open $self->{logfh}, ">:perlio", $path |
|
|
407 | or Carp::croak "$path: $!"; |
|
|
408 | |
|
|
409 | $self->log (start => $VERSION, 0, 0, { interval => $self->{interval} }); |
|
|
410 | } elsif ($self->{logfh}) { |
|
|
411 | $self->log ("stop"); |
|
|
412 | delete $self->{logfh}; |
|
|
413 | } |
|
|
414 | } |
|
|
415 | |
|
|
416 | =item $gps->replay_log ($path, %options) |
|
|
417 | |
|
|
418 | Replays a log file written using C<record_log> (or stops replaying when |
|
|
419 | C<$path> is undefined). While the log file replays, real GPS events will |
|
|
420 | be ignored. This comes in handy when testing. |
|
|
421 | |
|
|
422 | Please note that replaying a log will change configuration options that |
|
|
423 | will not be restored, so it's best not to reuse a gpsd object after a |
|
|
424 | replay. |
|
|
425 | |
|
|
426 | The options include: |
|
|
427 | |
|
|
428 | =over 4 |
|
|
429 | |
|
|
430 | =item compress => 1 |
|
|
431 | |
|
|
432 | If set to a true value (default: false), then passages without fix will be |
|
|
433 | replayed much faster than passages with fix. The same happens for passages |
|
|
434 | without much movement. |
|
|
435 | |
|
|
436 | =item stretch => $factor |
|
|
437 | |
|
|
438 | Multiplies all times by the given factor. Values < 1 make the log replay |
|
|
439 | faster, values > 1 slower. Note that the frequency of fixes will not be |
|
|
440 | increased, o stretch factors > 1 do not work well. |
|
|
441 | |
|
|
442 | A stretch factor of zero is not allowed, but if you want to replay a log |
|
|
443 | instantly you may speicfy a very low value (e.g. 1e-10). |
|
|
444 | |
|
|
445 | =back |
|
|
446 | |
|
|
447 | =cut |
|
|
448 | |
|
|
449 | sub replay_log { |
|
|
450 | my ($self, $path, %option) = @_; |
|
|
451 | |
|
|
452 | if (defined $path) { |
|
|
453 | $self->replay_log; |
|
|
454 | |
|
|
455 | require JSON; |
|
|
456 | |
|
|
457 | open my $fh, "<:perlio", $path |
|
|
458 | or Carp::croak "$path: $!"; |
|
|
459 | |
|
|
460 | $self->{stretch} = $option{stretch} || 1; |
|
|
461 | $self->{compress} = $option{compress}; |
|
|
462 | |
|
|
463 | $self->{imterval} /= $self->{stretch}; |
|
|
464 | |
|
|
465 | Scalar::Util::weaken $self; |
|
|
466 | |
|
|
467 | $self->{replay_cb} = sub { |
|
|
468 | my $line = <$fh>; |
|
|
469 | |
|
|
470 | if (2 > length $line) { |
|
|
471 | $self->replay_log; |
|
|
472 | } else { |
|
|
473 | my ($time, $type, @data) = @{ JSON::decode_json ($line) }; |
|
|
474 | |
|
|
475 | $time *= $self->{stretch}; |
|
|
476 | |
|
|
477 | if ($type eq "start") { |
|
|
478 | my ($module_version, $major_version, $minor_version, $args) = @data; |
|
|
479 | |
|
|
480 | $self->{interval} = ($args->{interval} || 1) / $self->{stretch}; |
|
|
481 | } |
|
|
482 | |
|
|
483 | if ( |
|
|
484 | $type eq "start" |
|
|
485 | or ($self->{compress} |
|
|
486 | and $self->{fix} && ($self->{fix}{mode} < 2 || $self->{fix}{speed} < 5)) |
|
|
487 | ) { |
|
|
488 | $self->{replay_now} = $time; |
|
|
489 | } |
|
|
490 | |
|
|
491 | $self->{replay_timer} = AnyEvent->timer (after => $time - $self->{replay_now}, cb => sub { |
|
|
492 | $self->{replay_now} = $time; |
|
|
493 | $self->{command} = []; # no can do |
|
|
494 | $self->feed ($data[0]) if $type eq "raw"; |
|
|
495 | $self->{replay_cb}(); |
|
|
496 | }); |
|
|
497 | } |
|
|
498 | }; |
|
|
499 | |
|
|
500 | $self->{replay_cb}(); |
|
|
501 | |
|
|
502 | } else { |
|
|
503 | delete $self->{stretch}; |
|
|
504 | delete $self->{compress}; |
|
|
505 | delete $self->{replay_timer}; |
|
|
506 | delete $self->{replay_cb}; |
|
|
507 | } |
|
|
508 | } |
|
|
509 | |
350 | =back |
510 | =back |
351 | |
511 | |
352 | =head1 SEE ALSO |
512 | =head1 SEE ALSO |
353 | |
513 | |
354 | L<AnyEvent>. |
514 | L<AnyEvent>. |