File Coverage

blib/lib/Box/Calc/Box.pm
Criterion Covered Total %
statement 87 90 96.6
branch 13 14 92.8
condition 2 2 100.0
subroutine 20 20 100.0
pod 9 10 90.0
total 131 136 96.3


line stmt bran cond sub pod time code
1             package Box::Calc::Box;
2             $Box::Calc::Box::VERSION = '1.0201';
3 9     9   145409 use strict;
  9         34  
  9         284  
4 9     9   45 use warnings;
  9         19  
  9         240  
5 9     9   983 use Moose;
  9         838576  
  9         89  
6 9     9   68084 use Storable qw(dclone);
  9         28403  
  9         708  
7             with 'Box::Calc::Role::Container';
8             with 'Box::Calc::Role::Mailable';
9 9     9   4485 use Box::Calc::Layer;
  9         3949  
  9         388  
10 9     9   4533 use Data::GUID;
  9         40596  
  9         50  
11 9     9   1862 use List::Util qw/sum/;
  9         24  
  9         547  
12 9     9   59 use Log::Any qw($log);
  9         55  
  9         85  
13 9     9   2261 use Data::Dumper;
  9         21  
  9         8818  
14              
15             =head1 NAME
16              
17             Box::Calc::Box - The container in which we pack items.
18              
19             =head1 VERSION
20              
21             version 1.0201
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 21     21 1 47 my $self = shift;
85 21         45 my $value = 0;
86 21         51 foreach my $layer (@{$self->layers}) {
  21         514  
87 273 100       720 $value = $layer->fill_x if $layer->fill_x > $value;
88             }
89 21         142 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 21     21 1 48 my $self = shift;
100 21         42 my $value = 0;
101 21         39 foreach my $layer (@{$self->layers}) {
  21         530  
102 273 100       627 $value = $layer->fill_y if $layer->fill_y > $value;
103             }
104 21         136 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 18373     18373 1 29921 my $self = shift;
115 18373         22413 my $value = 0;
116 18373         22031 foreach my $layer (@{$self->layers}) {
  18373         372111  
117 343897         711046 $value += $layer->fill_z;
118             }
119 18373         452659 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 17842     17842 1 29528 my $self = shift;
184 17842         387190 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 544     544 1 1431 my $self = shift;
195 544         949 push @{$self->layers}, Box::Calc::Layer->new( max_x => $self->x, max_y => $self->y, );
  544         12885  
196             }
197              
198             sub BUILD {
199 34     34 0 86 my $self = shift;
200 34         129 $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 17820     17820 1 63515 my ($self, $item, $count) = @_;
221 17820   100     55139 $count ||= 1;
222 17820 50       34446 if ($count > 99) {
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 17820 100       400387 if ($item->weight + $self->calculate_weight >= $self->max_weight) {
228 1         8 $log->info($item->{name}.' would make this box weigh too much, requesting new box.');
229 1         5 return 0;
230             }
231             # item height > ( box height - box fill + the height of the current layer )
232 17819 100       384728 if ($item->z > $self->z - $self->fill_z + $self->layers->[-1]->fill_z) {
233 1         9 $log->info($item->{name}.' would make the layer too tall to fit in the box, requesting new box.');
234 1         8 return 0;
235             }
236 17818 100       383289 if ($self->layers->[-1]->pack_item($item)) {
237 17287         384960 $self->fill_weight($self->fill_weight + $item->weight);
238 17287         67821 return 1;
239             }
240             else {
241 531 100       13128 if ($item->z > $self->z - $self->fill_z) {
242 21         165 $log->info($item->{name}.' is too big to create another layer in this box, requesting another box.');
243 21         146 return 0;
244             }
245             else {
246 510         2123 $self->create_layer;
247 510         2374 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 15     15 1 41134 my $self = shift;
260 15         413 my $weight = $self->weight;
261 15         36 my $list = {};
262 15         28 foreach my $layer (@{$self->layers}) {
  15         368  
263 264         754 $layer->packing_list(\$weight, $list)
264             }
265 15         89 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 20     20 1 49 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             volume => $self->volume,
303 20         620 layers => [map { $_->packing_instructions } @{ $self->layers }],
  272         746  
  20         471  
304             };
305             }
306              
307             =head2 used_volume
308              
309             Returns the real used volume for this box.
310              
311             =cut
312              
313             sub used_volume {
314 20     20 1 48 my $self = shift;
315 20         40 return sum map { $_->used_volume } @{ $self->layers };
  272         686  
  20         476  
316             }
317              
318             =head2 volume
319              
320             Returns the exact volume needed for this box.
321              
322             =cut
323              
324             sub volume {
325             return $_[0]->fill_x * $_[0]->fill_y * $_[0]->fill_z;
326             }
327              
328 9     9   77 no Moose;
  9         42  
  9         72  
329             __PACKAGE__->meta->make_immutable;
330              
331             =for Pod::Coverage BUILD