--- AnyEvent-GPSD/GPSD.pm 2008/07/02 04:57:02 1.1 +++ AnyEvent-GPSD/GPSD.pm 2008/07/26 05:34:58 1.7 @@ -59,6 +59,12 @@ The port to connect to, default is C<2947>. +=item min_speed => $speed_in_m_per_s + +Sets the mininum speed (default: 0) that is considered real for the +purposes of replay compression or estimate. Speeds below this value will +be considered 0. + =item on_error => $cb->($gps) Called on every connection or protocol failure, reason is in C<$!> @@ -90,13 +96,21 @@ minimum value for a good fix). C contains either C<1> to indicate that this satellite was used for -the last position fix, C<0> otherwise. EGNOS/WAAS etc. satellites will +the last position fix, C<0> otherwise. EGNOS/WAAS etc. satellites will always show as C<0>, even if their correction info was used. +The passed hash references are read-only. + =item on_fix => $cb->({point}) -Called regularly. The C<{point}> hash contains at least the following -members: +Called regularly (usually about once/second), even when there is no +connection to the GPSD (so is useful to update your idea of the current +position). The passed hash reference must I be modified in any way. + +If C is C<2> or C<3>, then the C<{point}> hash contains at least the +following members, otherwise it is undefined which members exist. Members +whose values are not known are C (usually the error values, speed +and so on). time when this fix was received (s) @@ -124,17 +138,26 @@ my $class = shift; my $self = bless { @_, + interval => 1, + fix => { time => AnyEvent->now, mode => 1 }, }, $class; + $self->interval_timer; $self->connect; $self } +sub DESTROY { + my ($self) = @_; + + $self->record_log; +} + sub event { my $event = splice @_, 1, 1, (); - warn "event<$event,@_>\n";#d# + #warn "event<$event,@_>\n";#d# if ($event = $_[0]{"on_$event"}) { &$event; } @@ -144,6 +167,7 @@ my ($self) = @_; delete $self->{fh}; + delete $self->{command}; Scalar::Util::weaken $self; $self->{retry_w} = AnyEvent->timer (after => 1, cb => sub { @@ -152,6 +176,22 @@ }); } +# make sure we send "no fix" updates when we lose connectivity +sub interval_timer { + my ($self) = @_; + + $self->{interval_w} = AnyEvent->timer (after => $self->{interval}, cb => sub { + if (AnyEvent->now - $self->{fix}{time} > $self->{interval} * 1.9) { + $self->{fix}{mode} = 1; + $self->event (fix => $self->{fix}); + } + + $self->interval_timer; + }); + + Scalar::Util::weaken $self; +} + sub connect { my ($self) = @_; @@ -179,23 +219,27 @@ $self->retry; }, on_eof => sub { - $! = &Errno::EBADMSG; + $! = &Errno::EPIPE; $self->event ("error"); + $self->log ("disconnect"); $self->retry; }, on_read => sub { $_[0]{rbuf} =~ s/^([^\015\012]*)\015\012// or return; - $self->feed ($1); + $self->feed ($1) + unless $self->{replay_cb}; }, ; $self->send ("w"); $self->send ("o"); $self->send ("y"); + $self->send ("c"); $self->event ("connect"); + $self->log ("connect"); } else { $self->event ("error"); } @@ -225,6 +269,9 @@ $self->{now} = AnyEvent->now; + $self->log (raw => $line) + if $self->{logfh}; + unless ($line =~ /^GPSD,(.)=(.*)$/) { $! = &Errno::EBADMSG; $self->event ("error"); @@ -233,23 +280,43 @@ my ($type, $data) = ($1, $2); + #warn "$type=$data\n";#d# + $self->{state}{$type} = [$data => $self->{now}]; if ($type eq "O") { my @data = split /\s+/, $data; - my %fix = (time => $self->{now}); + + my $fix = $self->{fix}; + + $fix->{time} = $self->{now}; if (@data > 3) { # the gpsd time is virtually useless as it is truncated :/ - $fix{$_} = shift @data for qw(tag _time _terr lat lon alt herr verr bearing speed vspeed berr serr vserr mode); + for (qw(tag _time _terr lat lon alt herr verr bearing speed vspeed berr serr vserr mode)) { + $type = shift @data; + $fix->{$_} = $type eq "?" ? undef : $type; + } + + if (my $s = $self->{stretch}) { + $s = 1 / $s; + + $fix->{herr} *= $s; # ? + $fix->{verr} *= $s; # ? + $fix->{berr} *= $s; # ? + $fix->{serr} *= $s; # ? + $fix->{vserr} *= $s; # ? + + $fix->{speed} *= $s; + $fix->{vspeed} *= $s; + } - $fix{mode} = 2 if $fix{mode} eq "?"; # arbitrary choice + $fix->{mode} = 2 if $fix->{mode} eq "?"; # arbitrary choice } else { - $fix{mode} = 1; + $fix->{mode} = 1; } - $self->{fix} = \%fix; - $self->event (fix => \%fix); + $self->event (fix => $fix); } elsif ($type eq "Y") { my (undef, @sats) = split /:/, $data; @@ -266,6 +333,9 @@ } @sats]; $self->event (satellite_update => $self->{satellite_info}); + + } elsif ($type eq "C") { + $self->{interval} = $data >= 1 ? $data * 1 : 1; } # we (wrongly) assume that gpsd responses are always in response @@ -280,19 +350,24 @@ =item ($lat, $lon) = $gps->estimate ([$max_seconds]) This returns an estimate of the current position based on the last fix and -the time passed since then. Useful for interactive applications where you -want more frequent updates, but not very useful to store, as the next fix -might well be totally off. +the time passed since then. -If the fix is older then C<$max_seconds> (default: C<1.9>) or if no fix is -available, returns the empty list. +Useful for interactive applications where you want more frequent updates, +but not very useful to store, as the next fix might well be totally +off. For example, when displaying a real-time map, you could simply call +C ten times a second and update the cursor or map position, but +you should use C to actually gather data to plot the course itself. + +If the fix is older then C<$max_seconds> (default: C<1.9> times the update +interval, i.e. usually C<1.9> seconds) or if no fix is available, returns +the empty list. =cut sub estimate { my ($self, $max) = @_; - $max ||= 1.9 unless defined $max; + $max ||= 1.9 * $self->{interval} unless defined $max; my $geo = $self->{geo_forward} ||= new Geo::Forward; @@ -303,7 +378,7 @@ $diff <= $max or return; - if ($fix->{speed} > $fix->{serr}) { + if ($fix->{speed} >= $self->{min_speed}) { my ($lat, $lon) = $geo->forward ($fix->{lat}, $fix->{lon}, $fix->{bearing}, $fix->{speed} * $diff); ($lat, $lon) @@ -313,6 +388,139 @@ } } +sub log { + my ($self, @arg) = @_; + + syswrite $self->{logfh}, JSON::encode_json ([AnyEvent->time, @arg]) . "\n" + if $self->{logfh}; +} + +=item $gps->record_log ($path) + +If C<$path> is defined, then that file will be created or truncated and a +log of all (raw) packets received will be written to it. This log file can +later be replayed by calling C<< $gps->replay_log ($path) >>. + +If C<$path> is undefined then the log will be closed. + +=cut + +sub record_log { + my ($self, $path) = @_; + + if (defined $path) { + $self->record_log; + + require JSON; + + open $self->{logfh}, ">:perlio", $path + or Carp::croak "$path: $!"; + + $self->log (start => $VERSION, 0, 0, { interval => $self->{interval} }); + } elsif ($self->{logfh}) { + $self->log ("stop"); + delete $self->{logfh}; + } +} + +=item $gps->replay_log ($path, %options) + +Replays a log file written using C (or stops replaying when +C<$path> is undefined). While the log file replays, real GPS events will +be ignored. This comes in handy when testing. + +Please note that replaying a log will change configuration options that +will not be restored, so it's best not to reuse a gpsd object after a +replay. + +The C distribution comes with an example log +(F) that you can replay for testing or enjoyment +purposes. + +The options include: + +=over 4 + +=item compress => 1 + +If set to a true value (default: false), then passages without fix will be +replayed much faster than passages with fix. The same happens for passages +without much movement. + +=item stretch => $factor + +Multiplies all times by the given factor. Values < 1 make the log replay +faster, values > 1 slower. Note that the frequency of fixes will not be +increased, o stretch factors > 1 do not work well. + +A stretch factor of zero is not allowed, but if you want to replay a log +instantly you may speicfy a very low value (e.g. 1e-10). + +=back + +=cut + +sub replay_log { + my ($self, $path, %option) = @_; + + if (defined $path) { + $self->replay_log; + + require JSON; + + open my $fh, "<:perlio", $path + or Carp::croak "$path: $!"; + + $self->{stretch} = $option{stretch} || 1; + $self->{compress} = $option{compress}; + + $self->{imterval} /= $self->{stretch}; + + Scalar::Util::weaken $self; + + $self->{replay_cb} = sub { + my $line = <$fh>; + + if (2 > length $line) { + $self->replay_log; + } else { + my ($time, $type, @data) = @{ JSON::decode_json ($line) }; + + $time *= $self->{stretch}; + + if ($type eq "start") { + my ($module_version, $major_version, $minor_version, $args) = @data; + + $self->{interval} = ($args->{interval} || 1) / $self->{stretch}; + } + + if ( + $type eq "start" + or ($self->{compress} + and $self->{fix} && ($self->{fix}{mode} < 2 || $self->{fix}{speed} < $self->{min_speed})) + ) { + $self->{replay_now} = $time; + } + + $self->{replay_timer} = AnyEvent->timer (after => $time - $self->{replay_now}, cb => sub { + $self->{replay_now} = $time; + $self->{command} = []; # no can do + $self->feed ($data[0]) if $type eq "raw"; + $self->{replay_cb}(); + }); + } + }; + + $self->{replay_cb}(); + + } else { + delete $self->{stretch}; + delete $self->{compress}; + delete $self->{replay_timer}; + delete $self->{replay_cb}; + } +} + =back =head1 SEE ALSO