AnyEvent-GPSD/GPSD.pm

=head1 NAME

AnyEvent::GPSD - event based interface to GPSD

=head1 SYNOPSIS

   use AnyEvent::GPSD;

=head1 DESCRIPTION

This module is an L<AnyEvent> user, you need to make sure that you use and
run a supported event loop.

This module implements an interface to GPSD (http://gpsd.berlios.de/).

You need to consult the GPSD protocol desription in the manpage to make
better sense of this module.

=head2 METHODS

=over 4

=cut

package AnyEvent::GPSD;

use strict;
no warnings;

use Carp ();
use Errno ();
use Scalar::Util ();
use Geo::Forward ();

use AnyEvent ();
use AnyEvent::Util ();
use AnyEvent::Socket ();
use AnyEvent::Handle ();

our $VERSION = '1.0';

=item $gps = new AnyEvent::GPSD [key => value...]

Creates a (virtual) connection to the GPSD. If the C<"hostname:port">
argument is missing then C<localhost:2947> will be used.

If the connection cannot be established, then it will retry every
second. Otherwise, the connection is put into watcher mode.

You can specify various configuration parameters, most of them callbacks:

=over 4

=item host => $hostname

The host to connect to, default is C<locahost>.

=item port => $port

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<$!>
(protocl errors are signalled via EBADMSG). Can be used to bail out if you
are not interested in retries.

=item on_connect => $cb->($gps)

Nornormally used: Called on every successful connection establish.

=item on_response => $cb->($gps, $type, $data, $time)

Not normally used: Called on every response received from GPSD. C<$type>
is the single letter type and C<$data> is the data portion, if
any. C<$time> is the timestamp that this message was received at.

=item on_satellite_info => $cb->($gps, {satellite-info}...)

Called each time the satellite info changes, also on first connect. Each
C<satellite-info> hash contains at least the following members (mnemonic:
all keys have three letters):

C<prn> holds the satellite PRN (1..32 GPS, anything higher is
wASS/EGNOS/MCAS etc, see L<GPS::PRN>).

C<ele>, C<azi> contain the elevation (0..90) and azimuth (0..359) of the satellite.

C<snr> contains the signal strength in decibals (28+ is usually the
minimum value for a good fix).

C<fix> contains either C<1> to indicate that this satellite was used for
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 (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<not> be modified in any way.

If C<mode> 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<undef> (usually the error values, speed
and so on).

   time         when this fix was received (s)

   lat          latitude (S -90..90 N)
   lon          longitude (W -180..180 E)
   alt          altitude

   herr         estimated horizontal error (m)
   verr         estimated vertical error (m)

   bearing      bearing over ground (0..360)
   berr         estimated error in bearing (degrees)
   speed        speed over ground (m/s)
   serr         estimated error in speed over ground (m/s)
   vspeed       vertical velocity, positive = upwards (m/s)
   vserr        estimated error in vspeed (m/s)

   mode         1 = no fix, 2 = 2d fix, 3 = 3d fix

=back

=cut

sub new {
   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#
   if ($event = $_[0]{"on_$event"}) {
      &$event;
   }
}

sub retry {
   my ($self) = @_;

   delete $self->{fh};
   delete $self->{command};

   Scalar::Util::weaken $self;
   $self->{retry_w} = AnyEvent->timer (after => 1, cb => sub {
      delete $self->{retry_w};
      $self->connect;
   });
}

# 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) = @_;

   return if $self->{fh};

   AnyEvent::Socket::tcp_connect $self->{host} || "localhost", $self->{port} || 2947, sub {
      my ($fh) = @_;

      return unless $self;

      if ($fh) {
         # unbelievable, but true: gpsd does not support command pipelining.
         # it's an immensely shitty piece of software, actually, as it blocks
         # randomly and for extended periods of time, has a surprisingly broken
         # and non-configurable baud autoconfiguration system (it does stuff
         # like switching to read-only mode when my bluetooth gps mouse temporarily
         # loses the connection etc.) and uses rather idiotic and wasteful
         # programming methods.

         $self->{fh} = new AnyEvent::Handle
            fh        => $fh,
            low_delay => 1,
            on_error  => sub {
               $self->event ("error");
               $self->retry;
            },
            on_eof    => sub {
               $! = &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)
                  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");
      }
   };

   Scalar::Util::weaken $self;
}

sub drain_wbuf {
   my ($self) = @_;

   $self->{fh}->push_write (join "", @{ $self->{command}[0] });
}

sub send {
   my ($self, $command, $args) = @_;

   # curse them, we simply expect that each comamnd will result in a response using
   # the same letter

   push @{ $self->{command} }, [uc $command, $args];
   $self->drain_wbuf if @{ $self->{command} } == 1;
}

sub feed {
   my ($self, $line) = @_;

   $self->{now} = AnyEvent->now;

   $self->log (raw => $line)
      if $self->{logfh};

   unless ($line =~ /^GPSD,(.)=(.*)$/) {
      $! = &Errno::EBADMSG;
      $self->event ("error");
      return $self->retry;
   }

   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 = $self->{fix};

      $fix->{time} = $self->{now};

      if (@data > 3) {
         # the gpsd time is virtually useless as it is truncated :/
         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
      } else {
         $fix->{mode} = 1;
      }

      $self->event (fix => $fix);

   } elsif ($type eq "Y") {
      my (undef, @sats) = split /:/, $data;
      
      $self->{satellite_info} = [map {
         my @sat = split /\s+/;
         {
            prn => $sat[0],
            ele => $sat[1],
            azi => $sat[2],
            snr => $sat[3],
            fix => $sat[4],
         }
      } @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
   # to an earlier command

   if (@{ $self->{command} } && $self->{command}[0][0] eq $type) {
      shift @{ $self->{command} };
      $self->drain_wbuf if @{ $self->{command} };
   }
}

=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. For example, when displaying a real-time map, you could simply call
C<estimate> ten times a second and update the cursor or map position, but
you should use C<on_fix> 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 * $self->{interval} unless defined $max;

   my $geo = $self->{geo_forward} ||= new Geo::Forward;

   my $fix = $self->{fix} or return;
   $fix->{mode} >= 2 or return;

   my $diff = AnyEvent->time - $fix->{time};

   $diff <= $max or return;

   if ($fix->{speed} >= $self->{min_speed}) {
      my ($lat, $lon) = $geo->forward ($fix->{lat}, $fix->{lon}, $fix->{bearing}, $fix->{speed} * $diff);
      ($lat, $lon)

   } else {
      # if we likely have zero speed, return the point itself
      ($fix->{lat}, $fix->{lon})
   }
}

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<record_log> (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<AnyEvent::GPSD> distribution comes with an example log
(F<eg/example.aegps>) 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

L<AnyEvent>.

=head1 AUTHOR

   Marc Lehmann <schmorp@schmorp.de>
   http://home.schmorp.de/

=cut

1

Revision:	1.7
Committed:	Sat Jul 26 05:34:58 2008 UTC (15 years, 9 months ago) by root
Branch:	MAIN
CVS Tags:	rel-1_0, HEAD
Changes since 1.6:	+19 -5 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3			AnyEvent::GPSD - event based interface to GPSD
4
5			=head1 SYNOPSIS
6
7			use AnyEvent::GPSD;
8
9			=head1 DESCRIPTION
10
11			This module is an L<AnyEvent> user, you need to make sure that you use and
12			run a supported event loop.
13
14			This module implements an interface to GPSD (http://gpsd.berlios.de/).
15
16			You need to consult the GPSD protocol desription in the manpage to make
17			better sense of this module.
18
19			=head2 METHODS
20
21			=over 4
22
23			=cut
24
25			package AnyEvent::GPSD;
26
27			use strict;
28			no warnings;
29
30			use Carp ();
31			use Errno ();
32			use Scalar::Util ();
33			use Geo::Forward ();
34
35			use AnyEvent ();
36			use AnyEvent::Util ();
37			use AnyEvent::Socket ();
38			use AnyEvent::Handle ();
39
40			our $VERSION = '1.0';
41
42			=item $gps = new AnyEvent::GPSD [key => value...]
43
44			Creates a (virtual) connection to the GPSD. If the C<"hostname:port">
45			argument is missing then C<localhost:2947> will be used.
46
47			If the connection cannot be established, then it will retry every
48			second. Otherwise, the connection is put into watcher mode.
49
50			You can specify various configuration parameters, most of them callbacks:
51
52			=over 4
53
54			=item host => $hostname
55
56			The host to connect to, default is C<locahost>.
57
58			=item port => $port
59
60			The port to connect to, default is C<2947>.
61
62	root	1.7	=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
68	root	1.1	=item on_error => $cb->($gps)
69
70			Called on every connection or protocol failure, reason is in C<$!>
71			(protocl errors are signalled via EBADMSG). Can be used to bail out if you
72			are not interested in retries.
73
74			=item on_connect => $cb->($gps)
75
76			Nornormally used: Called on every successful connection establish.
77
78			=item on_response => $cb->($gps, $type, $data, $time)
79
80			Not normally used: Called on every response received from GPSD. C<$type>
81			is the single letter type and C<$data> is the data portion, if
82			any. C<$time> is the timestamp that this message was received at.
83
84			=item on_satellite_info => $cb->($gps, {satellite-info}...)
85
86			Called each time the satellite info changes, also on first connect. Each
87			C<satellite-info> hash contains at least the following members (mnemonic:
88			all keys have three letters):
89
90			C<prn> holds the satellite PRN (1..32 GPS, anything higher is
91			wASS/EGNOS/MCAS etc, see L<GPS::PRN>).
92
93			C<ele>, C<azi> contain the elevation (0..90) and azimuth (0..359) of the satellite.
94
95			C<snr> contains the signal strength in decibals (28+ is usually the
96			minimum value for a good fix).
97
98			C<fix> contains either C<1> to indicate that this satellite was used for
99	root	1.3	the last position fix, C<0> otherwise. EGNOS/WAAS etc. satellites will
100	root	1.1	always show as C<0>, even if their correction info was used.
101
102	root	1.3	The passed hash references are read-only.
103
104	root	1.1	=item on_fix => $cb->({point})
105
106	root	1.2	Called regularly (usually about once/second), even when there is no
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).
114	root	1.1
115			time when this fix was received (s)
116
117			lat latitude (S -90..90 N)
118			lon longitude (W -180..180 E)
119			alt altitude
120
121			herr estimated horizontal error (m)
122			verr estimated vertical error (m)
123
124			bearing bearing over ground (0..360)
125			berr estimated error in bearing (degrees)
126			speed speed over ground (m/s)
127			serr estimated error in speed over ground (m/s)
128			vspeed vertical velocity, positive = upwards (m/s)
129			vserr estimated error in vspeed (m/s)
130
131			mode 1 = no fix, 2 = 2d fix, 3 = 3d fix
132
133			=back
134
135			=cut
136
137			sub new {
138			my $class = shift;
139			my $self = bless {
140			@_,
141	root	1.2	interval => 1,
142			fix => { time => AnyEvent->now, mode => 1 },
143	root	1.1	}, $class;
144
145	root	1.2	$self->interval_timer;
146	root	1.1	$self->connect;
147
148			$self
149			}
150
151	root	1.5	sub DESTROY {
152			my ($self) = @_;
153
154			$self->record_log;
155			}
156
157	root	1.1	sub event {
158			my $event = splice @_, 1, 1, ();
159
160	root	1.5	#warn "event<$event,@_>\n";#d#
161	root	1.1	if ($event = $_[0]{"on_$event"}) {
162			&$event;
163			}
164			}
165
166			sub retry {
167			my ($self) = @_;
168
169			delete $self->{fh};
170	root	1.4	delete $self->{command};
171	root	1.1
172			Scalar::Util::weaken $self;
173			$self->{retry_w} = AnyEvent->timer (after => 1, cb => sub {
174			delete $self->{retry_w};
175			$self->connect;
176			});
177			}
178
179	root	1.2	# 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;
193			}
194
195	root	1.1	sub connect {
196			my ($self) = @_;
197
198			return if $self->{fh};
199
200			AnyEvent::Socket::tcp_connect $self->{host} \|\| "localhost", $self->{port} \|\| 2947, sub {
201			my ($fh) = @_;
202
203			return unless $self;
204
205			if ($fh) {
206			# unbelievable, but true: gpsd does not support command pipelining.
207			# it's an immensely shitty piece of software, actually, as it blocks
208			# randomly and for extended periods of time, has a surprisingly broken
209			# and non-configurable baud autoconfiguration system (it does stuff
210			# like switching to read-only mode when my bluetooth gps mouse temporarily
211			# loses the connection etc.) and uses rather idiotic and wasteful
212			# programming methods.
213
214			$self->{fh} = new AnyEvent::Handle
215			fh => $fh,
216			low_delay => 1,
217			on_error => sub {
218			$self->event ("error");
219			$self->retry;
220			},
221			on_eof => sub {
222	root	1.2	$! = &Errno::EPIPE;
223	root	1.1	$self->event ("error");
224	root	1.4	$self->log ("disconnect");
225	root	1.1	$self->retry;
226			},
227			on_read => sub {
228			$_[0]{rbuf} =~ s/^([^\015\012]*)\015\012//
229			or return;
230
231	root	1.5	$self->feed ($1)
232			unless $self->{replay_cb};
233	root	1.1	},
234			;
235
236			$self->send ("w");
237			$self->send ("o");
238			$self->send ("y");
239	root	1.2	$self->send ("c");
240	root	1.1
241			$self->event ("connect");
242	root	1.4	$self->log ("connect");
243	root	1.1	} else {
244			$self->event ("error");
245			}
246			};
247
248			Scalar::Util::weaken $self;
249			}
250
251			sub drain_wbuf {
252			my ($self) = @_;
253
254			$self->{fh}->push_write (join "", @{ $self->{command}[0] });
255			}
256
257			sub send {
258			my ($self, $command, $args) = @_;
259
260			# curse them, we simply expect that each comamnd will result in a response using
261			# the same letter
262
263			push @{ $self->{command} }, [uc $command, $args];
264			$self->drain_wbuf if @{ $self->{command} } == 1;
265			}
266
267			sub feed {
268			my ($self, $line) = @_;
269
270			$self->{now} = AnyEvent->now;
271
272	root	1.4	$self->log (raw => $line)
273			if $self->{logfh};
274
275	root	1.1	unless ($line =~ /^GPSD,(.)=(.*)$/) {
276			$! = &Errno::EBADMSG;
277			$self->event ("error");
278			return $self->retry;
279			}
280
281			my ($type, $data) = ($1, $2);
282
283	root	1.4	#warn "$type=$data\n";#d#
284
285	root	1.1	$self->{state}{$type} = [$data => $self->{now}];
286
287			if ($type eq "O") {
288			my @data = split /\s+/, $data;
289	root	1.2
290			my $fix = $self->{fix};
291
292			$fix->{time} = $self->{now};
293	root	1.1
294			if (@data > 3) {
295			# the gpsd time is virtually useless as it is truncated :/
296	root	1.2	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			}
300	root	1.1
301	root	1.5	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
314	root	1.2	$fix->{mode} = 2 if $fix->{mode} eq "?"; # arbitrary choice
315	root	1.1	} else {
316	root	1.2	$fix->{mode} = 1;
317	root	1.1	}
318
319	root	1.2	$self->event (fix => $fix);
320	root	1.1
321			} elsif ($type eq "Y") {
322			my (undef, @sats) = split /:/, $data;
323
324			$self->{satellite_info} = [map {
325			my @sat = split /\s+/;
326			{
327			prn => $sat[0],
328			ele => $sat[1],
329			azi => $sat[2],
330			snr => $sat[3],
331			fix => $sat[4],
332			}
333			} @sats];
334
335			$self->event (satellite_update => $self->{satellite_info});
336	root	1.2
337			} elsif ($type eq "C") {
338			$self->{interval} = $data >= 1 ? $data * 1 : 1;
339	root	1.1	}
340
341			# we (wrongly) assume that gpsd responses are always in response
342			# to an earlier command
343
344			if (@{ $self->{command} } && $self->{command}[0][0] eq $type) {
345			shift @{ $self->{command} };
346			$self->drain_wbuf if @{ $self->{command} };
347			}
348			}
349
350			=item ($lat, $lon) = $gps->estimate ([$max_seconds])
351
352			This returns an estimate of the current position based on the last fix and
353	root	1.7	the time passed since then.
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	root	1.1
361	root	1.3	If the fix is older then C<$max_seconds> (default: C<1.9> times the update
362			interval, i.e. usually C<1.9> seconds) or if no fix is available, returns
363			the empty list.
364	root	1.1
365			=cut
366
367			sub estimate {
368			my ($self, $max) = @_;
369
370	root	1.3	$max \|\|= 1.9 * $self->{interval} unless defined $max;
371	root	1.1
372			my $geo = $self->{geo_forward} \|\|= new Geo::Forward;
373
374			my $fix = $self->{fix} or return;
375			$fix->{mode} >= 2 or return;
376
377			my $diff = AnyEvent->time - $fix->{time};
378
379			$diff <= $max or return;
380
381	root	1.7	if ($fix->{speed} >= $self->{min_speed}) {
382	root	1.1	my ($lat, $lon) = $geo->forward ($fix->{lat}, $fix->{lon}, $fix->{bearing}, $fix->{speed} * $diff);
383			($lat, $lon)
384
385			} else {
386			# if we likely have zero speed, return the point itself
387			($fix->{lat}, $fix->{lon})
388			}
389			}
390
391	root	1.4	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	root	1.5	=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	root	1.4	sub record_log {
409	root	1.5	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	root	1.7	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	root	1.5	The options include:
441	root	1.4
442	root	1.5	=over 4
443	root	1.4
444	root	1.5	=item compress => 1
445	root	1.4
446	root	1.5	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	root	1.6	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	root	1.5
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	root	1.7	and $self->{fix} && ($self->{fix}{mode} < 2 \|\| $self->{fix}{speed} < $self->{min_speed}))
501	root	1.5	) {
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	root	1.4	}
523
524	root	1.1	=back
525
526			=head1 SEE ALSO
527
528			L<AnyEvent>.
529
530			=head1 AUTHOR
531
532			Marc Lehmann <schmorp@schmorp.de>
533			http://home.schmorp.de/
534
535			=cut
536
537			1
538