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 event {
   my $event = splice @_, 1, 1, ();

   warn "event<$event,@_>\n";#d#
   if ($event = $_[0]{"on_$event"}) {
      &$event;
   }
}

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

   delete $self->{fh};

   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->retry;
            },
            on_read   => sub {
               $_[0]{rbuf} =~ s/^([^\015\012]*)\015\012//
                  or return;

               $self->feed ($1);
            },
         ;

         $self->send ("w");
         $self->send ("o");
         $self->send ("y");
         $self->send ("c");

         $self->event ("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;

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

   my ($type, $data) = ($1, $2);

   $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;
         }

         $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})
   }
}

=back

=head1 SEE ALSO

L<AnyEvent>.

=head1 AUTHOR

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

=cut

1

Revision:	1.3
Committed:	Wed Jul 2 05:21:58 2008 UTC (15 years, 10 months ago) by root
Branch:	MAIN
Changes since 1.2:	+7 -4 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			sub event {
146			my $event = splice @_, 1, 1, ();
147
148			warn "event<$event,@_>\n";#d#
149			if ($event = $_[0]{"on_$event"}) {
150			&$event;
151			}
152			}
153
154			sub retry {
155			my ($self) = @_;
156
157			delete $self->{fh};
158
159			Scalar::Util::weaken $self;
160			$self->{retry_w} = AnyEvent->timer (after => 1, cb => sub {
161			delete $self->{retry_w};
162			$self->connect;
163			});
164			}
165
166	root	1.2	# make sure we send "no fix" updates when we lose connectivity
167			sub interval_timer {
168			my ($self) = @_;
169
170			$self->{interval_w} = AnyEvent->timer (after => $self->{interval}, cb => sub {
171			if (AnyEvent->now - $self->{fix}{time} > $self->{interval} * 1.9) {
172			$self->{fix}{mode} = 1;
173			$self->event (fix => $self->{fix});
174			}
175
176			$self->interval_timer;
177			});
178
179			Scalar::Util::weaken $self;
180			}
181
182	root	1.1	sub connect {
183			my ($self) = @_;
184
185			return if $self->{fh};
186
187			AnyEvent::Socket::tcp_connect $self->{host} \|\| "localhost", $self->{port} \|\| 2947, sub {
188			my ($fh) = @_;
189
190			return unless $self;
191
192			if ($fh) {
193			# unbelievable, but true: gpsd does not support command pipelining.
194			# it's an immensely shitty piece of software, actually, as it blocks
195			# randomly and for extended periods of time, has a surprisingly broken
196			# and non-configurable baud autoconfiguration system (it does stuff
197			# like switching to read-only mode when my bluetooth gps mouse temporarily
198			# loses the connection etc.) and uses rather idiotic and wasteful
199			# programming methods.
200
201			$self->{fh} = new AnyEvent::Handle
202			fh => $fh,
203			low_delay => 1,
204			on_error => sub {
205			$self->event ("error");
206			$self->retry;
207			},
208			on_eof => sub {
209	root	1.2	$! = &Errno::EPIPE;
210	root	1.1	$self->event ("error");
211			$self->retry;
212			},
213			on_read => sub {
214			$_[0]{rbuf} =~ s/^([^\015\012]*)\015\012//
215			or return;
216
217			$self->feed ($1);
218			},
219			;
220
221			$self->send ("w");
222			$self->send ("o");
223			$self->send ("y");
224	root	1.2	$self->send ("c");
225	root	1.1
226			$self->event ("connect");
227			} else {
228			$self->event ("error");
229			}
230			};
231
232			Scalar::Util::weaken $self;
233			}
234
235			sub drain_wbuf {
236			my ($self) = @_;
237
238			$self->{fh}->push_write (join "", @{ $self->{command}[0] });
239			}
240
241			sub send {
242			my ($self, $command, $args) = @_;
243
244			# curse them, we simply expect that each comamnd will result in a response using
245			# the same letter
246
247			push @{ $self->{command} }, [uc $command, $args];
248			$self->drain_wbuf if @{ $self->{command} } == 1;
249			}
250
251			sub feed {
252			my ($self, $line) = @_;
253
254			$self->{now} = AnyEvent->now;
255
256			unless ($line =~ /^GPSD,(.)=(.*)$/) {
257			$! = &Errno::EBADMSG;
258			$self->event ("error");
259			return $self->retry;
260			}
261
262			my ($type, $data) = ($1, $2);
263
264			$self->{state}{$type} = [$data => $self->{now}];
265
266			if ($type eq "O") {
267			my @data = split /\s+/, $data;
268	root	1.2
269			my $fix = $self->{fix};
270
271			$fix->{time} = $self->{now};
272	root	1.1
273			if (@data > 3) {
274			# the gpsd time is virtually useless as it is truncated :/
275	root	1.2	for (qw(tag _time _terr lat lon alt herr verr bearing speed vspeed berr serr vserr mode)) {
276			$type = shift @data;
277			$fix->{$_} = $type eq "?" ? undef : $type;
278			}
279	root	1.1
280	root	1.2	$fix->{mode} = 2 if $fix->{mode} eq "?"; # arbitrary choice
281	root	1.1	} else {
282	root	1.2	$fix->{mode} = 1;
283	root	1.1	}
284
285	root	1.2	$self->event (fix => $fix);
286	root	1.1
287			} elsif ($type eq "Y") {
288			my (undef, @sats) = split /:/, $data;
289
290			$self->{satellite_info} = [map {
291			my @sat = split /\s+/;
292			{
293			prn => $sat[0],
294			ele => $sat[1],
295			azi => $sat[2],
296			snr => $sat[3],
297			fix => $sat[4],
298			}
299			} @sats];
300
301			$self->event (satellite_update => $self->{satellite_info});
302	root	1.2
303			} elsif ($type eq "C") {
304			$self->{interval} = $data >= 1 ? $data * 1 : 1;
305	root	1.1	}
306
307			# we (wrongly) assume that gpsd responses are always in response
308			# to an earlier command
309
310			if (@{ $self->{command} } && $self->{command}[0][0] eq $type) {
311			shift @{ $self->{command} };
312			$self->drain_wbuf if @{ $self->{command} };
313			}
314			}
315
316			=item ($lat, $lon) = $gps->estimate ([$max_seconds])
317
318			This returns an estimate of the current position based on the last fix and
319			the time passed since then. Useful for interactive applications where you
320			want more frequent updates, but not very useful to store, as the next fix
321			might well be totally off.
322
323	root	1.3	If the fix is older then C<$max_seconds> (default: C<1.9> times the update
324			interval, i.e. usually C<1.9> seconds) or if no fix is available, returns
325			the empty list.
326	root	1.1
327			=cut
328
329			sub estimate {
330			my ($self, $max) = @_;
331
332	root	1.3	$max \|\|= 1.9 * $self->{interval} unless defined $max;
333	root	1.1
334			my $geo = $self->{geo_forward} \|\|= new Geo::Forward;
335
336			my $fix = $self->{fix} or return;
337			$fix->{mode} >= 2 or return;
338
339			my $diff = AnyEvent->time - $fix->{time};
340
341			$diff <= $max or return;
342
343			if ($fix->{speed} > $fix->{serr}) {
344			my ($lat, $lon) = $geo->forward ($fix->{lat}, $fix->{lon}, $fix->{bearing}, $fix->{speed} * $diff);
345			($lat, $lon)
346
347			} else {
348			# if we likely have zero speed, return the point itself
349			($fix->{lat}, $fix->{lon})
350			}
351			}
352
353			=back
354
355			=head1 SEE ALSO
356
357			L<AnyEvent>.
358
359			=head1 AUTHOR
360
361			Marc Lehmann <schmorp@schmorp.de>
362			http://home.schmorp.de/
363
364			=cut
365
366			1
367