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 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.

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} > $fix->{serr}) {
      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 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. =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} < 5))
            ) {
               $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.5
Committed:	Fri Jul 25 13:22:18 2008 UTC (15 years, 9 months ago) by root
Branch:	MAIN
Changes since 1.4:	+133 -7 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			=item on_error => $cb->($gps)
63
64			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
66			are not interested in retries.
67
68			=item on_connect => $cb->($gps)
69
70			Nornormally used: Called on every successful connection establish.
71
72			=item on_response => $cb->($gps, $type, $data, $time)
73
74			Not normally used: Called on every response received from GPSD. C<$type>
75			is the single letter type and C<$data> is the data portion, if
76			any. C<$time> is the timestamp that this message was received at.
77
78			=item on_satellite_info => $cb->($gps, {satellite-info}...)
79
80			Called each time the satellite info changes, also on first connect. Each
81			C<satellite-info> hash contains at least the following members (mnemonic:
82			all keys have three letters):
83
84			C<prn> holds the satellite PRN (1..32 GPS, anything higher is
85			wASS/EGNOS/MCAS etc, see L<GPS::PRN>).
86
87			C<ele>, C<azi> contain the elevation (0..90) and azimuth (0..359) of the satellite.
88
89			C<snr> contains the signal strength in decibals (28+ is usually the
90			minimum value for a good fix).
91
92			C<fix> contains either C<1> to indicate that this satellite was used for
93	root	1.3	the last position fix, C<0> otherwise. EGNOS/WAAS etc. satellites will
94	root	1.1	always show as C<0>, even if their correction info was used.
95
96	root	1.3	The passed hash references are read-only.
97
98	root	1.1	=item on_fix => $cb->({point})
99
100	root	1.2	Called regularly (usually about once/second), even when there is no
101			connection to the GPSD (so is useful to update your idea of the current
102			position). The passed hash reference must I<not> be modified in any way.
103
104			If C<mode> is C<2> or C<3>, then the C<{point}> hash contains at least the
105			following members, otherwise it is undefined which members exist. Members
106			whose values are not known are C<undef> (usually the error values, speed
107			and so on).
108	root	1.1
109			time when this fix was received (s)
110
111			lat latitude (S -90..90 N)
112			lon longitude (W -180..180 E)
113			alt altitude
114
115			herr estimated horizontal error (m)
116			verr estimated vertical error (m)
117
118			bearing bearing over ground (0..360)
119			berr estimated error in bearing (degrees)
120			speed speed over ground (m/s)
121			serr estimated error in speed over ground (m/s)
122			vspeed vertical velocity, positive = upwards (m/s)
123			vserr estimated error in vspeed (m/s)
124
125			mode 1 = no fix, 2 = 2d fix, 3 = 3d fix
126
127			=back
128
129			=cut
130
131			sub new {
132			my $class = shift;
133			my $self = bless {
134			@_,
135	root	1.2	interval => 1,
136			fix => { time => AnyEvent->now, mode => 1 },
137	root	1.1	}, $class;
138
139	root	1.2	$self->interval_timer;
140	root	1.1	$self->connect;
141
142			$self
143			}
144
145	root	1.5	sub DESTROY {
146			my ($self) = @_;
147
148			$self->record_log;
149			}
150
151	root	1.1	sub event {
152			my $event = splice @_, 1, 1, ();
153
154	root	1.5	#warn "event<$event,@_>\n";#d#
155	root	1.1	if ($event = $_[0]{"on_$event"}) {
156			&$event;
157			}
158			}
159
160			sub retry {
161			my ($self) = @_;
162
163			delete $self->{fh};
164	root	1.4	delete $self->{command};
165	root	1.1
166			Scalar::Util::weaken $self;
167			$self->{retry_w} = AnyEvent->timer (after => 1, cb => sub {
168			delete $self->{retry_w};
169			$self->connect;
170			});
171			}
172
173	root	1.2	# make sure we send "no fix" updates when we lose connectivity
174			sub interval_timer {
175			my ($self) = @_;
176
177			$self->{interval_w} = AnyEvent->timer (after => $self->{interval}, cb => sub {
178			if (AnyEvent->now - $self->{fix}{time} > $self->{interval} * 1.9) {
179			$self->{fix}{mode} = 1;
180			$self->event (fix => $self->{fix});
181			}
182
183			$self->interval_timer;
184			});
185
186			Scalar::Util::weaken $self;
187			}
188
189	root	1.1	sub connect {
190			my ($self) = @_;
191
192			return if $self->{fh};
193
194			AnyEvent::Socket::tcp_connect $self->{host} \|\| "localhost", $self->{port} \|\| 2947, sub {
195			my ($fh) = @_;
196
197			return unless $self;
198
199			if ($fh) {
200			# unbelievable, but true: gpsd does not support command pipelining.
201			# it's an immensely shitty piece of software, actually, as it blocks
202			# randomly and for extended periods of time, has a surprisingly broken
203			# and non-configurable baud autoconfiguration system (it does stuff
204			# like switching to read-only mode when my bluetooth gps mouse temporarily
205			# loses the connection etc.) and uses rather idiotic and wasteful
206			# programming methods.
207
208			$self->{fh} = new AnyEvent::Handle
209			fh => $fh,
210			low_delay => 1,
211			on_error => sub {
212			$self->event ("error");
213			$self->retry;
214			},
215			on_eof => sub {
216	root	1.2	$! = &Errno::EPIPE;
217	root	1.1	$self->event ("error");
218	root	1.4	$self->log ("disconnect");
219	root	1.1	$self->retry;
220			},
221			on_read => sub {
222			$_[0]{rbuf} =~ s/^([^\015\012]*)\015\012//
223			or return;
224
225	root	1.5	$self->feed ($1)
226			unless $self->{replay_cb};
227	root	1.1	},
228			;
229
230			$self->send ("w");
231			$self->send ("o");
232			$self->send ("y");
233	root	1.2	$self->send ("c");
234	root	1.1
235			$self->event ("connect");
236	root	1.4	$self->log ("connect");
237	root	1.1	} else {
238			$self->event ("error");
239			}
240			};
241
242			Scalar::Util::weaken $self;
243			}
244
245			sub drain_wbuf {
246			my ($self) = @_;
247
248			$self->{fh}->push_write (join "", @{ $self->{command}[0] });
249			}
250
251			sub send {
252			my ($self, $command, $args) = @_;
253
254			# curse them, we simply expect that each comamnd will result in a response using
255			# the same letter
256
257			push @{ $self->{command} }, [uc $command, $args];
258			$self->drain_wbuf if @{ $self->{command} } == 1;
259			}
260
261			sub feed {
262			my ($self, $line) = @_;
263
264			$self->{now} = AnyEvent->now;
265
266	root	1.4	$self->log (raw => $line)
267			if $self->{logfh};
268
269	root	1.1	unless ($line =~ /^GPSD,(.)=(.*)$/) {
270			$! = &Errno::EBADMSG;
271			$self->event ("error");
272			return $self->retry;
273			}
274
275			my ($type, $data) = ($1, $2);
276
277	root	1.4	#warn "$type=$data\n";#d#
278
279	root	1.1	$self->{state}{$type} = [$data => $self->{now}];
280
281			if ($type eq "O") {
282			my @data = split /\s+/, $data;
283	root	1.2
284			my $fix = $self->{fix};
285
286			$fix->{time} = $self->{now};
287	root	1.1
288			if (@data > 3) {
289			# the gpsd time is virtually useless as it is truncated :/
290	root	1.2	for (qw(tag _time _terr lat lon alt herr verr bearing speed vspeed berr serr vserr mode)) {
291			$type = shift @data;
292			$fix->{$_} = $type eq "?" ? undef : $type;
293			}
294	root	1.1
295	root	1.5	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;
306			}
307
308	root	1.2	$fix->{mode} = 2 if $fix->{mode} eq "?"; # arbitrary choice
309	root	1.1	} else {
310	root	1.2	$fix->{mode} = 1;
311	root	1.1	}
312
313	root	1.2	$self->event (fix => $fix);
314	root	1.1
315			} elsif ($type eq "Y") {
316			my (undef, @sats) = split /:/, $data;
317
318			$self->{satellite_info} = [map {
319			my @sat = split /\s+/;
320			{
321			prn => $sat[0],
322			ele => $sat[1],
323			azi => $sat[2],
324			snr => $sat[3],
325			fix => $sat[4],
326			}
327			} @sats];
328
329			$self->event (satellite_update => $self->{satellite_info});
330	root	1.2
331			} elsif ($type eq "C") {
332			$self->{interval} = $data >= 1 ? $data * 1 : 1;
333	root	1.1	}
334
335			# we (wrongly) assume that gpsd responses are always in response
336			# to an earlier command
337
338			if (@{ $self->{command} } && $self->{command}[0][0] eq $type) {
339			shift @{ $self->{command} };
340			$self->drain_wbuf if @{ $self->{command} };
341			}
342			}
343
344			=item ($lat, $lon) = $gps->estimate ([$max_seconds])
345
346			This returns an estimate of the current position based on the last fix and
347			the time passed since then. Useful for interactive applications where you
348			want more frequent updates, but not very useful to store, as the next fix
349			might well be totally off.
350
351	root	1.3	If the fix is older then C<$max_seconds> (default: C<1.9> times the update
352			interval, i.e. usually C<1.9> seconds) or if no fix is available, returns
353			the empty list.
354	root	1.1
355			=cut
356
357			sub estimate {
358			my ($self, $max) = @_;
359
360	root	1.3	$max \|\|= 1.9 * $self->{interval} unless defined $max;
361	root	1.1
362			my $geo = $self->{geo_forward} \|\|= new Geo::Forward;
363
364			my $fix = $self->{fix} or return;
365			$fix->{mode} >= 2 or return;
366
367			my $diff = AnyEvent->time - $fix->{time};
368
369			$diff <= $max or return;
370
371			if ($fix->{speed} > $fix->{serr}) {
372			my ($lat, $lon) = $geo->forward ($fix->{lat}, $fix->{lon}, $fix->{bearing}, $fix->{speed} * $diff);
373			($lat, $lon)
374
375			} else {
376			# if we likely have zero speed, return the point itself
377			($fix->{lat}, $fix->{lon})
378			}
379			}
380
381	root	1.4	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	root	1.5	=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	root	1.4	sub record_log {
399	root	1.5	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	root	1.4
428	root	1.5	=over 4
429	root	1.4
430	root	1.5	=item compress => 1
431	root	1.4
432	root	1.5	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. =back
441
442			=cut
443
444			sub replay_log {
445			my ($self, $path, %option) = @_;
446
447			if (defined $path) {
448			$self->replay_log;
449
450			require JSON;
451
452			open my $fh, "<:perlio", $path
453			or Carp::croak "$path: $!";
454
455			$self->{stretch} = $option{stretch} \|\| 1;
456			$self->{compress} = $option{compress};
457
458			$self->{imterval} /= $self->{stretch};
459
460			Scalar::Util::weaken $self;
461
462			$self->{replay_cb} = sub {
463			my $line = <$fh>;
464
465			if (2 > length $line) {
466			$self->replay_log;
467			} else {
468			my ($time, $type, @data) = @{ JSON::decode_json ($line) };
469
470			$time *= $self->{stretch};
471
472			if ($type eq "start") {
473			my ($module_version, $major_version, $minor_version, $args) = @data;
474
475			$self->{interval} = ($args->{interval} \|\| 1) / $self->{stretch};
476			}
477
478			if (
479			$type eq "start"
480			or ($self->{compress}
481			and $self->{fix} && ($self->{fix}{mode} < 2 \|\| $self->{fix}{speed} < 5))
482			) {
483			$self->{replay_now} = $time;
484			}
485
486			$self->{replay_timer} = AnyEvent->timer (after => $time - $self->{replay_now}, cb => sub {
487			$self->{replay_now} = $time;
488			$self->{command} = []; # no can do
489			$self->feed ($data[0]) if $type eq "raw";
490			$self->{replay_cb}();
491			});
492			}
493			};
494
495			$self->{replay_cb}();
496
497			} else {
498			delete $self->{stretch};
499			delete $self->{compress};
500			delete $self->{replay_timer};
501			delete $self->{replay_cb};
502			}
503	root	1.4	}
504
505	root	1.1	=back
506
507			=head1 SEE ALSO
508
509			L<AnyEvent>.
510
511			=head1 AUTHOR
512
513			Marc Lehmann <schmorp@schmorp.de>
514			http://home.schmorp.de/
515
516			=cut
517
518			1
519