File Coverage

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


line stmt bran cond sub pod time code
1             package Acme::Array::MaxSize;
2              
3 2     2   61500 use 5.006;
  2         10  
4 2     2   8 use strict;
  2         3  
  2         29  
5 2     2   6 use warnings;
  2         3  
  2         49  
6              
7 2     2   676 use parent 'Tie::Array';
  2         462  
  2         8  
8 2     2   2482 use Carp;
  2         4  
  2         632  
9              
10             my %max_size;
11             my $last_index = sub { $max_size{+shift} - 1 };
12              
13              
14             sub TIEARRAY {
15 1     1   69 my ($class, $max_size) = @_;
16 1         2 my $self = bless [], $class;
17 1         9 $max_size{$self} = $max_size;
18 1         4 return $self
19             }
20              
21             sub STORE {
22 29     29   117 my ($self, $index, $value) = @_;
23 29 100       38 if ($index > $self->$last_index) {
24 4         241 carp 'Array too long';
25             return
26 4         190 }
27 25         58 $self->[$index] = $value;
28             }
29              
30             sub FETCH {
31 71     71   224 my ($self, $index) = @_;
32 71         166 $self->[$index]
33             }
34              
35             sub FETCHSIZE {
36 37     37   268 my $self = shift;
37 37         95 @$self
38             }
39              
40             sub STORESIZE {
41 6     6   639 my ($self, $count) = @_;
42 6 100       15 if ($count > $max_size{$self}) {
43 1         170 carp 'Array too long';
44 1         86 $count = $max_size{$self};
45             }
46 6         8 $#{$self} = $count - 1;
  6         23  
47             }
48              
49             sub SPLICE {
50 16     16   43 my ($self, $offset, $length, @list) = @_;
51 16 100       68 if ($offset > $max_size{$self}) {
52 1         58 carp 'Array too long';
53 1         50 return;
54             }
55              
56 15 100       32 if ($offset + $length > $max_size{$self}) {
57 2         119 carp 'Array too long';
58 2         108 $length = $max_size{$self} - $offset;
59             }
60              
61 15         19 my $asked = @$self - $length + @list;
62 15 100       30 if ($asked > $max_size{$self}) {
63 13         779 carp 'Array too long';
64 13 100       666 if ($offset == 0) {
65 4         12 splice @list, 0, $asked - $max_size{$self};
66             } else {
67 9         21 splice @list, $max_size{$self} - $asked;
68             }
69             }
70 15         45 $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.04
81              
82             =cut
83              
84             our $VERSION = '0.04';
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 * Search CPAN
154              
155             L
156              
157             =back
158              
159              
160             =head1 ACKNOWLEDGEMENTS
161              
162             Dedicated to L.
163              
164             =head1 LICENSE AND COPYRIGHT
165              
166             Copyright 2016-2022 E. Choroba.
167              
168             This program is free software; you can redistribute it and/or modify it
169             under the terms of the the Artistic License (2.0). You may obtain a
170             copy of the full license at:
171              
172             L
173              
174             Any use, modification, and distribution of the Standard or Modified
175             Versions is governed by this Artistic License. By using, modifying or
176             distributing the Package, you accept this license. Do not use, modify,
177             or distribute the Package, if you do not accept this license.
178              
179             If your Modified Version has been derived from a Modified Version made
180             by someone other than you, you are nevertheless required to ensure that
181             your Modified Version complies with the requirements of this license.
182              
183             This license does not grant you the right to use any trademark, service
184             mark, tradename, or logo of the Copyright Holder.
185              
186             This license includes the non-exclusive, worldwide, free-of-charge
187             patent license to make, have made, use, offer to sell, sell, import and
188             otherwise transfer the Package with respect to any patent claims
189             licensable by the Copyright Holder that are necessarily infringed by the
190             Package. If you institute patent litigation (including a cross-claim or
191             counterclaim) against any party alleging that the Package constitutes
192             direct or contributory patent infringement, then this Artistic License
193             to you shall terminate on the date that such litigation is filed.
194              
195             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
196             AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
197             THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
198             PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
199             YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
200             CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
201             CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
202             EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
203              
204              
205             =cut
206              
207             __PACKAGE__