File Coverage

blib/lib/Geo/GoogleEarth/Pluggable.pm
Criterion Covered Total %
statement 9 9 100.0
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 12 12 100.0


line stmt bran cond sub pod time code
1             package Geo::GoogleEarth::Pluggable;
2 5     5   106701 use strict;
  5         13  
  5         178  
3 5     5   24 use warnings;
  5         7  
  5         135  
4 5     5   23 use base qw{Geo::GoogleEarth::Pluggable::Folder};
  5         14  
  5         2859  
5             use XML::LibXML::LazyBuilder qw{DOM E};
6             use Archive::Zip qw{COMPRESSION_DEFLATED};
7             use IO::Scalar qw{};
8              
9             our $VERSION='0.15';
10              
11             =head1 NAME
12              
13             Geo::GoogleEarth::Pluggable - Generates GoogleEarth Documents
14              
15             =head1 SYNOPSIS
16              
17             use Geo::GoogleEarth::Pluggable;
18             my $document=Geo::GoogleEarth::Pluggable->new(%data); #is a special Folder...
19             my $folder =$document->Folder(%data); #isa Geo::GoogleEarth::Pluggable::Folder
20             my $point =$document->Point(%data); #isa Geo::GoogleEarth::Pluggable::Point
21             my $netlink =$document->NetworkLink(%data); #isa Geo::GoogleEarth::Pluggable::NetworkLink
22             my $lookat =$document->LookAt(%data); #isa Geo::GoogleEarth::Pluggable::LookAt
23             my $style =$document->Style(%data); #isa Geo::GoogleEarth::Pluggable::Style
24             print $document->render;
25              
26             KML CGI Example
27              
28             use Geo::GoogleEarth::Pluggable;
29             my $document=Geo::GoogleEarth::Pluggable->new(name=>"KML Document");
30             print $document->header,
31             $document->render;
32              
33             KMZ CGI Example
34              
35             use Geo::GoogleEarth::Pluggable;
36             my $document=Geo::GoogleEarth::Pluggable->new(name=>"KMZ Document");
37             print $document->header_kmz,
38             $document->archive;
39              
40             =head1 DESCRIPTION
41              
42             Geo::GoogleEarth::Pluggable is a Perl object oriented interface that allows for the creation of XML documents that can be used with Google Earth.
43              
44             Geo::GoogleEarth::Pluggable (aka Document) is a L with a render method.
45              
46             =head2 Object Inheritance Graph
47              
48             --- Constructor -+- Base --- Folder --- Document
49             | |
50             | +- Placemark -+- Point
51             | | +- LineString
52             | | +- LinearRing
53             | |
54             | +- StyleBase -+- Style
55             | | +- StyleMap
56             | |
57             | +- NetworkLink
58             |
59             +- LookAt
60              
61             =head2 Constructors that append to the parent folder object
62              
63             Folder, NetworkLink, Point, LineString, LinearRing
64              
65             =head2 Constructors that return objects for future use
66              
67             LookAt(), Style(), StyleMap()
68              
69             =head2 Wrappers (what makes it easy)
70              
71             Style => IconStyle, LineStyle, PolyStyle, LabelStyle, ListStyle
72              
73             Point => MultiPoint
74              
75             =head1 USAGE
76              
77             This is all of the code you need to generate a complete Google Earth document.
78              
79             use Geo::GoogleEarth::Pluggable;
80             my $document=Geo::GoogleEarth::Pluggable->new;
81             $document->Point(name=>"White House", lat=>38.897337, lon=>-77.036503);
82             print $document->render;
83              
84             =head1 CONSTRUCTOR
85              
86             =head2 new
87              
88             my $document=Geo::GoogleEarth::Pluggable->new(name=>"My Name");
89              
90             =head1 METHODS
91              
92             =head2 type
93              
94             Returns the object type.
95              
96             my $type=$folder->type;
97              
98             =cut
99              
100             sub type {"Document"};
101              
102             =head2 document
103              
104             Returns the document object.
105              
106             All objects know to which document they belong even the document itself!
107              
108             =cut
109              
110             sub document {shift};
111              
112             =head2 render
113              
114             Returns an XML document with an XML declaration and a root name of "Document"
115              
116             print $document->render;
117              
118             =cut
119              
120             sub render {
121             my $self=shift;
122             my $d = DOM(E(kml=>{$self->xmlns}, $self->node));
123             return $d->toString;
124             }
125              
126             =head2 archive
127              
128             Returns a KMZ formatted Zipped archive of the XML document
129              
130             print $document->archive;
131              
132             =cut
133              
134             sub archive {
135             my $self=shift;
136             my $azip=Archive::Zip->new;
137             my $member=$azip->addString($self->render, "doc.kml");
138             $member->desiredCompressionMethod(COMPRESSION_DEFLATED);
139             #$member->desiredCompressionLevel(9); #RT60563, RT54827
140              
141             my $archive=q{};
142             my $iosh=IO::Scalar->new( \$archive );
143             $azip->writeToFileHandle($iosh);
144             $iosh->close;
145             return $archive;
146             }
147              
148             =head2 xmlns
149              
150             Add or update a namespace
151              
152             $document->xmlns->{"namespace"}=$url;
153              
154             Delete a namespace
155              
156             delete($document->xmlns->{"xmlns:gx"});
157              
158             Replace all namespaces
159              
160             $document->{"xmlns"}={namespace=>$url};
161              
162             Reset to default namespaces
163              
164             delete($document->{"xmlns"});
165              
166             =cut
167              
168             sub xmlns {
169             my $self=shift;
170             unless (defined($self->{'xmlns'})) {
171             $self->{'xmlns'}={
172             'xmlns' => "http://www.opengis.net/kml/2.2",
173             'xmlns:gx' => "http://www.google.com/kml/ext/2.2",
174             'xmlns:kml' => "http://www.opengis.net/kml/2.2",
175             'xmlns:atom' => "http://www.w3.org/2005/Atom",
176             };
177             }
178             return wantarray ? %{$self->{'xmlns'}} : $self->{'xmlns'};
179             }
180              
181             =head2 nextId
182              
183             This method is in the document since all Styles and StyleMaps are in the document not folders.
184              
185             my $id=$document->nextId($type); #$type in "Style" or "StyleMap"
186              
187             =cut
188              
189             sub nextId {
190             my $self=shift;
191             my $type=shift || "Unknown";
192             $self->{"nextId"}=0 unless defined $self->{"nextId"};
193             return sprintf("%s-%s-%s", $type, "perl", $self->{"nextId"}++);
194             }
195              
196             =head2 header, header_kml
197              
198             Returns a header appropriate for a web application
199              
200             Content-type: application/vnd.google-earth.kml+xml
201             Content-Disposition: attachment; filename=filename.xls
202              
203             $document->header #embedded in browser
204             $document->header(filename=>"filename.xls") #download prompt
205             $document->header(content_type=>"application/vnd.google-earth.kml+xml") #default content type
206              
207             =cut
208              
209             *header_kml=\&header;
210              
211             sub header {
212             my $self=shift;
213             my %data=@_;
214             $data{"content_type"}="application/vnd.google-earth.kml+xml"
215             unless defined $data{"content_type"};
216             my $header=sprintf("Content-type: %s\n", $data{"content_type"});
217             $header.=sprintf(qq{Content-Disposition: attachment; filename="%s";\n},
218             $data{"filename"}) if defined $data{"filename"};
219             $header.="\n";
220             return $header;
221             }
222              
223             =head2 header_kmz
224              
225             Returns a header appropriate for a web application
226              
227             Content-type: application/vnd.google-earth.kml+xml
228             Content-Disposition: attachment; filename=filename.xls
229              
230             $document->header_kmz #embedded in browser
231             $document->header_kmz(filename=>"filename.xls") #download prompt
232             $document->header_kmz(content_type=>"application/vnd.google-earth.kmz") #default content type
233              
234             =cut
235              
236             sub header_kmz {
237             my $self=shift;
238             my %data=@_;
239             $data{"content_type"}||="application/vnd.google-earth.kmz";
240             return $self->header(%data);
241             }
242              
243             =head1 TODO
244              
245             =over
246              
247             =item Support for default Polygon and Line styles that are nicer than GoogleEarth's
248              
249             =item Support for DateTime object in the constructor that is promoted to the LookAt object.
250              
251             =item Create a L plugin (Promote tag as name and datetime to LookAt)
252              
253             =back
254              
255             =head1 BUGS
256              
257             Please log on RT and send to the geo-perl email list.
258              
259             =head1 LIMITATIONS
260              
261             =head2 Not So Pretty XML
262              
263             The XML produced by L is not "pretty". If you need pretty XML you must pass the output through xmllint or a simular product.
264              
265             For example:
266              
267             perl -MGeo::GoogleEarth::Pluggable -e "print Geo::GoogleEarth::Pluggable->new->render" | xmllint --format -
268              
269             =head2 Write Only
270              
271             This package can only write KML and KMZ files. However, if you need to read KML files, please see the L package's C method.
272              
273             =head1 SUPPORT
274              
275             DavisNetworks.com supports all Perl applications including this package.
276              
277             =head1 AUTHOR
278              
279             Michael R. Davis (mrdvt92)
280             CPAN ID: MRDVT
281              
282             =head1 COPYRIGHT
283              
284             This program is free software licensed under the...
285              
286             The BSD License
287              
288             The full text of the license can be found in the LICENSE file included with this module.
289              
290             =head1 SEE ALSO
291              
292             L, L, L, L, L
293              
294             =cut
295              
296             1;