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. The C<{point}> hash contains at least the following
members:

   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 {
      @_,
   }, $class;

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

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::EBADMSG;
               $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->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 = (time => $self->{now});

      if (@data > 3) {
         # the gpsd time is virtually useless as it is truncated :/
         $fix{$_} = shift @data for qw(tag _time _terr lat lon alt herr verr bearing speed vspeed berr serr vserr mode);

         $fix{mode} = 2 if $fix{mode} eq "?"; # arbitrary choice
      } else {
         $fix{mode} = 1;
      }

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

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