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.

=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>) or if no fix is
available, returns the empty list.

=cut

sub estimate {
   my ($self, $max) = @_;

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