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