File Coverage

blib/lib/Geo/GoogleEarth/AutoTour.pm
Criterion Covered Total %
statement 149 152 98.0
branch 32 44 72.7
condition 25 38 65.7
subroutine 18 18 100.0
pod 7 7 100.0
total 231 259 89.1


line stmt bran cond sub pod time code
1             package Geo::GoogleEarth::AutoTour;
2             # ABSTRACT: Generate Google Earth Camera Tours from Tracks and Paths
3              
4 2     2   392215 use 5.012;
  2         15  
5 2     2   9 use strict;
  2         3  
  2         31  
6 2     2   7 use warnings;
  2         3  
  2         54  
7              
8 2     2   18 use base 'Exporter';
  2         4  
  2         150  
9              
10 2     2   11 use Carp 'croak';
  2         3  
  2         101  
11 2     2   1155 use IO::Uncompress::Unzip qw( unzip $UnzipError );
  2         99969  
  2         205  
12 2     2   1212 use IO::Compress::Zip qw(zip $ZipError);
  2         36430  
  2         194  
13 2     2   1170 use XML::LibXML;
  2         64403  
  2         11  
14 2     2   1125 use Date::Parse 'str2time';
  2         12713  
  2         159  
15 2     2   935 use Math::Trig 1.23 qw( deg2rad rad2deg great_circle_distance great_circle_bearing );
  2         22965  
  2         3069  
16              
17             our $VERSION = '1.07'; # VERSION
18              
19             our @EXPORT_OK = qw( tour kmz_to_xml xml_to_kmz load_kml read_path gather_points build_tour );
20              
21             sub tour {
22 4     4 1 4306 my ( $input, $settings, $output ) = @_;
23 4 100       196 croak('Input not defined') unless ( defined $input );
24              
25 3 100       16 my $xc = load_kml( ( ref $input ) ? kmz_to_xml($input) : $input );
26              
27 3   100     33 $settings //= {};
28 3         19 my $doc_name = $xc->findvalue('//g:Document/g:name');
29 3   66     591 $settings->{doc_name} //= $doc_name;
30              
31 3 100       157 if ( $xc->findnodes('//g:Placemark[@id="tour"]/gx:MultiTrack/gx:Track')->size ) {
    50          
32 1         612 $settings->{points} = gather_points($xc);
33             }
34             elsif ( length $xc->findvalue('//g:Document/g:Placemark/g:LineString/g:coordinates') > 0 ) {
35 2         528 $settings->{points} = read_path($xc);
36             }
37             else {
38 0         0 croak('Input appears not to be either a track or path KML/KMZ');
39             }
40              
41 3         1020 my $xml = build_tour($settings);
42              
43 3 50       2848 if ( ref $output eq 'SCALAR' ) {
    100          
44 0         0 $$output = $xml;
45             }
46             elsif ( ref $output ) {
47 2         9 xml_to_kmz( $xml, $output, $doc_name );
48             }
49              
50 3         7313 return $xml;
51             }
52              
53             sub kmz_to_xml {
54 5     5 1 12877 my ($kmz_file_handle) = @_;
55 5         14 my $buffer;
56 5 50       41 unzip( $kmz_file_handle, \$buffer ) or die $UnzipError;
57 5         18225 return $buffer;
58             }
59              
60             sub xml_to_kmz {
61 2     2 1 7 my ( $xml, $kmz_file_handle ) = @_;
62 2 50       14 zip( \$xml, $kmz_file_handle, 'Name' => 'doc.kml' ) or die $ZipError;
63             }
64              
65             sub load_kml {
66 3     3 1 11 my ($xml_input) = @_;
67              
68 3         5 my $xc;
69 3         7 eval {
70 3         26 $xc = XML::LibXML::XPathContext->new(
71             XML::LibXML->load_xml( string => $xml_input )->documentElement
72             );
73             };
74 3 50       5437 croak('Unable to parse KML XML input') if ($@);
75              
76 3         25 $xc->registerNs( g => 'http://www.opengis.net/kml/2.2' );
77              
78 3         7 return $xc;
79             }
80              
81             sub read_path {
82 2     2 1 5 my ($xc) = @_;
83              
84 2         6 ( my $coords = $xc->findvalue('//g:Document/g:Placemark/g:LineString/g:coordinates') ) =~ s/^\s+|\s+$//g;
85 2         4890 my ( $time, $last_lat, $last_long ) = ( time, undef, undef );
86              
87             my @coords = map {
88 2         832 my ( $longitude, $latitude, $altitude ) = split( /,/, $_ );
  1160         3151  
89             {
90 1160         3002 latitude => $latitude,
91             longitude => $longitude,
92             altitude => $altitude,
93             };
94             } split( /\s/, $coords );
95              
96 2         56 $coords[0]{time} = time;
97 2         10 for ( my $i = 1; $i < @coords; $i++ ) {
98             my @points = (
99             deg2rad( $coords[ $i - 1 ]->{longitude} ),
100             deg2rad( 90 - $coords[ $i - 1 ]->{latitude} ),
101             deg2rad( $coords[$i]->{longitude} ),
102 1158         1919 deg2rad( 90 - $coords[$i]->{latitude} ),
103             );
104              
105 1158         21719 $coords[$i]{duration} = great_circle_distance( @points, 3956 ) / 140 * 60 * 60;
106 1158         15212 $coords[$i]{heading} = $coords[ $i - 1 ]{heading} = rad2deg( great_circle_bearing( @points, 3956 ) );
107 1158         24314 $coords[$i]{time} = $coords[ $i - 1 ]{time} + $coords[$i]{duration};
108             }
109              
110 2         12 return \@coords;
111             }
112              
113             sub gather_points {
114 1     1 1 3 my ($xc) = @_;
115              
116 1         3 my $last_time;
117             return [
118             map {
119 1         4 my $when = $xc->findnodes( 'g:when', $_ );
  32         5035  
120 32         1816 my $coord = $xc->findnodes( 'gx:coord', $_ );
121 32         1342 my $bearing = $xc->findnodes(
122             'g:ExtendedData/g:SchemaData/gx:SimpleArrayData[@name="bearing"]/gx:value',
123             $_,
124             );
125              
126             $when->map( sub {
127 783     783   18613 my ( $longitude, $latitude, $altitude) = split( ' ', $coord->shift->to_literal );
128              
129 783         5950 my $time = str2time( $_->to_literal );
130 783 100       124526 my $duration = ($last_time) ? $time - $last_time : undef;
131 783         1034 $last_time = $time;
132              
133             {
134 783         2163 latitude => $latitude,
135             longitude => $longitude,
136             altitude => $altitude,
137             heading => $bearing->shift->to_literal,
138             duration => $duration,
139             time => $time,
140             };
141 32         1844 } );
142             } $xc->findnodes('//g:Placemark[@id="tour"]/gx:MultiTrack/gx:Track')
143             ];
144             }
145              
146             sub build_tour {
147 5     5 1 1387 my $settings;
148 5         13 eval {
149 5 50       24 $settings = ( ref $_[0] eq 'HASH' ) ? $_[0] : { @{ $_[0] } };
  0         0  
150             };
151 5 50       22 croak($@) if ($@);
152             croak('Points not defined properly') unless (
153 5 50 66     213 $settings->{points} and ref $settings->{points} eq 'ARRAY' and ref $settings->{points}[0] eq 'HASH'
      66        
154             );
155              
156 4   100     16 $settings->{doc_name} //= 'Tour';
157 4   50     24 $settings->{tour_name} //= 'Tour';
158 4   50     22 $settings->{tilt} //= 80; # lower = deeper; higher = higher; 90 = flat
159 4   50     19 $settings->{gap_duration} //= 20; # seconds
160 4   50     19 $settings->{play_speed} //= 20; # higher = faster; 1 = normal
161 4   50     20 $settings->{initial_move} //= 2; # seconds
162 4   50     20 $settings->{initial_wait} //= 5; # seconds
163 4   50     16 $settings->{start_trim} //= 0; # seconds
164 4   50     21 $settings->{end_trim} //= 0; # seconds
165 4   100     17 $settings->{altitude_adjustment} //= 100; # feet
166 4   100     15 $settings->{altitude_mode} //= 'absolute'; # absolute, relativeToGround
167              
168 4 50       17 $settings->{altitude_mode} = 'absolute' if ( lc( $settings->{altitude_mode} ) eq 'msl' );
169 4 100       19 $settings->{altitude_mode} = 'relativeToGround' if ( lc( $settings->{altitude_mode} ) eq 'agl' );
170 4 50       13 $settings->{altitude_mode} = 'relativeToGround' if ( lc( $settings->{altitude_mode} ) eq 'relative' );
171              
172 4         12 $settings->{altitude_adjustment} /= 3.28084; # convert feet into meters for use in Google Earth KML
173              
174 4         39 my $xml = XML::LibXML::Document->new( '1.0', 'UTF-8' );
175              
176 4         38 my $kml = $xml->createElement('kml');
177 4         25 $kml->setAttribute( 'xmlns' => 'http://www.opengis.net/kml/2.2' );
178 4         267 $kml->setAttribute( 'xmlns:gx' => 'http://www.google.com/kml/ext/2.2' );
179              
180 4         128 my $doc = $xml->createElement('Document');
181              
182 4         16 my $name = $xml->createElement('name');
183 4         21 $name->appendTextNode( $settings->{doc_name} );
184 4         33 $doc->appendChild($name);
185              
186 4         11 my $tour = $xml->createElement('gx:Tour');
187              
188 4         62 my $tour_name = $xml->createElement('name');
189 4         16 $tour_name->appendTextNode( $settings->{tour_name} );
190 4         13 $tour->appendChild($tour_name);
191              
192 4         8 my $playlist = $xml->createElement('gx:Playlist');
193              
194 4         45 my ( $wait, $total_duration ) = ( 0, 0 );
195 4         6 for my $point ( @{ $settings->{points} } ) {
  4         13  
196             next if (
197             $point->{time} < $settings->{points}[0]->{time} + $settings->{start_trim}
198             or
199             $point->{time} > $settings->{points}[-1]->{time} - $settings->{end_trim}
200 1944 50 33     23540 );
201              
202 1944   100     3047 $total_duration += $point->{duration} || 0;
203 1944 100       3131 next if ( $total_duration < $settings->{gap_duration} );
204              
205 475         1495 my $flyto = $xml->createElement('gx:FlyTo');
206              
207 475         1336 my $duration = $xml->createElement('gx:duration');
208             $duration->appendTextNode(
209             ( defined $point->{duration} )
210             ? $total_duration / $settings->{play_speed}
211             : $settings->{initial_move}
212 475 50       2785 );
213 475         1585 $flyto->appendChild($duration);
214              
215 475         972 $total_duration = 0;
216              
217 475         4867 my $mode = $xml->createElement('gx:flyToMode');
218 475         1364 $mode->appendTextNode('smooth');
219 475         1313 $flyto->appendChild($mode);
220              
221 475         891 my $camera = $xml->createElement('Camera');
222              
223 475         4671 for my $node_name ( qw( latitude longitude altitude heading tilt ) ) {
224 2375         31339 my $element = $xml->createElement($node_name);
225             $element->appendTextNode(
226             ( $node_name eq 'tilt' ) ? $settings->{tilt} :
227             ( $node_name eq 'altitude' ) ? $point->{$node_name} + $settings->{altitude_adjustment} :
228 2375 100       11865 $point->{$node_name}
    100          
229             );
230 2375         8079 $camera->appendChild($element);
231             }
232              
233 475         7291 my $a_mode = $xml->createElement('altitudeMode');
234 475         1479 $a_mode->appendTextNode( $settings->{altitude_mode} );
235 475         1311 $camera->appendChild($a_mode);
236              
237 475         884 $flyto->appendChild($camera);
238 475         4451 $playlist->appendChild($flyto);
239              
240 475 100       4356 unless ($wait) {
241 3         36 my $gx_wait = $xml->createElement('gx:Wait');
242              
243 3         11 my $element = $xml->createElement('gx:duration');
244 3         21 $element->appendTextNode( $settings->{initial_wait} );
245 3         11 $gx_wait->appendChild($element);
246              
247 3         7 $playlist->appendChild($gx_wait);
248              
249 3         31 $wait = 1;
250             }
251             }
252              
253 4         267 $tour->appendChild($playlist);
254 4         16 $doc->appendChild($tour);
255 4         189 $kml->appendChild($doc);
256 4         184 $xml->setDocumentElement($kml);
257              
258 4         166 return $xml->toString(1);
259             }
260              
261             1;
262              
263             __END__