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   340013 use 5.012;
  2         14  
5 2     2   8 use strict;
  2         3  
  2         27  
6 2     2   6 use warnings;
  2         3  
  2         37  
7              
8 2     2   6 use base 'Exporter';
  2         3  
  2         144  
9              
10 2     2   9 use Carp 'croak';
  2         2  
  2         97  
11 2     2   933 use IO::Uncompress::Unzip qw( unzip $UnzipError );
  2         85011  
  2         194  
12 2     2   1067 use IO::Compress::Zip qw(zip $ZipError);
  2         30214  
  2         192  
13 2     2   1008 use XML::LibXML;
  2         46386  
  2         11  
14 2     2   997 use Date::Parse 'str2time';
  2         11090  
  2         145  
15 2     2   814 use Math::Trig 1.23 qw( deg2rad rad2deg great_circle_distance great_circle_bearing );
  2         19708  
  2         2539  
16              
17             our $VERSION = '1.08'; # 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 4042 my ( $input, $settings, $output ) = @_;
23 4 100       163 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     29 $settings //= {};
28 3         17 my $doc_name = $xc->findvalue('//g:Document/g:name');
29 3   66     507 $settings->{doc_name} //= $doc_name;
30              
31 3 100       140 if ( $xc->findnodes('//g:Placemark[@id="tour"]/gx:MultiTrack/gx:Track')->size ) {
    50          
32 1         530 $settings->{points} = gather_points($xc);
33             }
34             elsif ( length $xc->findvalue('//g:Document/g:Placemark/g:LineString/g:coordinates') > 0 ) {
35 2         469 $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         918 my $xml = build_tour($settings);
42              
43 3 50       2593 if ( ref $output eq 'SCALAR' ) {
    100          
44 0         0 $$output = $xml;
45             }
46             elsif ( ref $output ) {
47 2         11 xml_to_kmz( $xml, $output, $doc_name );
48             }
49              
50 3         6898 return $xml;
51             }
52              
53             sub kmz_to_xml {
54 5     5 1 11782 my ($kmz_file_handle) = @_;
55 5         13 my $buffer;
56 5 50       36 unzip( $kmz_file_handle, \$buffer ) or die $UnzipError;
57 5         16042 return $buffer;
58             }
59              
60             sub xml_to_kmz {
61 2     2 1 6 my ( $xml, $kmz_file_handle ) = @_;
62 2 50       15 zip( \$xml, $kmz_file_handle, 'Name' => 'doc.kml' ) or die $ZipError;
63             }
64              
65             sub load_kml {
66 3     3 1 8 my ($xml_input) = @_;
67              
68 3         6 my $xc;
69 3         5 eval {
70 3         26 $xc = XML::LibXML::XPathContext->new(
71             XML::LibXML->load_xml( string => $xml_input )->documentElement
72             );
73             };
74 3 50       4971 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         20 return $xc;
79             }
80              
81             sub read_path {
82 2     2 1 4 my ($xc) = @_;
83              
84 2         6 ( my $coords = $xc->findvalue('//g:Document/g:Placemark/g:LineString/g:coordinates') ) =~ s/^\s+|\s+$//g;
85 2         3903 my ( $time, $last_lat, $last_long ) = ( time, undef, undef );
86              
87             my @coords = map {
88 2         740 my ( $longitude, $latitude, $altitude ) = split( /,/, $_ );
  1160         2687  
89             {
90 1160         2593 latitude => $latitude,
91             longitude => $longitude,
92             altitude => $altitude,
93             };
94             } split( /\s/, $coords );
95              
96 2         49 $coords[0]{time} = time;
97 2         11 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         1692 deg2rad( 90 - $coords[$i]->{latitude} ),
103             );
104              
105 1158         18207 $coords[$i]{duration} = great_circle_distance( @points, 3956 ) / 140 * 60 * 60;
106 1158         13278 $coords[$i]{heading} = $coords[ $i - 1 ]{heading} = rad2deg( great_circle_bearing( @points, 3956 ) );
107 1158         20811 $coords[$i]{time} = $coords[ $i - 1 ]{time} + $coords[$i]{duration};
108             }
109              
110 2         11 return \@coords;
111             }
112              
113             sub gather_points {
114 1     1 1 3 my ($xc) = @_;
115              
116 1         2 my $last_time;
117             return [
118             map {
119 1         4 my $when = $xc->findnodes( 'g:when', $_ );
  32         4344  
120 32         1708 my $coord = $xc->findnodes( 'gx:coord', $_ );
121 32         1155 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   16146 my ( $longitude, $latitude, $altitude) = split( ' ', $coord->shift->to_literal );
128              
129 783         4899 my $time = str2time( $_->to_literal );
130 783 100       106062 my $duration = ($last_time) ? $time - $last_time : undef;
131 783         865 $last_time = $time;
132              
133             {
134 783         1948 latitude => $latitude,
135             longitude => $longitude,
136             altitude => $altitude,
137             heading => $bearing->shift->to_literal,
138             duration => $duration,
139             time => $time,
140             };
141 32         1591 } );
142             } $xc->findnodes('//g:Placemark[@id="tour"]/gx:MultiTrack/gx:Track')
143             ];
144             }
145              
146             sub build_tour {
147 5     5 1 1227 my $settings;
148 5         7 eval {
149 5 50       22 $settings = ( ref $_[0] eq 'HASH' ) ? $_[0] : { @{ $_[0] } };
  0         0  
150             };
151 5 50       20 croak($@) if ($@);
152             croak('Points not defined properly') unless (
153 5 50 66     195 $settings->{points} and ref $settings->{points} eq 'ARRAY' and ref $settings->{points}[0] eq 'HASH'
      66        
154             );
155              
156 4   100     17 $settings->{doc_name} //= 'Tour';
157 4   50     20 $settings->{tour_name} //= 'Tour';
158 4   50     22 $settings->{tilt} //= 80; # lower = deeper; higher = higher; 90 = flat
159 4   50     17 $settings->{gap_duration} //= 20; # seconds
160 4   50     20 $settings->{play_speed} //= 20; # higher = faster; 1 = normal
161 4   50     25 $settings->{initial_move} //= 2; # seconds
162 4   50     21 $settings->{initial_wait} //= 5; # seconds
163 4   50     17 $settings->{start_trim} //= 0; # seconds
164 4   50     15 $settings->{end_trim} //= 0; # seconds
165 4   100     16 $settings->{altitude_adjustment} //= 100; # feet
166 4   100     15 $settings->{altitude_mode} //= 'absolute'; # absolute, relativeToGround
167              
168 4 50       15 $settings->{altitude_mode} = 'absolute' if ( lc( $settings->{altitude_mode} ) eq 'msl' );
169 4 100       14 $settings->{altitude_mode} = 'relativeToGround' if ( lc( $settings->{altitude_mode} ) eq 'agl' );
170 4 50       10 $settings->{altitude_mode} = 'relativeToGround' if ( lc( $settings->{altitude_mode} ) eq 'relative' );
171              
172 4         14 $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         42 my $kml = $xml->createElement('kml');
177 4         20 $kml->setAttribute( 'xmlns' => 'http://www.opengis.net/kml/2.2' );
178 4         215 $kml->setAttribute( 'xmlns:gx' => 'http://www.google.com/kml/ext/2.2' );
179              
180 4         112 my $doc = $xml->createElement('Document');
181              
182 4         15 my $name = $xml->createElement('name');
183 4         22 $name->appendTextNode( $settings->{doc_name} );
184 4         32 $doc->appendChild($name);
185              
186 4         12 my $tour = $xml->createElement('gx:Tour');
187              
188 4         55 my $tour_name = $xml->createElement('name');
189 4         15 $tour_name->appendTextNode( $settings->{tour_name} );
190 4         15 $tour->appendChild($tour_name);
191              
192 4         7 my $playlist = $xml->createElement('gx:Playlist');
193              
194 4         41 my ( $wait, $total_duration ) = ( 0, 0 );
195 4         7 for my $point ( @{ $settings->{points} } ) {
  4         11  
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     21666 );
201              
202 1944   100     2787 $total_duration += $point->{duration} || 0;
203 1944 100       2872 next if ( $total_duration < $settings->{gap_duration} );
204              
205 475         1242 my $flyto = $xml->createElement('gx:FlyTo');
206              
207 475         1100 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       2417 );
213 475         2583 $flyto->appendChild($duration);
214              
215 475         864 $total_duration = 0;
216              
217 475         4118 my $mode = $xml->createElement('gx:flyToMode');
218 475         1120 $mode->appendTextNode('smooth');
219 475         1145 $flyto->appendChild($mode);
220              
221 475         764 my $camera = $xml->createElement('Camera');
222              
223 475         4390 for my $node_name ( qw( latitude longitude altitude heading tilt ) ) {
224 2375         29403 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       10062 $point->{$node_name}
    100          
229             );
230 2375         6819 $camera->appendChild($element);
231             }
232              
233 475         6665 my $a_mode = $xml->createElement('altitudeMode');
234 475         1272 $a_mode->appendTextNode( $settings->{altitude_mode} );
235 475         1170 $camera->appendChild($a_mode);
236              
237 475         716 $flyto->appendChild($camera);
238 475         4016 $playlist->appendChild($flyto);
239              
240 475 100       3820 unless ($wait) {
241 3         32 my $gx_wait = $xml->createElement('gx:Wait');
242              
243 3         22 my $element = $xml->createElement('gx:duration');
244 3         12 $element->appendTextNode( $settings->{initial_wait} );
245 3         10 $gx_wait->appendChild($element);
246              
247 3         6 $playlist->appendChild($gx_wait);
248              
249 3         28 $wait = 1;
250             }
251             }
252              
253 4         249 $tour->appendChild($playlist);
254 4         10 $doc->appendChild($tour);
255 4         164 $kml->appendChild($doc);
256 4         162 $xml->setDocumentElement($kml);
257              
258 4         154 return $xml->toString(1);
259             }
260              
261             1;
262              
263             __END__