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 3     3   467380 use 5.012;
  3         9  
5 3     3   14 use strict;
  3         4  
  3         64  
6 3     3   9 use warnings;
  3         3  
  3         137  
7              
8 3     3   31 use base 'Exporter';
  3         6  
  3         296  
9              
10 3     3   14 use Carp 'croak';
  3         3  
  3         199  
11 3     3   1815 use IO::Uncompress::Unzip qw( unzip $UnzipError );
  3         179412  
  3         366  
12 3     3   3475 use IO::Compress::Zip qw(zip $ZipError);
  3         65063  
  3         443  
13 3     3   2000 use XML::LibXML;
  3         110270  
  3         19  
14 3     3   1773 use Date::Parse 'str2time';
  3         12899  
  3         233  
15 3     3   1433 use Math::Trig 1.23 qw( deg2rad rad2deg great_circle_distance great_circle_bearing );
  3         35998  
  3         5190  
16              
17             our $VERSION = '1.11'; # 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 393678 my ( $input, $settings, $output ) = @_;
23 4 100       156 croak('Input not defined') unless ( defined $input );
24              
25 3 100       22 my $xc = load_kml( ( ref $input ) ? kmz_to_xml($input) : $input );
26              
27 3   100     47 $settings //= {};
28 3         19 my $doc_name = $xc->findvalue('//g:Document/g:name');
29 3   66     663 $settings->{doc_name} //= $doc_name;
30              
31 3 100       189 if ( $xc->findnodes('//g:Placemark[@id="tour"]/gx:MultiTrack/gx:Track')->size ) {
    50          
32 1         640 $settings->{points} = gather_points($xc);
33             }
34             elsif ( length $xc->findvalue('//g:Document/g:Placemark/g:LineString/g:coordinates') > 0 ) {
35 2         373 $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         900 my $xml = build_tour($settings);
42              
43 3 50       2893 if ( ref $output eq 'SCALAR' ) {
    100          
44 0         0 $$output = $xml;
45             }
46             elsif ( ref $output ) {
47 2         8 xml_to_kmz( $xml, $output, $doc_name );
48             }
49              
50 3         7526 return $xml;
51             }
52              
53             sub kmz_to_xml {
54 5     5 1 12383 my ($kmz_file_handle) = @_;
55 5         11 my $buffer;
56 5 50       31 unzip( $kmz_file_handle, \$buffer ) or die $UnzipError;
57 5         19601 return $buffer;
58             }
59              
60             sub xml_to_kmz {
61 2     2 1 4 my ( $xml, $kmz_file_handle ) = @_;
62 2 50       13 zip( \$xml, $kmz_file_handle, 'Name' => 'doc.kml' ) or die $ZipError;
63             }
64              
65             sub load_kml {
66 3     3 1 10 my ($xml_input) = @_;
67              
68 3         6 my $xc;
69 3         21 eval {
70 3         48 $xc = XML::LibXML::XPathContext->new(
71             XML::LibXML->load_xml( string => $xml_input )->documentElement
72             );
73             };
74 3 50       6024 croak('Unable to parse KML XML input') if ($@);
75              
76 3         24 $xc->registerNs( g => 'http://www.opengis.net/kml/2.2' );
77              
78 3         8 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         7943 my ( $time, $last_lat, $last_long ) = ( time, undef, undef );
86              
87             my @coords = map {
88 2         862 my ( $longitude, $latitude, $altitude ) = split( /,/, $_ );
  1160         3392  
89             {
90 1160         3165 latitude => $latitude,
91             longitude => $longitude,
92             altitude => $altitude,
93             };
94             } split( /\s/, $coords );
95              
96 2         71 $coords[0]{time} = time;
97 2         16 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         1875 deg2rad( 90 - $coords[$i]->{latitude} ),
103             );
104              
105 1158         20773 $coords[$i]{duration} = great_circle_distance( @points, 3956 ) / 140 * 60 * 60;
106 1158         23204 $coords[$i]{heading} = $coords[ $i - 1 ]{heading} = rad2deg( great_circle_bearing( @points, 3956 ) );
107 1158         22785 $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 2 my ($xc) = @_;
115              
116 1         2 my $last_time;
117             return [
118             map {
119 1         4 my $when = $xc->findnodes( 'g:when', $_ );
  32         4448  
120 32         1895 my $coord = $xc->findnodes( 'gx:coord', $_ );
121 32         1208 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   15270 my ( $longitude, $latitude, $altitude) = split( ' ', $coord->shift->to_literal );
128              
129 783         4536 my $time = str2time( $_->to_literal );
130 783 100       105201 my $duration = ($last_time) ? $time - $last_time : undef;
131 783         968 $last_time = $time;
132              
133             {
134 783         1767 latitude => $latitude,
135             longitude => $longitude,
136             altitude => $altitude,
137             heading => $bearing->shift->to_literal,
138             duration => $duration,
139             time => $time,
140             };
141 32         1675 } );
142             } $xc->findnodes('//g:Placemark[@id="tour"]/gx:MultiTrack/gx:Track')
143             ];
144             }
145              
146             sub build_tour {
147 5     5 1 1569 my $settings;
148 5         12 eval {
149 5 50       21 $settings = ( ref $_[0] eq 'HASH' ) ? $_[0] : { @{ $_[0] } };
  0         0  
150             };
151 5 50       16 croak($@) if ($@);
152             croak('Points not defined properly') unless (
153 5 50 66     218 $settings->{points} and ref $settings->{points} eq 'ARRAY' and ref $settings->{points}[0] eq 'HASH'
      66        
154             );
155              
156 4   100     15 $settings->{doc_name} //= 'Tour';
157 4   50     26 $settings->{tour_name} //= 'Tour';
158 4   50     23 $settings->{tilt} //= 80; # lower = deeper; higher = higher; 90 = flat
159 4   50     20 $settings->{gap_duration} //= 20; # seconds
160 4   50     17 $settings->{play_speed} //= 20; # higher = faster; 1 = normal
161 4   50     22 $settings->{initial_move} //= 2; # seconds
162 4   50     19 $settings->{initial_wait} //= 5; # seconds
163 4   50     21 $settings->{start_trim} //= 0; # seconds
164 4   50     20 $settings->{end_trim} //= 0; # seconds
165 4   100     19 $settings->{altitude_adjustment} //= 100; # feet
166 4   100     16 $settings->{altitude_mode} //= 'absolute'; # absolute, relativeToGround
167              
168 4 50       16 $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       16 $settings->{altitude_mode} = 'relativeToGround' if ( lc( $settings->{altitude_mode} ) eq 'relative' );
171              
172 4         9 $settings->{altitude_adjustment} /= 3.28084; # convert feet into meters for use in Google Earth KML
173              
174 4         46 my $xml = XML::LibXML::Document->new( '1.0', 'UTF-8' );
175              
176 4         58 my $kml = $xml->createElement('kml');
177 4         23 $kml->setAttribute( 'xmlns' => 'http://www.opengis.net/kml/2.2' );
178 4         255 $kml->setAttribute( 'xmlns:gx' => 'http://www.google.com/kml/ext/2.2' );
179              
180 4         136 my $doc = $xml->createElement('Document');
181              
182 4         16 my $name = $xml->createElement('name');
183 4         23 $name->appendTextNode( $settings->{doc_name} );
184 4         33 $doc->appendChild($name);
185              
186 4         9 my $tour = $xml->createElement('gx:Tour');
187              
188 4         77 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         7 my $playlist = $xml->createElement('gx:Playlist');
193              
194 4         70 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     25101 );
201              
202 1944   100     3524 $total_duration += $point->{duration} || 0;
203 1944 100       3364 next if ( $total_duration < $settings->{gap_duration} );
204              
205 475         1591 my $flyto = $xml->createElement('gx:FlyTo');
206              
207 475         1510 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       2671 );
213 475         1587 $flyto->appendChild($duration);
214              
215 475         861 $total_duration = 0;
216              
217 475         4943 my $mode = $xml->createElement('gx:flyToMode');
218 475         1473 $mode->appendTextNode('smooth');
219 475         1421 $flyto->appendChild($mode);
220              
221 475         780 my $camera = $xml->createElement('Camera');
222              
223 475         5169 for my $node_name ( qw( latitude longitude altitude heading tilt ) ) {
224 2375         32286 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       12086 $point->{$node_name}
    100          
229             );
230 2375         7214 $camera->appendChild($element);
231             }
232              
233 475         7580 my $a_mode = $xml->createElement('altitudeMode');
234 475         1543 $a_mode->appendTextNode( $settings->{altitude_mode} );
235 475         1333 $camera->appendChild($a_mode);
236              
237 475         826 $flyto->appendChild($camera);
238 475         4476 $playlist->appendChild($flyto);
239              
240 475 100       4369 unless ($wait) {
241 3         35 my $gx_wait = $xml->createElement('gx:Wait');
242              
243 3         12 my $element = $xml->createElement('gx:duration');
244 3         11 $element->appendTextNode( $settings->{initial_wait} );
245 3         15 $gx_wait->appendChild($element);
246              
247 3         22 $playlist->appendChild($gx_wait);
248              
249 3         43 $wait = 1;
250             }
251             }
252              
253 4         313 $tour->appendChild($playlist);
254 4         16 $doc->appendChild($tour);
255 4         198 $kml->appendChild($doc);
256 4         187 $xml->setDocumentElement($kml);
257              
258 4         181 return $xml->toString(1);
259             }
260              
261             1;
262              
263             __END__