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__ |