File Coverage

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


line stmt bran cond sub pod time code
1             package Geo::GoogleEarth::Pluggable::Style;
2 1     1   5 use base qw{Geo::GoogleEarth::Pluggable::StyleBase};
  1         2  
  1         562  
3 1     1   6 use Scalar::Util qw{reftype};
  1         17  
  1         62  
4 1     1   449 use XML::LibXML::LazyBuilder qw{E};
  0            
  0            
5             use warnings;
6             use strict;
7              
8             our $VERSION='0.09';
9             our $PACKAGE=__PACKAGE__;
10              
11             =head1 NAME
12              
13             Geo::GoogleEarth::Pluggable::Style - Geo::GoogleEarth::Pluggable Style Object
14              
15             =head1 SYNOPSIS
16              
17             use Geo::GoogleEarth::Pluggable;
18             my $document=Geo::GoogleEarth::Pluggable->new();
19             my $style=$document->Style();
20              
21             =head1 DESCRIPTION
22              
23             Geo::GoogleEarth::Pluggable::Style is a L with a few other methods.
24              
25             =head1 USAGE
26              
27             my $style=$document->Style(id=>"Style_Internal_HREF",
28             iconHref=>"http://.../path/image.png");
29              
30             =head1 CONSTRUCTOR
31              
32             =head2 new
33              
34             my $style=$document->Style(id=>"Style_Internal_HREF",
35             iconHref=>"http://.../path/image.png");
36              
37             =head1 METHODS
38              
39             =head2 type
40              
41             Returns the object type.
42              
43             my $type=$style->type;
44              
45             =cut
46              
47             sub type {"Style"};
48              
49             =head2 node
50              
51             =cut
52              
53             sub node {
54             my $self=shift;
55             my @element=();
56             foreach my $style (keys %$self) {
57             next if $style eq "document";
58             next if $style eq "id";
59             my @subelement=();
60             if (reftype($self->{$style}) eq "HASH") {
61             foreach my $key (keys %{$self->{$style}}) {
62             my $value=$self->{$style}->{$key};
63             #printf "Style: %s, Key: %s, Value: %s\n", $style, $key, $value;
64             #push @subelement, E(key=>{}, $key);
65             if ($key eq "color") {
66             push @subelement, E($key=>{}, $self->color($value));
67             } elsif ($key eq "href") {
68             if ($style eq "ListStyle") { #Google Earth Inconsistency!
69             push @subelement, E(ItemIcon=>{}, E($key=>{}, $value));
70             } else {
71             push @subelement, E(Icon=>{}, E($key=>{}, $value)); #which way to default
72             }
73             } elsif (ref($value) eq "HASH") { #e.g. hotSpot
74             push @subelement, E($key=>$value);
75             } elsif (ref($value) eq "ARRAY") {
76             push @subelement, E($key=>{}, join(",", @$value));
77             } else {
78             push @subelement, E($key=>{}, $value);
79             }
80             }
81             } else {
82             warn("Warning: Expecting $style to be a hash reference.");
83             }
84             push @element, E($style=>{}, @subelement);
85             }
86             return E(Style=>{id=>$self->id}, @element);
87             }
88              
89             =head2 color
90              
91             Returns a color code for use in the XML structure given many different inputs.
92              
93             my $color=$style->color("FFFFFFFF"); #AABBGGRR in hex
94             my $color=$style->color({color="FFFFFFFF"});
95             my $color=$style->color({red=>255, green=>255, blue=>255, alpha=>255});
96             my $color=$style->color({rgb=>[255,255,255], alpha=>255});
97             my $color=$style->color({abgr=>[255,255,255,255]});
98             #my $color=$style->color({name=>"blue", alpha=>255}); #TODO with ColorNames
99              
100             Note: alpha can be 0-255 or "0%"-"100%"
101              
102             =cut
103              
104             sub color {
105             my $self=shift;
106             my $color=shift;
107             if (ref($color) eq "HASH") {
108             if (defined($color->{"color"})) {
109             return $color->{"color"} || "FFFFFFFF";
110             } else {
111             my $a=$color->{"a"} || $color->{"alpha"} || $color->{"abgr"}->[0];
112             my $b=$color->{"b"} || $color->{"blue"} || $color->{"abgr"}->[1] || 0;
113             my $g=$color->{"g"} || $color->{"green"} || $color->{"abgr"}->[2] || 0;
114             my $r=$color->{"r"} || $color->{"red"} || $color->{"abgr"}->[3] || 0;
115             $a=255 unless defined $a;
116             if ($a=~m/(\d+)%/) {
117             $a=$1/100*255;
118             }
119             return unpack("H8", pack("C4", $a,$b,$g,$r));
120             }
121             } else {
122             return $color || "FFFFFFFF";
123             }
124             }
125              
126             =head1 BUGS
127              
128             Please log on RT and send to the geo-perl email list.
129              
130             =head1 SUPPORT
131              
132             Try geo-perl email list.
133              
134             =head1 AUTHOR
135              
136             Michael R. Davis (mrdvt92)
137             CPAN ID: MRDVT
138              
139             =head1 COPYRIGHT
140              
141             This program is free software licensed under the...
142              
143             The BSD License
144              
145             The full text of the license can be found in the
146             LICENSE file included with this module.
147              
148             =head1 SEE ALSO
149              
150             L creates a GoogleEarth Document.
151              
152             =cut
153              
154             1;