File Coverage

blib/lib/Acme/Array/MaxSize.pm
Criterion Covered Total %
statement 45 47 95.7
branch 11 12 91.6
condition n/a
subroutine 11 11 100.0
pod n/a
total 67 70 95.7


line stmt bran cond sub pod time code
1             package Acme::Array::MaxSize;
2              
3 2     2   21378 use 5.006;
  2         6  
4 2     2   11 use strict;
  2         3  
  2         38  
5 2     2   10 use warnings;
  2         6  
  2         52  
6              
7 2     2   1401 use parent 'Tie::Array';
  2         561  
  2         11  
8 2     2   3954 use Carp;
  2         4  
  2         1000  
9              
10             my %max_size;
11             my $last_index = sub { $max_size{+shift} - 1 };
12              
13              
14             sub TIEARRAY {
15 1     1   10 my ($class, $max_size) = @_;
16 1         4 my $self = bless [], $class;
17 1         7 $max_size{$self} = $max_size;
18 1         4 return $self
19             }
20              
21             sub STORE {
22 29     29   134 my ($self, $index, $value) = @_;
23 29 100       159 if ($index > $self->$last_index) {
24 4         393 carp 'Array too long';
25             return
26 4         212 }
27 25         80 $self->[$index] = $value;
28             }
29              
30             sub FETCH {
31 68     68   239 my ($self, $index) = @_;
32 68         218 $self->[$index]
33             }
34              
35             sub FETCHSIZE {
36 36     36   298 my $self = shift;
37 36         117 @$self
38             }
39              
40             sub STORESIZE {
41 6     6   463 my ($self, $count) = @_;
42 6 100       21 if ($count > $max_size{$self}) {
43 1         173 carp 'Array too long';
44 1         81 $count = $max_size{$self};
45             }
46 6         10 $#{$self} = $count - 1;
  6         32  
47             }
48              
49             sub SPLICE {
50 15     15   48 my ($self, $offset, $length, @list) = @_;
51 15 50       51 if ($offset > $max_size{$self}) {
52 0         0 carp 'Array too long';
53 0         0 return;
54             }
55              
56 15 100       44 if ($offset + $length > $max_size{$self}) {
57 2         188 carp 'Array too long';
58 2         124 $length = $max_size{$self} - $offset;
59             }
60              
61 15         28 my $asked = @$self - $length + @list;
62 15 100       45 if ($asked > $max_size{$self}) {
63 13         1219 carp 'Array too long';
64 13 100       762 if ($offset == 0) {
65 4         14 splice @list, 0, $asked - $max_size{$self};
66             } else {
67 9         42 splice @list, $max_size{$self} - $asked;
68             }
69             }
70 15         50 $self->SUPER::SPLICE($offset, $length, @list);
71             }
72              
73              
74             =head1 NAME
75              
76             Acme::Array::MaxSize - Limit the maximal size your arrays can get.
77              
78             =head1 VERSION
79              
80             Version 0.02
81              
82             =cut
83              
84             our $VERSION = '0.02';
85              
86              
87             =head1 SYNOPSIS
88              
89             Your array will never grow bigger over a given limit.
90              
91             use Acme::Array::MaxSize;
92              
93             tie my @short, 'Acme::Array::MaxSize', 3;
94             @short = (1 .. 10);
95             print "@short"; # 1 2 3
96              
97             =head1 DETAILS
98              
99             When adding new elements, if the maximal size is reached, all other
100             elements are thrown away.
101              
102             tie my @short, 'Acme::Array::MaxSize', 3;
103             @short = ('a');
104             push @short, 'b' .. 'h';
105             print "@short"; # a b c
106              
107             Inserting elements at the B behaves differently,
108             though. Each C or C would insert the maximal possible number of elements B of the inserted list:
109              
110             tie my @short, 'Acme::Array::MaxSize', 3;
111             @short = ('a');
112             unshift @short, 'b' .. 'h';
113             print "@short"; # g h a
114              
115             =head1 AUTHOR
116              
117             E. Choroba, C<< >>
118              
119             =head1 BUGS
120              
121             Please report any bugs or feature requests to the GitHub repository
122             L, or
123             C, or through the web interface
124             at
125             L.
126             I will be notified, and then you'll automatically be notified of
127             progress on your bug as I make changes.
128              
129             =head1 SUPPORT
130              
131             You can find documentation for this module with the perldoc command.
132              
133             perldoc Acme::Array::MaxSize
134              
135              
136             You can also look for information at:
137              
138             =over 4
139              
140             =item * Meta CPAN
141              
142             L
143              
144             =item * GitHub Repository
145              
146             L
147              
148             =item * RT: CPAN's request tracker (report bugs here)
149              
150             L
151              
152             =item * AnnoCPAN: Annotated CPAN documentation
153              
154             L
155              
156             =item * CPAN Ratings
157              
158             L
159              
160             =item * Search CPAN
161              
162             L
163              
164             =back
165              
166              
167             =head1 ACKNOWLEDGEMENTS
168              
169             Dedicated to L.
170              
171             =head1 LICENSE AND COPYRIGHT
172              
173             Copyright 2016 E. Choroba.
174              
175             This program is free software; you can redistribute it and/or modify it
176             under the terms of the the Artistic License (2.0). You may obtain a
177             copy of the full license at:
178              
179             L
180              
181             Any use, modification, and distribution of the Standard or Modified
182             Versions is governed by this Artistic License. By using, modifying or
183             distributing the Package, you accept this license. Do not use, modify,
184             or distribute the Package, if you do not accept this license.
185              
186             If your Modified Version has been derived from a Modified Version made
187             by someone other than you, you are nevertheless required to ensure that
188             your Modified Version complies with the requirements of this license.
189              
190             This license does not grant you the right to use any trademark, service
191             mark, tradename, or logo of the Copyright Holder.
192              
193             This license includes the non-exclusive, worldwide, free-of-charge
194             patent license to make, have made, use, offer to sell, sell, import and
195             otherwise transfer the Package with respect to any patent claims
196             licensable by the Copyright Holder that are necessarily infringed by the
197             Package. If you institute patent litigation (including a cross-claim or
198             counterclaim) against any party alleging that the Package constitutes
199             direct or contributory patent infringement, then this Artistic License
200             to you shall terminate on the date that such litigation is filed.
201              
202             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
203             AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
204             THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
205             PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
206             YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
207             CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
208             CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
209             EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
210              
211              
212             =cut
213              
214             __PACKAGE__