File Coverage

blib/lib/Net/GPSD3.pm
Criterion Covered Total %
statement 61 123 49.5
branch 5 52 9.6
condition 1 5 20.0
subroutine 17 24 70.8
pod 13 13 100.0
total 97 217 44.7


line stmt bran cond sub pod time code
1             package Net::GPSD3;
2 18     18   279772 use strict;
  18         41  
  18         537  
3 17     17   2919 use warnings;
  17         32  
  17         508  
4 15     15   83 use base qw{Net::GPSD3::Base};
  15         27  
  15         9030  
5 15     15   11989 use JSON::XS qw{};
  15         112172  
  15         332  
6 15     15   10549 use IO::Socket::INET6 qw{};
  15         436308  
  15         338  
7 15     15   7019 use Net::GPSD3::Return::Unknown;
  15         34  
  15         350  
8 15     15   5467 use Net::GPSD3::Cache;
  15         29  
  15         316  
9 15     15   15717 use DateTime;
  15         2086912  
  15         18994  
10            
11             our $VERSION='0.19';
12             our $PACKAGE=__PACKAGE__;
13            
14             =head1 NAME
15            
16             Net::GPSD3 - Interface to the gpsd server daemon protocol versions 3 (JSON).
17            
18             =head1 SYNOPSIS
19            
20             =head2 Watch Interface
21            
22             use Net::GPSD3;
23             my $gpsd=Net::GPSD3->new;
24             $gpsd->watch;
25            
26             One Liner
27            
28             perl -MNet::GPSD3 -e 'Net::GPSD3->new->watch'
29            
30             =head2 Poll Interface
31            
32             use Net::GPSD3;
33             use Data::Dumper qw{Dumper};
34             my $gpsd=Net::GPSD3->new;
35             my $poll=$gpsd->poll;
36             print Dumper($poll);
37            
38             One Liner
39            
40             perl -MNet::GPSD3 -e 'printf "Protocol: %s\n", Net::GPSD3->new->poll->parent->cache->VERSION->protocol;'
41            
42             Protocol: 3.4
43            
44             =head2 POE Interface
45            
46             See L
47            
48             =head1 DESCRIPTION
49            
50             Net::GPSD3 provides an object client interface to the gpsd server daemon utilizing the version 3 protocol. gpsd is an open source GPS daemon from http://www.catb.org/gpsd/ Support for Version 3 of the protocol (JSON) was added to the daemon in version 2.90. If your daemon is before 2.90 (protocol 2.X), please use the L package.
51            
52             =head1 CONSTRUCTOR
53            
54             =head2 new
55            
56             Returns a new Net::GPSD3 object.
57            
58             my $gpsd=Net::GPSD3->new;
59             my $gpsd=Net::GPSD3->new(host=>"127.0.0.1", port=>2947); #defaults
60            
61             =head1 METHODS
62            
63             =head2 host
64            
65             Sets or returns the current gpsd host.
66            
67             my $host=$obj->host;
68            
69             =cut
70            
71             sub host {
72 3     3 1 91 my $self=shift;
73 3 0       7 if (@_) {
74 3         32 $self->{'host'}=shift;
75 3         15 undef($self->{'socket'});
76             }
77 3 0       5 $self->{'host'}="127.0.0.1" unless defined $self->{'host'};
78 3         29 return $self->{'host'};
79             }
80            
81             =head2 port
82            
83             Sets or returns the current gpsd TCP port.
84            
85             my $port=$obj->port;
86            
87             =cut
88            
89             sub port {
90 3     3 1 15 my $self=shift;
91 3 0       5 if (@_) {
92 3         30 $self->{'port'}=shift;
93 3         14 undef($self->{'socket'});
94             }
95 3 0       7 $self->{'port'}='2947' unless defined $self->{'port'};
96 3         31 return $self->{'port'};
97             }
98            
99             =head2 poll
100            
101             Sends a Poll request to the gpsd server and returns a L object. The method also populates the cache object with the L and L objects.
102            
103             my $poll=$gpsd->poll; #isa Net::GPSD3::Return::POLL object
104            
105             Note: In order to use the poll method consistently you should run the GPSD daemon as a service. You may also need to run the daemon with the "-n" option.
106            
107             =cut
108            
109             sub poll {
110 0     3 1 0 my $self=shift;
111 0 0       0 $self->socket->send(qq(?DEVICES;\n)) unless $self->cache->DEVICES;
112 0         0 $self->socket->send(qq(?POLL;\n));
113 0         0 my $object;
114 0         0 do { #Reads and caches VERSION and DEVICES
115 0         0 local $/="\r\n";
116 0         0 my $line=$self->socket->getline;
117 0         0 chomp $line;
118 0         0 $object=$self->constructor($self->decode($line), string=>$line);
119 0 0       0 $self->cache->add($object) unless $object->class eq "POLL";
120             } until $object->class eq "POLL"; #this needs more logic
121 0         0 return $object;
122             }
123            
124             =head2 watch
125            
126             Calls all handlers that are registered in the handler method.
127            
128             $gpsd->watch; #will not return unless something goes wrong.
129            
130             =cut
131            
132             sub watch {
133 0     3 1 0 my $self=shift;
134 0         0 my @handler=$self->handlers;
135 0 0       0 push @handler, \&default_handler unless scalar(@handler);
136             #$self->socket->send(qq(?DEVICES;\n)); #appears this is now done in the daemon
137 0         0 $self->socket->send($self->_watch_string_on. "\n");
138 0         0 my $object;
139             #man 8 gpsd - Each request returns a line of response text ended by a CR/LF.
140 0         0 local $/="\r\n";
141 0         0 my $line;
142 0         0 while (defined($line=$self->socket->getline)) { #Reads VERSION and DEVICES object too.
143             #print "$line\n";
144 0         0 chomp $line;
145 0         0 my $object=$self->constructor($self->decode($line), string=>$line);
146 0         0 $_->($object) foreach @handler;
147 0         0 $self->cache($object); #cache after handler so that the last point is available to the handler.
148             }
149 0         0 return $self;
150             }
151            
152             sub _watch_string_on {
153 0     0   0 return q(?WATCH={"enable":true,"json":true};);
154             }
155            
156             sub _watch_string_off {
157 0     0   0 return q(?WATCH={"enable":false,"json":true};);
158             }
159            
160             =head2 addHandler
161            
162             Adds handlers to the handler list.
163            
164             $gpsd->addHandler(\&myHandler);
165             $gpsd->addHandler(\&myHandler1, \&myHandler2);
166            
167             A handler is a sub reference where the first argument is a Net::GPSD3::Return::* object.
168            
169             =cut
170            
171             sub addHandler {
172 0     0 1 0 my $self=shift;
173 0         0 my $array=$self->handlers;
174 0 0       0 push @$array, @_ if @_;
175 0         0 return $self;
176             }
177            
178             =head2 handlers
179            
180             List of handlers that are called in order to process objects from the gpsd wathcer stream.
181            
182             my @handler=$gpsd->handlers; #()
183             my $handler=$gpsd->handlers; #[]
184            
185             =cut
186            
187             sub handlers {
188 0     0 1 0 my $self=shift;
189 0 0       0 $self->{'handler'}=[] unless ref($self->{'handler'});
190 0 0       0 return wantarray ? @{$self->{'handler'}} : $self->{'handler'};
  0         0  
191             }
192            
193             =head2 cache
194            
195             Returns the L caching object.
196            
197             =cut
198            
199             sub cache {
200 0     0 1 0 my $self=shift;
201 0 0       0 $self->{"cache"}=Net::GPSD3::Cache->new(parent=>$self)
202             unless defined $self->{"cache"};
203 0         0 return $self->{"cache"};
204             }
205            
206             =head1 METHODS Internal
207            
208             =head2 default_handler
209            
210             =cut
211            
212             sub default_handler {
213 0     0 1 0 my $object=shift;
214             #use Data::Dumper qw{Dumper};
215             #print Dumper($object);
216 0 0       0 if ($object->class eq "TPV") {
    0          
    0          
    0          
    0          
    0          
    0          
    0          
217 0         0 printf "%s: %s, Time: %s, Lat: %s, Lon: %s, Speed: %s, Heading: %s\n",
218             DateTime->now,
219             $object->class,
220             $object->timestamp,
221             $object->lat,
222             $object->lon,
223             $object->speed,
224             $object->track;
225             } elsif ($object->class eq "SKY") {
226 0         0 printf "%s: %s, Satellites: %s, Used: %s, PRNs: %s\n",
227             DateTime->now,
228             $object->class,
229             $object->reported,
230             $object->used,
231 0         0 join(",", map {$_->prn} grep {$_->used} $object->Satellites),
  0         0  
232             } elsif ($object->class eq "SUBFRAME") {
233 0         0 printf qq{%s: %s, Device: %s\n},
234             DateTime->now,
235             $object->class,
236             $object->device;
237             } elsif ($object->class eq "VERSION") {
238 0         0 printf "%s: %s, GPSD: %s (%s), %s: %s\n",
239             DateTime->now,
240             $object->class,
241             $object->release,
242             $object->revision,
243             ref($object->parent),
244             $object->parent->VERSION;
245             } elsif ($object->class eq "WATCH") {
246 0         0 printf "%s: %s, Enabled: %s\n",
247             DateTime->now,
248             $object->class,
249             $object->enabled;
250             } elsif ($object->class eq "DEVICES") {
251 0         0 my @device=$object->Devices;
252 0         0 foreach my $device (@device) {
253 0 0       0 if ($device->activated) {
254 0         0 $device=sprintf("%s (%s bps %s-%s)", $device->path, $device->bps, $device->driver, $device->subtype);
255             } else {
256 0         0 $device=$device->path;
257             }
258             }
259 0         0 printf "%s: %s, Devices: %s\n",
260             DateTime->now,
261             $object->class,
262             join(", ", @device);
263             } elsif ($object->class eq "DEVICE") {
264 0         0 printf qq{%s: %s, Device: %s (%s bps %s-%s)\n},
265             DateTime->now,
266             $object->class,
267             $object->path,
268             $object->bps,
269             $object->driver,
270             $object->subtype;
271             } elsif ($object->class eq "ERROR") {
272 0         0 printf qq{%s: %s, Message: "%s"\n},
273             DateTime->now,
274             $object->class,
275             $object->message;
276             } else {
277 0         0 warn(sprintf(qq{Warning: Unknown class "%s" for object "%s".}, $object->class, ref($object)));
278             #print Dumper($object);
279             }
280             #print Dumper($object);
281             }
282            
283             =head2 socket
284            
285             Returns the cached L object
286            
287             my $socket=$gpsd->socket; #try to reconnect on failure
288            
289             =cut
290            
291             sub socket {
292 0     0 1 0 my $self=shift;
293 0 0 0     0 unless (defined($self->{'socket'}) and
294             defined($self->{'socket'}->connected)) {
295 0         0 $self->{"socket"}=IO::Socket::INET6->new(
296             PeerAddr => $self->host,
297             PeerPort => $self->port,
298             );
299 0 0       0 die(sprintf("Error: Cannot connect to gpsd://%s:%s/.\n",
300             $self->host, $self->port)) unless defined($self->{"socket"});
301             }
302 0         0 return $self->{'socket'};
303             }
304            
305             =head2 json
306            
307             Returns the cached L object
308            
309             =cut
310            
311             sub json {
312 52     52 1 58 my $self=shift;
313             #Do I need to support JSON::PP?
314 52 100       551 $self->{"json"}=JSON::XS->new unless ref($self->{"json"}) eq "JSON::XS";
315 52         1072 return $self->{"json"};
316             }
317            
318             =head2 decode
319            
320             Returns a perl data structure given a JSON formated string.
321            
322             my %data=$gpsd->decode($string); #()
323             my $data=$gpsd->decode($string); #{}
324            
325             =cut
326            
327             sub decode {
328 11     11 1 8212 my $self=shift;
329 11         25 my $string=shift;
330 11         34 my $data=eval {$self->json->decode($string)};
  11         49  
331 11 50       79 if ($@) {
332 0         0 $data={class=>"ERROR", message=>"Invalid JSON"};
333             }
334 11 50       179 return wantarray ? %$data : $data;
335             }
336            
337             =head2 encode
338            
339             Returns a JSON string from a perl data structure
340            
341             =cut
342            
343             sub encode {
344 41     41 1 49 my $self=shift;
345 41         44 my $data=shift;
346 41         89 my $string=$self->json->encode($data);
347 41         156 return $string;
348             }
349            
350             =head2 constructor
351            
352             Constructs a class object by lazy loading the classes.
353            
354             my $obj=$gpsd->constructor(%$data);
355             my $obj=$gpsd->constructor(class=>"DEVICE",
356             string=>'{...}',
357             ...);
358            
359             Returns and object in the Net::GPSD3::Return::* namespace.
360            
361             =cut
362            
363             sub constructor {
364 52     52 1 82 my $self=shift;
365 52         2410 my %data=@_;
366 52   50     189 $data{"class"}||="undef";
367 52         136 my $class=join("::", $PACKAGE, "Return", $data{"class"});
368 52         54 my $object;
369 52     11   3535 eval("use $class");
  11         8089  
  11         26  
  11         199  
370 52 50       155 if ($@) { #Failed to load class
371 0         0 $object=Net::GPSD3::Return::Unknown->new(parent=>$self, %data);
372             } else {
373 52         399 $object=$class->new(parent=>$self, %data);
374             }
375 52         306 return $object;
376             }
377            
378             =head1 BUGS
379            
380             Log on RT and Send to gpsd-dev email list
381            
382             There are no two GPS devices that are alike. Each GPS device has a different GPSD signature as well. If your GPS device does not work out of the box with this package, please send me a log of your devices JSON sentences.
383            
384             echo '?POLL;' | nc 127.0.0.1 2947
385            
386             echo '?WATCH={"enable":true,"json":true};' | socat -t10 stdin stdout | nc 127.0.0.1 2947
387            
388             =head1 SUPPORT
389            
390             DavisNetworks.com supports all Perl applications including this package.
391            
392             Try gpsd-dev email list
393            
394             =head1 AUTHOR
395            
396             Michael R. Davis
397             CPAN ID: MRDVT
398             STOP, LLC
399             domain=>michaelrdavis,tld=>com,account=>perl
400             http://www.stopllc.com/
401            
402             =head1 COPYRIGHT
403            
404             This program is free software licensed under the...
405            
406             The BSD License
407            
408             The full text of the license can be found in the LICENSE file included with this module.
409            
410             =head1 SEE ALSO
411            
412             L, L, L, L, L, L
413            
414             =cut
415            
416             1;