File Coverage

blib/lib/Lego/From/PNG/Brick.pm
Criterion Covered Total %
statement 16 72 22.2
branch 0 16 0.0
condition 0 18 0.0
subroutine 6 16 37.5
pod 10 10 100.0
total 32 132 24.2


line stmt bran cond sub pod time code
1             package Lego::From::PNG::Brick;
2              
3 1     1   1371 use strict;
  1         3  
  1         45  
4 1     1   6 use warnings;
  1         2  
  1         53  
5              
6             BEGIN {
7 1     1   25 $Lego::From::PNG::Brick::VERSION = '0.03';
8             }
9              
10 1     1   486 use Lego::From::PNG::Const qw(:all);
  1         3  
  1         1245  
11              
12 1     1   723 use Data::Debug;
  1         2391  
  1         564  
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 depth length height meta));
21              
22 0 0         die "Invalid color" if ! scalar( grep { $_ eq $hash->{'color'} } LEGO_COLORS );
  0            
23              
24             # Default any undefined dimensions to 1
25 0   0       $hash->{'depth'} ||= 1;
26 0   0       $hash->{'length'} ||= 1;
27 0   0       $hash->{'height'} ||= 1;
28              
29             # Default meta to an empty hashref if it is undefined or an invalid ref
30 0 0 0       $hash->{'meta'} = (! $hash->{'meta'} || ref($hash->{'meta'}) ne 'HASH') ? {} : $hash->{'meta'};
31              
32 0   0       my $self = bless ($hash, ref ($class) || $class);
33              
34 0           return $self;
35             }
36              
37 0     0 1   sub id { &identifier }
38             sub identifier {
39 0     0 1   my $self = shift;
40              
41 0   0       return $self->{'id'} ||= $self->color.'_'.join('x',$self->depth,$self->length,$self->height);
42             }
43              
44             sub color {
45 0     0 1   my $self = shift;
46 0           my $val = shift;
47              
48 0 0         if(defined $val) {
49 0 0         die "Invalid color" if ! scalar( grep { $_ eq $val } LEGO_COLORS );
  0            
50              
51 0           $self->{'color'} = $val;
52              
53 0           delete $self->{'id'}; # Clear out id
54 0           delete $self->{'color_info'}; # Clear out color info on color change
55             }
56              
57 0           return $self->{'color'};
58             }
59              
60             sub depth {
61 0     0 1   my $self = shift;
62 0           my $val = shift;
63              
64 0 0         if(defined $val) {
65 0           $self->{'depth'} = $val * 1;
66              
67 0           delete $self->{'id'}; # Clear out id
68             }
69              
70 0           return $self->{'depth'};
71             }
72              
73             sub length {
74 0     0 1   my $self = shift;
75 0           my $val = shift;
76              
77 0 0         if(defined $val) {
78 0           $self->{'length'} = $val * 1;
79              
80 0           delete $self->{'id'}; # Clear out id
81             }
82              
83 0           return $self->{'length'};
84             }
85              
86             sub height {
87 0     0 1   my $self = shift;
88 0           my $val = shift;
89              
90 0 0         if(defined $val) {
91 0           $self->{'height'} = $val * 1;
92              
93 0           delete $self->{'id'}; # Clear out id
94             }
95              
96 0           return $self->{'height'};
97             }
98              
99 0     0 1   sub meta { shift->{'meta'} }
100              
101             sub color_info {
102 0     0 1   my $self = shift;
103              
104 0   0       return $self->{'color_info'} ||= do {
105 0           my $color = $self->color;
106              
107 0           my ($on_key, $cn_key, $hex_key, $r_key, $g_key, $b_key) = (
108             $color . '_OFFICIAL_NAME',
109             $color . '_COMMON_NAME',
110             $color . '_HEX_COLOR',
111             $color . '_RGB_COLOR_RED',
112             $color . '_RGB_COLOR_GREEN',
113             $color . '_RGB_COLOR_BLUE',
114             );
115              
116 1     1   10 no strict 'refs';
  1         2  
  1         170  
117              
118             +{
119 0           'cid' => $color,
120             'official_name' => Lego::From::PNG::Const->$on_key,
121             'common_name' => Lego::From::PNG::Const->$cn_key,
122             'hex_color' => Lego::From::PNG::Const->$hex_key,
123             'rgb_color' => [
124             Lego::From::PNG::Const->$r_key,
125             Lego::From::PNG::Const->$g_key,
126             Lego::From::PNG::Const->$b_key,
127             ],
128             };
129             };
130             }
131              
132             sub flatten {
133 0     0 1   my $self = shift;
134              
135 0           $self->identifier; # Make sure it's generated
136              
137 0           my %hash;
138 0           my @keys = qw(id color depth length height meta);
139              
140 0           @hash{ @keys } = @{ $self }{ @keys };
  0            
141              
142 0           return \%hash;
143             }
144              
145             =pod
146              
147             =head1 NAME
148              
149             Lego::From::PNG::Brick - A simple representation of a lego brick
150              
151             =head1 SYNOPSIS
152              
153             use Lego::From::PNG::Brick;
154              
155             my ($color, $depth, $length, $height) = ('BLACK', 1, 2, 1);
156              
157             # depth x length x height
158             my $object = Lego::From::PNG::Brick->new(
159             color => $color,
160             depth => $depth,
161             length => $length,
162             height => $height,
163             meta => {} # Anything else we want to track
164             );
165              
166             # Get at the data with accessors
167              
168             =head1 DESCRIPTION
169              
170             Representation of a Lego Brick plus additional meta data about that brick
171              
172             =head1 USAGE
173              
174             =head2 new
175              
176             Usage : ->new()
177             Purpose : Returns Lego::From::PNG::Brick object
178              
179             Returns : Lego::From::PNG::Brick object
180             Argument :
181             color -> must be a valid color from L
182             depth -> brick depth, defaults to 1
183             length -> brick length, defaults to 1
184             height -> brick height, defaults to 1
185             meta -> a hashref of additional meta data for the instanciated brick
186             Throws : Dies if the color is invalid
187              
188             Comment : Clobbers meta if it's not a valid hashref
189             See Also :
190              
191             =head2 id
192              
193             See identifier
194              
195             =head2 identifier
196              
197             Usage : ->identifier()
198             Purpose : Returns brick id, which is based on color, depth, length and width
199              
200             Returns : the indentifier. Format: _xx
201             Argument :
202             Throws :
203              
204             Comment : Identifiers aren't necessarily unique, more than one brick could have the same identifier and different meta for instance
205             See Also :
206              
207              
208             =head2 color
209              
210             Usage : ->color() or ->color($new_color)
211             Purpose : Returns lego color for the brick, optionally a new color may be set
212              
213             Returns : lego color value for this brick
214             Argument : Optional. Pass a scalar with a new valid color value to change the bricks color
215             Throws :
216              
217             Comment :
218             See Also :
219              
220             =head2 depth
221              
222             Usage : ->depth() or ->depth($new_number)
223             Purpose : Returns depth for the brick, optionally a new depth may be set
224              
225             Returns : depth value for this brick
226             Argument : Optional. Pass a scalar with a new valid depth value to change the bricks depth
227             Throws :
228              
229             Comment :
230             See Also :
231              
232             =head2 length
233              
234             Usage : ->length() or ->length($new_number)
235             Purpose : Returns length for the brick, optionally a new length may be set
236              
237             Returns : length value for this brick
238             Argument : Optional. Pass a scalar with a new valid length value to change the bricks length
239             Throws :
240              
241             Comment :
242             See Also :
243              
244             =head2 height
245              
246             Usage : ->height() or ->height($new_number)
247             Purpose : Returns height for the brick, optionally a new height may be set
248              
249             Returns : height value for this brick
250             Argument : Optional. Pass a scalar with a new valid height value to change the bricks height
251             Throws :
252              
253             Comment :
254             See Also :
255              
256             =head2 meta
257              
258             Usage : ->meta()
259             Purpose : Returns brick meta data
260              
261             Returns : brick meta data
262             Argument :
263             Throws :
264              
265             Comment :
266             See Also :
267              
268             =head2 color_info
269              
270             Usage : ->color_info()
271             Purpose : Returns hash of color info related to bricks current color
272              
273             Returns : hash of color info
274             Argument :
275             Throws :
276              
277             Comment :
278             See Also :
279              
280             =head2 flatten
281              
282             Usage : ->flatten()
283             Purpose : Returns an unblessed version of the data
284              
285             Returns : hashref of brick data
286             Argument :
287             Throws :
288              
289             Comment :
290             See Also :
291              
292             =head1 BUGS
293              
294             =head1 SUPPORT
295              
296             =head1 AUTHOR
297              
298             Travis Chase
299             CPAN ID: GAUDEON
300             gaudeon@cpan.org
301             https://github.com/gaudeon/Lego-From-Png
302              
303             =head1 COPYRIGHT
304              
305             This program is free software licensed under the...
306              
307             The MIT License
308              
309             The full text of the license can be found in the
310             LICENSE file included with this module.
311              
312             =head1 SEE ALSO
313              
314             perl(1).
315              
316             =cut
317              
318             1;