File Coverage

blib/lib/VLGal/Size.pm
Criterion Covered Total %
statement 42 66 63.6
branch 12 38 31.5
condition 8 27 29.6
subroutine 9 15 60.0
pod 9 9 100.0
total 80 155 51.6


line stmt bran cond sub pod time code
1             package VLGal::Size;
2              
3 1     1   13 use 5.006;
  1         2  
  1         29  
4 1     1   4 use strict;
  1         8  
  1         27  
5 1     1   5 use warnings;
  1         1  
  1         28  
6 1     1   5 use Error qw(:try);
  1         2  
  1         5  
7              
8             # Used by _value_is_allowed
9             our %ALLOW_ISA = (
10             );
11              
12             # Used by _value_is_allowed
13             our %ALLOW_REF = (
14             );
15              
16             # Used by _value_is_allowed
17             our %ALLOW_RX = (
18             'max_height' => [ '^\d*$' ],
19             'max_width' => [ '^\d*$' ],
20             );
21              
22             # Used by _value_is_allowed
23             our %ALLOW_VALUE = (
24             );
25              
26             # Package version
27             our ($VERSION) = '$Revision: 0.01 $' =~ /\$Revision:\s+([^\s]+)/;
28              
29             =head1 NAME
30              
31             VLGal::Size - Size for Vincenzo's little gallery items
32              
33             =head1 SYNOPSIS
34              
35             TODO
36              
37             =head1 ABSTRACT
38              
39             Size for Vincenzo's little gallery items
40              
41             =head1 DESCRIPTION
42              
43             C contains size attributes for gallery items.
44              
45             =head1 CONSTRUCTOR
46              
47             =over
48              
49             =item new( [ OPT_HASH_REF ] )
50              
51             Creates a new C object. C is a hash reference used to pass initialization options. On error an exception C is thrown.
52              
53             Options for C may include:
54              
55             =over
56              
57             =item B>
58              
59             Passed to L.
60              
61             =item B>
62              
63             Passed to L.
64              
65             =item B>
66              
67             Passed to L.
68              
69             =item B>
70              
71             Passed to L.
72              
73             =back
74              
75             =back
76              
77             =head1 METHODS
78              
79             =over
80              
81             =item get_basename()
82              
83             Returns the basename of the directory containing item's from its size.
84              
85             =item get_label()
86              
87             Returns the label of the directory containing item's from its size.
88              
89             =item get_max_height()
90              
91             Returns the item's maximal height.
92              
93             =item get_max_width()
94              
95             Returns the item's maximal width.
96              
97             =item set_basename(VALUE)
98              
99             Set the basename of the directory containing item's from its size. C is the value. On error an exception C is thrown.
100              
101             =item set_label(VALUE)
102              
103             Set the label of the directory containing item's from its size. C is the value. On error an exception C is thrown.
104              
105             =item set_max_height(VALUE)
106              
107             Set the item's maximal height. C is the value. On error an exception C is thrown.
108              
109             =over
110              
111             =item VALUE must match regular expression:
112              
113             =over
114              
115             =item ^\d*$
116              
117             =back
118              
119             =back
120              
121             =item set_max_width(VALUE)
122              
123             Set the item's maximal width. C is the value. On error an exception C is thrown.
124              
125             =over
126              
127             =item VALUE must match regular expression:
128              
129             =over
130              
131             =item ^\d*$
132              
133             =back
134              
135             =back
136              
137             =back
138              
139             =head1 SEE ALSO
140              
141             L,
142             L,
143             L,
144             L,
145             L
146              
147             =head1 BUGS
148              
149             None known (yet.)
150              
151             =head1 HISTORY
152              
153             First development: September 2003
154             Last update: October 2003
155              
156             =head1 AUTHOR
157              
158             Vincenzo Zocca
159              
160             =head1 COPYRIGHT
161              
162             Copyright 2003 by Vincenzo Zocca
163              
164             =head1 LICENSE
165              
166             This file is part of the C module hierarchy for Perl by
167             Vincenzo Zocca.
168              
169             The VLGal module hierarchy is free software; you can redistribute it
170             and/or modify it under the terms of the GNU General Public License
171             as published by the Free Software Foundation; either version 2 of
172             the License, or (at your option) any later version.
173              
174             The VLGal module hierarchy is distributed in the hope that it will
175             be useful, but WITHOUT ANY WARRANTY; without even the implied
176             warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
177             See the GNU General Public License for more details.
178              
179             You should have received a copy of the GNU General Public License
180             along with the VLGal module hierarchy; if not, write to
181             the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
182             Boston, MA 02111-1307 USA
183              
184             =cut
185              
186             sub new {
187 8     8 1 24 my $class = shift;
188              
189 8         10 my $self = {};
190 8   33     37 bless( $self, ( ref($class) || $class ) );
191 8         19 return( $self->_initialize(@_) );
192             }
193              
194             sub _initialize {
195 8     8   33 my $self = shift;
196 8 50       15 my $opt = defined($_[0]) ? shift : {};
197              
198             # Check $opt
199 8 50       50 ref($opt) eq 'HASH' || throw Error::Simple("ERROR: VLGal::Size::_initialize, first argument must be 'HASH' reference.");
200              
201             # basename, SINGLE
202 8 50       14 exists( $opt->{basename} ) && $self->set_basename( $opt->{basename} );
203              
204             # label, SINGLE
205 8 50       17 exists( $opt->{label} ) && $self->set_label( $opt->{label} );
206              
207             # max_height, SINGLE
208 8 50       25 exists( $opt->{max_height} ) && $self->set_max_height( $opt->{max_height} );
209              
210             # max_width, SINGLE
211 8 50       25 exists( $opt->{max_width} ) && $self->set_max_width( $opt->{max_width} );
212              
213             # Return $self
214 8         38 return($self);
215             }
216              
217             sub _value_is_allowed {
218 16     16   19 my $name = shift;
219              
220             # Value is allowed if no ALLOW clauses exist for the named attribute
221 16 0 33     71 if ( ! exists( $ALLOW_ISA{$name} ) && ! exists( $ALLOW_REF{$name} ) && ! exists( $ALLOW_RX{$name} ) && ! exists( $ALLOW_VALUE{$name} ) ) {
      33        
      33        
222 0         0 return(1);
223             }
224              
225             # At this point, all values in @_ must to be allowed
226             CHECK_VALUES:
227 16         29 foreach my $val (@_) {
228             # Check ALLOW_ISA
229 16 50 33     30 if ( ref($val) && exists( $ALLOW_ISA{$name} ) ) {
230 0         0 foreach my $class ( @{ $ALLOW_ISA{$name} } ) {
  0         0  
231 0 0       0 &UNIVERSAL::isa( $val, $class ) && next CHECK_VALUES;
232             }
233             }
234              
235             # Check ALLOW_REF
236 16 50 33     30 if ( ref($val) && exists( $ALLOW_REF{$name} ) ) {
237 0 0       0 exists( $ALLOW_REF{$name}{ ref($val) } ) && next CHECK_VALUES;
238             }
239              
240             # Check ALLOW_RX
241 16 50 33     85 if ( defined($val) && ! ref($val) && exists( $ALLOW_RX{$name} ) ) {
      33        
242 16         14 foreach my $rx ( @{ $ALLOW_RX{$name} } ) {
  16         25  
243 16 50       104 $val =~ /$rx/ && next CHECK_VALUES;
244             }
245             }
246              
247             # Check ALLOW_VALUE
248 0 0 0     0 if ( ! ref($val) && exists( $ALLOW_VALUE{$name} ) ) {
249 0 0       0 exists( $ALLOW_VALUE{$name}{$val} ) && next CHECK_VALUES;
250             }
251              
252             # We caught a not allowed value
253 0         0 return(0);
254             }
255              
256             # OK, all values are allowed
257 16         40 return(1);
258             }
259              
260             sub get_basename {
261 0     0 1 0 my $self = shift;
262              
263 0         0 return( $self->{VLGal_Size}{basename} );
264             }
265              
266             sub get_label {
267 0     0 1 0 my $self = shift;
268              
269 0         0 return( $self->{VLGal_Size}{label} );
270             }
271              
272             sub get_max_height {
273 0     0 1 0 my $self = shift;
274              
275 0         0 return( $self->{VLGal_Size}{max_height} );
276             }
277              
278             sub get_max_width {
279 0     0 1 0 my $self = shift;
280              
281 0         0 return( $self->{VLGal_Size}{max_width} );
282             }
283              
284             sub set_basename {
285 0     0 1 0 my $self = shift;
286 0         0 my $val = shift;
287              
288             # Check if isa/ref/rx/value is allowed
289 0 0       0 &_value_is_allowed( 'basename', $val ) || throw Error::Simple("ERROR: VLGal::Size::set_basename, the specified value '$val' is not allowed.");
290              
291             # Assignment
292 0         0 $self->{VLGal_Size}{basename} = $val;
293             }
294              
295             sub set_label {
296 0     0 1 0 my $self = shift;
297 0         0 my $val = shift;
298              
299             # Check if isa/ref/rx/value is allowed
300 0 0       0 &_value_is_allowed( 'label', $val ) || throw Error::Simple("ERROR: VLGal::Size::set_label, the specified value '$val' is not allowed.");
301              
302             # Assignment
303 0         0 $self->{VLGal_Size}{label} = $val;
304             }
305              
306             sub set_max_height {
307 8     8 1 8 my $self = shift;
308 8         9 my $val = shift;
309              
310             # Check if isa/ref/rx/value is allowed
311 8 50       13 &_value_is_allowed( 'max_height', $val ) || throw Error::Simple("ERROR: VLGal::Size::set_max_height, the specified value '$val' is not allowed.");
312              
313             # Assignment
314 8         27 $self->{VLGal_Size}{max_height} = $val;
315             }
316              
317             sub set_max_width {
318 8     8 1 9 my $self = shift;
319 8         7 my $val = shift;
320              
321             # Check if isa/ref/rx/value is allowed
322 8 50       14 &_value_is_allowed( 'max_width', $val ) || throw Error::Simple("ERROR: VLGal::Size::set_max_width, the specified value '$val' is not allowed.");
323              
324             # Assignment
325 8         19 $self->{VLGal_Size}{max_width} = $val;
326             }
327              
328             1;