cvsroot/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};
   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);
            },
         ;

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

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

sub record_log {
   my ($self, $path) = @_,

   require JSON;

   open $self->{logfh}, ">", $path
      or Carp::croak "$path: $!";

   $self->log (start => $VERSION);
}

=back

=head1 SEE ALSO

L<AnyEvent>.

=head1 AUTHOR

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

=cut

1

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