File Coverage

blib/lib/Box/Calc/Box.pm
Criterion Covered Total %
statement 88 91 96.7
branch 13 14 92.8
condition 2 2 100.0
subroutine 21 21 100.0
pod 10 11 90.9
total 134 139 96.4


line stmt bran cond sub pod time code
1             package Box::Calc::Box;
2             $Box::Calc::Box::VERSION = '1.0206';
3 11     11   357775 use strict;
  11         214  
  11         328  
4 11     11   50 use warnings;
  11         19  
  11         303  
5 11     11   1581 use Moose;
  11         1204933  
  11         77  
6 11     11   74327 use Storable qw(dclone);
  11         34872  
  11         873  
7             with 'Box::Calc::Role::Container';
8             with 'Box::Calc::Role::Mailable';
9 11     11   5705 use Box::Calc::Layer;
  11         4002  
  11         537  
10 11     11   6367 use Data::GUID;
  11         48508  
  11         52  
11 11     11   2053 use List::Util qw/sum/;
  11         23  
  11         713  
12 11     11   63 use Log::Any qw($log);
  11         19  
  11         106  
13 11     11   2527 use Data::Dumper;
  11         23  
  11         10371  
14              
15             =head1 NAME
16              
17             Box::Calc::Box - The container in which we pack items.
18              
19             =head1 VERSION
20              
21             version 1.0206
22              
23             =head1 SYNOPSIS
24              
25             my $box = Box::Calc::Box->new(name => 'Big Box', x => 12, y => 12, z => 18, weight => 20);
26              
27             =head1 METHODS
28              
29             =head2 new(params)
30              
31             Constructor.
32              
33             B<NOTE:> All boxes automatically have one empty L<Box::Calc::Layer> added to them.
34              
35             =over
36              
37             =item params
38              
39             =over
40              
41             =item name
42              
43             An identifying name for your box.
44              
45             =item x
46              
47             The interior width of your box.
48              
49             =item y
50              
51             The interior length of your box.
52              
53             =item z
54              
55             The interior thickness of your box.
56              
57             =item weight
58              
59             The weight of your box.
60              
61             =back
62              
63             =back
64              
65             =head2 fill_weight()
66              
67             Returns the weight of the items in this box.
68              
69             =cut
70              
71             has fill_weight => (
72             is => 'rw',
73             default => 0,
74             isa => 'Num',
75             );
76              
77             =head2 fill_x()
78              
79             Returns how full the box is in the C<x> dimension.
80              
81             =cut
82              
83             sub fill_x {
84 89     89 1 213 my $self = shift;
85 89         202 my $value = 0;
86 89         155 foreach my $layer (@{$self->layers}) {
  89         2074  
87 1549 100       3472 $value = $layer->fill_x if $layer->fill_x > $value;
88             }
89 89         620 return sprintf ("%.4f", $value);
90             }
91              
92             =head2 fill_y()
93              
94             Returns how full the box is in the C<y> dimension.
95              
96             =cut
97              
98             sub fill_y {
99 89     89 1 189 my $self = shift;
100 89         170 my $value = 0;
101 89         175 foreach my $layer (@{$self->layers}) {
  89         1959  
102 1549 100       3118 $value = $layer->fill_y if $layer->fill_y > $value;
103             }
104 89         701 return sprintf ("%.4f", $value);
105             }
106              
107             =head2 fill_z()
108              
109             Returns how full the box is in the C<z> dimension.
110              
111             =cut
112              
113             sub fill_z {
114 47570     47570 1 79238 my $self = shift;
115 47570         72545 my $value = 0;
116 47570         62208 foreach my $layer (@{$self->layers}) {
  47570         915104  
117 947470         1892615 $value += $layer->fill_z;
118             }
119 47570         1182028 return sprintf ("%.4f", $value);
120             }
121              
122             =head2 id()
123              
124             Returns a generated unique id for this box.
125              
126             =cut
127              
128             has id => (
129             is => 'ro',
130             default => sub { Data::GUID->new->as_string },
131             );
132              
133             =head2 name()
134              
135             Returns the name of the box.
136              
137             =cut
138              
139             has name => (
140             is => 'ro',
141             isa => 'Str',
142             required => 1,
143             );
144              
145             =head2 layers()
146              
147             Returns an array reference of the L<Box::Calc::Layer>s in this box.
148              
149             =cut
150              
151             has layers => (
152             is => 'rw',
153             isa => 'ArrayRef[Box::Calc::Layer]',
154             default => sub { [] },
155             traits => ['Array'],
156             handles => {
157             count_layers => 'count',
158             }
159             );
160              
161             =head2 void_weight()
162              
163             Returns the weight assigned to the void space left in the box due to void space filler such as packing peanuts. Defaults to 70% of the box weight.
164              
165             =cut
166              
167             has void_weight => (
168             is => 'rw',
169             lazy => 1,
170             default => sub {
171             my $self = shift;
172             return $self->weight * 0.7;
173             }
174             );
175              
176             =head2 calculate_weight()
177              
178             Calculates and returns the weight of all the layers in this box, including the weight of this box and any packing filler (see L<void_weight>).
179              
180             =cut
181              
182             sub calculate_weight {
183 46231     46231 1 83299 my $self = shift;
184 46231         979068 return $self->weight + $self->void_weight + $self->fill_weight;
185             }
186              
187             =head2 create_layer()
188              
189             Adds a new L<Box::Calc::Layer> to this box.
190              
191             =cut
192              
193             sub create_layer {
194 1311     1311 1 3125 my $self = shift;
195 1311         2347 push @{$self->layers}, Box::Calc::Layer->new( max_x => $self->x, max_y => $self->y, );
  1311         28684  
196             }
197              
198             sub BUILD {
199 65     65 0 224 my $self = shift;
200 65         217 $self->create_layer;
201             }
202              
203             =head2 pack_item(item)
204              
205             Add a L<Box::Calc::Item> to this box.
206              
207             Returns 1 on success or 0 on failure.
208              
209             =over
210              
211             =item item
212              
213             The L<Box::Calc::Item> instance you want to add to this box.
214              
215             =back
216              
217             =cut
218              
219             sub pack_item {
220 46184     46184 1 134529 my ($self, $item, $count) = @_;
221 46184   100     155246 $count ||= 1;
222 46184 50       106538 if ($count > 5) {
223 0         0 $log->warn($item->{name}.' is causing infinite recursion in Box::Calc');
224 0         0 $log->debug(Dumper($item));
225 0         0 return 0;
226             }
227 46184 100       982551 if ($item->weight + $self->calculate_weight >= $self->max_weight) {
228 1         7 $log->info($item->{name}.' would make this box weigh too much, requesting new box.');
229 1         6 return 0;
230             }
231             # item height > ( box height - box fill + the height of the current layer )
232 46183 100       935098 if ($item->z > $self->z - $self->fill_z + $self->layers->[-1]->fill_z) {
233 1         10 $log->info($item->{name}.' would make the layer too tall to fit in the box, requesting new box.');
234 1         7 return 0;
235             }
236 46182 100       943168 if ($self->layers->[-1]->pack_item($item)) {
237 44886         993923 $self->fill_weight($self->fill_weight + $item->weight);
238 44886         254722 return 1;
239             }
240             else {
241 1296 100       29475 if ($item->z > $self->z - $self->fill_z) {
242 50         465 $log->info($item->{name}.' is too big to create another layer in this box, requesting another box.');
243 50         400 return 0;
244             }
245             else {
246 1246         5879 $self->create_layer;
247 1246         7140 return $self->pack_item($item, $count + 1);
248             }
249             }
250             }
251              
252             =head2 packing_list()
253              
254             Returns a scalar with the weight of the box and a hash reference of all the items in this box.
255              
256             =cut
257              
258             sub packing_list {
259 39     39 1 43684 my $self = shift;
260 39         977 my $weight = $self->weight;
261 39         74 my $list = {};
262 39         48 foreach my $layer (@{$self->layers}) {
  39         889  
263 766         2091 $layer->packing_list(\$weight, $list)
264             }
265 39         278 return ($weight, $list);
266             }
267              
268             =head2 packing_instructions()
269              
270             Returns a description of the box. Example:
271              
272             {
273             x => 5,
274             y => 6,
275             z => 3,
276             fill_x => 4,
277             fill_y => '5.1',
278             fill_z => 2,
279             name => 'The Big Box',
280             layers => [ ... ],
281             id => 'xxx',
282             weight => '6',
283             calculated_weight => '12.35',
284             }
285              
286             =cut
287              
288             sub packing_instructions {
289 44     44 1 91 my $self = shift;
290             return {
291             x => $self->x,
292             y => $self->y,
293             z => $self->z,
294             fill_x => $self->fill_x,
295             fill_y => $self->fill_y,
296             fill_z => $self->fill_z,
297             name => $self->name,
298             id => $self->id,
299             weight => $self->weight,
300             calculated_weight => $self->calculate_weight,
301             used_volume => $self->used_volume,
302             fill_volume => $self->fill_volume,
303             volume => $self->volume,
304 44         1176 layers => [map { $_->packing_instructions } @{ $self->layers }],
  774         2514  
  44         903  
305             };
306             }
307              
308             =head2 used_volume
309              
310             Returns the real used volume for this box.
311              
312             =cut
313              
314             sub used_volume {
315 44     44 1 91 my $self = shift;
316 44         65 return sum map { $_->used_volume } @{ $self->layers };
  774         2116  
  44         907  
317             }
318              
319             =head2 fill_volume
320              
321             Returns the exact volume needed for this box.
322              
323             =cut
324              
325             sub fill_volume {
326 44     44 1 206 return $_[0]->fill_x * $_[0]->fill_y * $_[0]->fill_z;
327             }
328              
329 11     11   96 no Moose;
  11         22  
  11         111  
330             __PACKAGE__->meta->make_immutable;
331              
332             =for Pod::Coverage BUILD