AnyEvent::GPSD - event based interface to GPSD

   use AnyEvent::GPSD;

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

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';

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

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} >= $self->{min_speed}) {
      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) = @_;

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

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

1