File Coverage

blib/lib/FuseBead/From/PNG/Bead.pm
Criterion Covered Total %
statement 16 53 30.1
branch 0 10 0.0
condition 0 12 0.0
subroutine 6 14 42.8
pod 8 8 100.0
total 30 97 30.9


line stmt bran cond sub pod time code
1             package FuseBead::From::PNG::Bead;
2              
3 1     1   875 use strict;
  1         1  
  1         22  
4 1     1   3 use warnings;
  1         0  
  1         25  
5              
6             BEGIN {
7 1     1   14 $FuseBead::From::PNG::Bead::VERSION = '0.01';
8             }
9              
10 1     1   378 use FuseBead::From::PNG::Const qw(:all);
  1         2  
  1         786  
11              
12 1     1   407 use Data::Debug;
  1         1649  
  1         297  
13              
14             sub new {
15 0     0 1   my $class = shift;
16 0 0         my %args = ref $_[0] eq 'HASH' ? %{$_[0]} : @_;
  0            
17              
18 0           my $hash = {};
19              
20 0           $hash->{$_} = $args{$_} for(qw(color meta));
21              
22 0 0         die "Invalid color" if ! scalar( grep { $_ eq $hash->{'color'} } BEAD_COLORS );
  0            
23              
24             # Default dimensions
25 0           $hash->{'diameter'} = BEAD_DIAMETER;
26              
27             # Default meta to an empty hashref if it is undefined or an invalid ref
28 0 0 0       $hash->{'meta'} = (! $hash->{'meta'} || ref($hash->{'meta'}) ne 'HASH') ? {} : $hash->{'meta'};
29              
30 0   0       my $self = bless ($hash, ref ($class) || $class);
31              
32 0           return $self;
33             }
34              
35 0     0 1   sub id { &identifier }
36             sub identifier {
37 0     0 1   my $self = shift;
38              
39 0   0       return $self->{'id'} ||= $self->color;
40             }
41              
42             sub color {
43 0     0 1   my $self = shift;
44 0           my $val = shift;
45              
46 0 0         if(defined $val) {
47 0 0         die "Invalid color" if ! scalar( grep { $_ eq $val } BEAD_COLORS );
  0            
48              
49 0           $self->{'color'} = $val;
50              
51 0           delete $self->{'id'}; # Clear out id
52 0           delete $self->{'color_info'}; # Clear out color info on color change
53             }
54              
55 0           return $self->{'color'};
56             }
57              
58 0     0 1   sub diameter { shift->{'diameter'} }
59              
60 0     0 1   sub meta { shift->{'meta'} }
61              
62             sub color_info {
63 0     0 1   my $self = shift;
64              
65 0   0       return $self->{'color_info'} ||= do {
66 0           my $color = $self->color;
67              
68 0           my ($n_key, $hex_key, $r_key, $g_key, $b_key) = (
69             $color . '_NAME',
70             $color . '_HEX_COLOR',
71             $color . '_RGB_COLOR_RED',
72             $color . '_RGB_COLOR_GREEN',
73             $color . '_RGB_COLOR_BLUE',
74             );
75              
76 1     1   4 no strict 'refs';
  1         2  
  1         121  
77              
78             +{
79 0           'cid' => $color,
80             'name' => FuseBead::From::PNG::Const->$n_key,
81             'hex_color' => FuseBead::From::PNG::Const->$hex_key,
82             'rgb_color' => [
83             FuseBead::From::PNG::Const->$r_key,
84             FuseBead::From::PNG::Const->$g_key,
85             FuseBead::From::PNG::Const->$b_key,
86             ],
87             };
88             };
89             }
90              
91             sub flatten {
92 0     0 1   my $self = shift;
93              
94 0           $self->identifier; # Make sure it's generated
95              
96 0           my %hash;
97 0           my @keys = qw(id color diameter meta);
98              
99 0           @hash{ @keys } = @{ $self }{ @keys };
  0            
100              
101 0           return \%hash;
102             }
103              
104             =pod
105              
106             =head1 NAME
107              
108             FuseBead::From::PNG::Bead - A simple representation of a fuse bead
109              
110             =head1 SYNOPSIS
111              
112             use FuseBead::From::PNG::Bead;
113              
114             my ($color) = ('BLACK');
115              
116             my $object = FuseBead::From::PNG::Bead->new(
117             color => $color,
118             meta => {} # Anything else we want to track
119             );
120              
121             # Get at the data with accessors
122              
123             =head1 DESCRIPTION
124              
125             Representation of a FuseBead Bead plus additional meta data about that bead
126              
127             =head1 USAGE
128              
129             =head2 new
130              
131             Usage : ->new()
132             Purpose : Returns FuseBead::From::PNG::Bead object
133              
134             Returns : FuseBead::From::PNG::Bead object
135             Argument :
136             color -> must be a valid color from L
137             meta -> a hashref of additional meta data for the instanciated bead
138             Throws : Dies if the color is invalid
139              
140             Comment : Clobbers meta if it's not a valid hashref
141             See Also :
142              
143             =head2 id
144              
145             See identifier
146              
147             =head2 identifier
148              
149             Usage : ->identifier()
150             Purpose : Returns bead id, which is based on color
151              
152             Returns : the indentifier. Format:
153             Argument :
154             Throws :
155              
156             Comment : Identifiers aren't necessarily unique, more than one bead could have the same identifier and different meta for instance
157             See Also :
158              
159              
160             =head2 color
161              
162             Usage : ->color() or ->color($new_color)
163             Purpose : Returns color for the bead, optionally a new color may be set
164              
165             Returns : color value for this bead
166             Argument : Optional. Pass a scalar with a new valid color value to change the beads color
167             Throws :
168              
169             Comment :
170             See Also :
171              
172             =head2 diameter
173              
174             Usage : ->diameter() or ->diameter($new_number)
175             Purpose : Returns diameter for the bead, optionally a new diameter may be set
176              
177             Returns : diameter value for this bead
178             Argument : Optional. Pass a scalar with a new valid diameter value to change the beads diameter
179             Throws :
180              
181             Comment :
182             See Also :
183              
184             =head2 meta
185              
186             Usage : ->meta()
187             Purpose : Returns bead meta data
188              
189             Returns : bead meta data
190             Argument :
191             Throws :
192              
193             Comment :
194             See Also :
195              
196             =head2 color_info
197              
198             Usage : ->color_info()
199             Purpose : Returns hash of color info related to beads current color
200              
201             Returns : hash of color info
202             Argument :
203             Throws :
204              
205             Comment :
206             See Also :
207              
208             =head2 flatten
209              
210             Usage : ->flatten()
211             Purpose : Returns an unblessed version of the data
212              
213             Returns : hashref of bead data
214             Argument :
215             Throws :
216              
217             Comment :
218             See Also :
219              
220             =head1 BUGS
221              
222             =head1 SUPPORT
223              
224             =head1 AUTHOR
225              
226             Travis Chase
227             CPAN ID: GAUDEON
228             gaudeon@cpan.org
229             https://github.com/gaudeon/FuseBead-From-Png
230              
231             =head1 COPYRIGHT
232              
233             This program is free software licensed under the...
234              
235             The MIT License
236              
237             The full text of the license can be found in the
238             LICENSE file included with this module.
239              
240             =head1 SEE ALSO
241              
242             perl(1).
243              
244             =cut
245              
246             1;