File Coverage

lib/Array/FIFO.pm
Criterion Covered Total %
statement 16 16 100.0
branch 1 2 50.0
condition n/a
subroutine 5 5 100.0
pod n/a
total 22 23 95.6


line stmt bran cond sub pod time code
1             package Array::FIFO;
2             $Array::FIFO::VERSION = '0.13';
3 1     1   151209 use Moose;
  1         476424  
  1         6  
4 1     1   7677 use List::Util qw(sum0);
  1         2  
  1         86  
5              
6 1     1   647 use namespace::autoclean;
  1         8197  
  1         4  
7              
8              
9             =head1 NAME
10              
11             Array::FIFO - A Simple limitable FIFO array, with sum and average methods
12              
13             =head1 VERSION
14              
15             version 0.13
16              
17             =head1 SYNOPSIS
18              
19             my $ar = Array::FIFO->new( limit => 12 );
20             $ar->add( 20 );
21             $ar->add( 18 );
22             $ar->add( 22 );
23              
24             say $ar->average;
25              
26             =head1 DESCRIPTION
27              
28             Array::FIFO is meant to be a simple limitable array, for storing data in a FIFO
29             manner; with an optional limit to how large the array can get. When the limit is
30             reached, the oldest value is returned by C<add> when new values are added.
31              
32             It's intent is for numeric values (i.e. current load of a system), but it should work
33             for other data types if you're not in need of the calculation methods.
34              
35             The C<sum> and C<average> methods return the current sum and average of the
36             data as you would expect. It does this on once, then caches the result until
37             the array changes.
38              
39              
40             =head1 METHODS
41              
42             =head2 C<new>
43              
44             =over 4
45              
46             =item C<limit> (optional)
47              
48             Numeric value of how large the array is allowed to get. When it reaches
49             limit, every item added causes the oldest item to be removed.
50              
51             If no value is passed, there is no max size.
52              
53              
54             =back
55              
56             =head2 C<add>
57              
58             $ar->add( 99 );
59              
60             You can add any type of item to the array; if it's not a number it will be
61             treated as a value of 0 when when calculating sum() and average().
62              
63             Returns the oldest element in the array.
64              
65             =head2 C<remove>
66              
67             $ar->remove;
68              
69             Remove the oldest item on the array.
70              
71             =head2 C<queue>
72              
73             $ar->queue;
74              
75             Reference directly the fifo array.
76              
77             =head2 C<size>
78              
79             $ar->size;
80              
81             How many elements are in the array.
82              
83             =head2 C<limit>
84              
85             $ar->limit;
86              
87             The maximum size the array is allowed to be.
88              
89             =head2 C<sum>
90              
91             $ar->sum;
92              
93             The sum of all numeric elements in the array.
94              
95             =head2 C<average>
96              
97             $ar->average;
98              
99             The average of all numeric elements in the array.
100              
101             =head1 AUTHOR
102              
103             Dan Burke C<< dburke at addictmud.org >>
104              
105             =head1 BUGS
106              
107             If you encounter any bugs, or have feature requests, please create an issue
108             on github. https://github.com/dwburke/perl-Array-FIFO/issues
109              
110             =head1 LICENSE AND COPYRIGHT
111              
112             L<http://www.perlfoundation.org/artistic_license_2_0>
113              
114             =cut
115              
116              
117             has limit => ( is => 'rw', isa => 'Int', default => -1 );
118              
119             has queue => (
120             is => 'rw',
121             isa => 'ArrayRef[Item]',
122             traits => [ 'Array' ],
123             default => sub { [ ] },
124             handles => {
125             add => 'push',
126             remove => 'shift',
127             size => 'count',
128             },
129             trigger => sub {
130             my $self = shift;
131              
132             if ($self->{limit} > 0) {
133             my $array = $self->{queue};
134             while (@{ $array } > $self->{limit}) {
135             shift @{ $array };
136             }
137             }
138              
139             $self->clear_average;
140             $self->clear_sum;
141             },
142             );
143              
144             around add => sub {
145             my $orig = shift;
146             my $self = shift;
147              
148             my $last = $self->{queue}[0];
149              
150             $self->$orig( @_ );
151              
152             $last;
153             };
154              
155             has sum => ( is => 'rw', isa => 'Num', clearer => 'clear_sum' , lazy => 1, builder => '_build_sum' );
156             has average => ( is => 'rw', isa => 'Num', clearer => 'clear_average', lazy => 1, builder => '_build_average' );
157              
158              
159             sub _build_sum {
160 12     12   20 my $self = shift;
161              
162 12         18 sum0( grep /^-?\d+\.?\d*$/, @{ $self->queue } );
  12         281  
163             }
164              
165              
166             sub _build_average {
167 7     7   10 my $self = shift;
168              
169 7         158 my $sum = $self->sum;
170 7         207 my $size = $self->size;
171              
172 7 50       192 $sum ? ($sum / $size) : 0;
173             }
174              
175              
176              
177             __PACKAGE__->meta->make_immutable;
178              
179             1;