File Coverage

blib/lib/Geo/GoogleEarth/Pluggable/Placemark.pm
Criterion Covered Total %
statement 13 15 86.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 18 20 90.0


line stmt bran cond sub pod time code
1             package Geo::GoogleEarth::Pluggable::Placemark;
2 1     1   7 use base qw{Geo::GoogleEarth::Pluggable::Base};
  1         11  
  1         76  
3 1     1   4 use strict;
  1         3  
  1         35  
4 1     1   13 use warnings;
  1         1  
  1         31  
5 1     1   5 use Scalar::Util qw{reftype blessed};
  1         1  
  1         160  
6 1     1   498 use XML::LibXML::LazyBuilder qw{E};
  0            
  0            
7              
8             our $VERSION='0.14';
9              
10             =head1 NAME
11              
12             Geo::GoogleEarth::Pluggable::Placemark - Base Object for Geo::GoogleEarth::Pluggable Placemarks
13              
14             =head1 SYNOPSIS
15              
16             use base qw{Geo::GoogleEarth::Pluggable::Placemark};
17              
18             =head1 DESCRIPTION
19              
20             The is the base of all Geo::GoogleEarth::Pluggable packages.
21              
22             =head1 USAGE
23              
24             =head1 METHODS
25              
26             =head2 type
27              
28             =cut
29              
30             sub type {"Placemark"};
31              
32             =head2 style
33              
34             Sets or returns the Placemark Style or StyleMap object.
35              
36             style=>$style is a short cut for styleUrl=>$style->url
37              
38             =cut
39              
40             sub style {
41             my $self=shift;
42             $self->{"style"}=shift if @_;
43             return $self->{"style"};
44             }
45              
46             =head2 styleUrl
47              
48             This overrides style->url if defined.
49              
50             =cut
51              
52             sub styleUrl {
53             my $self=shift;
54             my $url=undef;
55             $url=$self->style->url if blessed($self->style) && $self->style->can("url");
56             $self->{"styleUrl"}||=$url;
57             $self->{"styleUrl"}=shift if @_;
58             return $self->{"styleUrl"};
59             }
60              
61             =head2 LookAt
62              
63             Sets or returns the LookAt Object
64              
65             =cut
66              
67             sub LookAt {
68             my $self=shift;
69             $self->{"LookAt"}=shift if @_;
70             return $self->{"LookAt"};
71             }
72              
73             =head2 visibility
74              
75             Sets or returns visibility. The value is either 1 or 0 but defaults to undef which the same as 1.
76              
77             my $visibility=$placemark->visibility;
78              
79             =cut
80              
81             sub visibility {
82             my $self=shift;
83             $self->{"visibility"}=shift if @_;
84             return $self->{"visibility"};
85             }
86              
87             =head2 node
88              
89             =cut
90              
91             sub node {
92             my $self=shift;
93             my @element=();
94             push @element, $self->lookat->node
95             if ref($self->lookat) and $self->lookat->can("node");
96             push @element, E(name=>{}, $self->name)
97             if defined $self->name;
98             push @element, E(Snippet=>{maxLines=>scalar(@{$self->Snippet})}, join("\n", @{$self->Snippet}));
99             push @element, E(description=>{}, $self->description)
100             if defined $self->description;
101             push @element, E(visibility=>{}, $self->visibility)
102             if defined $self->visibility;
103             push @element, E(styleUrl=>{}, $self->styleUrl)
104             if defined $self->styleUrl;
105             push @element, $self->subnode;
106             return E($self->type=>{}, @element);
107             }
108              
109             =head2 coordinates
110              
111             The coordinates array is used consistantly for all placemark objects.
112              
113             my $coordinates=$placemark->coordinates(
114             [
115             [$lon, $lat, $alt],
116             {lat=>$lat, lon=>$lon, alt=>$alt},
117             GPS::Point,
118             Geo::Point,
119             Net::GPSD::Point,
120             ]
121             );
122              
123             my $coordinates=$placemark->coordinates(
124             Geo::Line, #TODO
125             );
126              
127              
128             =cut
129              
130             sub coordinates {
131             my $self=shift;
132             $self->{"coordinates"}=shift if @_;
133             return $self->{"coordinates"};
134             }
135              
136             =head2 coordinates_stringify
137              
138             =cut
139              
140             sub coordinates_stringify {
141             my $self=shift;
142             my $data=$self->coordinates;
143             my $string="";
144             if (ref($data) eq "ARRAY") {
145             $string=join(" ", map {$self->point_stringify($_)} @$data);
146             } else {
147             die(sprintf(qq{Error: the coordinates_stringify method does not understand coordinates value type "%s"}, ref($data)));
148             }
149             return $string;
150             }
151              
152             =head2 point_stringify
153              
154             my $string=$placemark->point_stringify($point); #returns "$lon,$lat,$alt"
155              
156             =cut
157              
158             sub point_stringify {
159             my $self=shift;
160             my %data=$self->point_normalize(@_);
161             return join(",", @data{qw{lon lat alt}});
162             }
163              
164             =head2 point_normalize
165              
166             Most of this code was taken from GPS::Point->initializeMulti
167              
168             my $data=$placemark->point_normalize($point); #returns {lat=>$lat,lon=>$lon,alt=>$alt}
169              
170             =cut
171              
172             sub point_normalize {
173             my $self=shift;
174             my $point=shift;
175             my $data={};
176             if (ref($point) eq "Geo::Point") {
177             $point=$point->in('wgs84') unless $point->proj eq "wgs84";
178             $data->{'lat'}=$point->latitude;
179             $data->{'lon'}=$point->longitude;
180             $data->{'alt'}=0;
181             } elsif (ref($point) eq "GPS::Point") {
182             $data->{'lat'}=$point->lat;
183             $data->{'lon'}=$point->lon;
184             $data->{'alt'}=$point->alt||0;
185             } elsif (ref($point) eq "Net::GPSD::Point") {
186             $data->{'lat'}=$point->latitude;
187             $data->{'lon'}=$point->longitude;
188             $data->{'alt'}=$point->altitude||0;
189             } elsif (reftype($point) eq "HASH") {
190             #{lat=>$lat, lon=>$lon, alt=>$alt}
191             $data->{'lat'}=$point->{'lat'}||$point->{'latitude'};
192             $data->{'lon'}=$point->{'lon'}||$point->{'long'}||$point->{'longitude'};
193             $data->{'alt'}=$point->{'alt'}||$point->{'altitude'}||
194             $point->{'elevation'}||$point->{'hae'}||$point->{'elev'}||0;
195             } elsif (reftype($point) eq "ARRAY") {
196             #[$lon, $lat, $alt]
197             $data->{'lon'}=$point->[0];
198             $data->{'lat'}=$point->[1];
199             $data->{'alt'}=$point->[2]||0;
200             }
201             $data->{$_}+=0 foreach qw{lat lon alt}; #convert to number to "trim" strings that look like numbers.
202             return wantarray ? %$data : $data;
203             }
204              
205             =head1 BUGS
206              
207             Please log on RT and send to the geo-perl email list.
208              
209             =head1 SUPPORT
210              
211             DavisNetworks.com supports all Perl applications including this package.
212              
213             =head1 AUTHOR
214              
215             Michael R. Davis (mrdvt92)
216             CPAN ID: MRDVT
217              
218             =head1 COPYRIGHT
219              
220             This program is free software licensed under the...
221              
222             The BSD License
223              
224             The full text of the license can be found in the LICENSE file included with this module.
225              
226             =head1 SEE ALSO
227              
228             L, L, L
229              
230             =cut
231              
232             1;