File Coverage

blib/lib/Algorithm/EventsPerSecond.pm
Criterion Covered Total %
statement 75 75 100.0
branch 19 20 95.0
condition 9 9 100.0
subroutine 16 16 100.0
pod 7 7 100.0
total 126 127 99.2


line stmt bran cond sub pod time code
1             package Algorithm::EventsPerSecond;
2              
3 4     4   358306 use 5.006;
  4         17  
4 4     4   36 use strict;
  4         6  
  4         113  
5 4     4   19 use warnings;
  4         11  
  4         558  
6              
7             =head1 NAME
8              
9             Algorithm::EventsPerSecond - A sliding-window events-per-second rate counter with a optional XS backend for additional zoomies.
10              
11             =head1 VERSION
12              
13             Version 0.0.1
14              
15             =cut
16              
17             our $VERSION = '0.0.1';
18              
19             our $BACKEND;
20              
21             BEGIN {
22 4     4   15 $BACKEND = 'PP';
23 4 100       984 unless ( $ENV{ALGORITHM_EVENTSPERSECOND_PP} ) {
24 3         6 local $@;
25 3 50       8 if ( eval { require Algorithm::EventsPerSecond::XS; 1 } ) {
  3         1324  
  3         14  
26 3         2950 $BACKEND = 'XS';
27             }
28             }
29             }
30              
31             =head1 SYNOPSIS
32              
33             use Algorithm::EventsPerSecond;
34              
35             my $meter = Algorithm::EventsPerSecond->new( window => 10 ); # 10-second window
36              
37             while (my $event = get_next_event()) {
38             $meter->mark; # record one event
39             # $meter->mark(5); # or record several at once
40              
41             printf "current rate: %.2f events/sec\n", $meter->rate;
42             }
43              
44             print "events seen in window: ", $meter->count, "\n";
45             print "lifetime total: ", $meter->total, "\n";
46              
47              
48             =head1 DESCRIPTION
49              
50             Algorithm::EventsPerSecond keeps per-second counts in a fixed-size ring buffer and
51             reports the average event rate over the most recent N seconds (the
52             "window"). Memory use is constant regardless of event volume, and both
53             C and C are O(1) averaged out over time.
54              
55             =head1 METHODS
56              
57             =head2 new( window => $seconds )
58              
59             Construct a meter. C is the length of the averaging window in
60             seconds and defaults to 60.
61              
62             =cut
63              
64             sub new {
65 41     41 1 17555 my ($class, %args) = @_;
66              
67 41   100     128 my $window = $args{window} // 60;
68 41 100 100     404 die "window must be a positive integer" unless $window =~ /^\d+$/ && $window > 0;
69              
70 33         84 my $self = {
71             window => $window,
72             total => 0, # lifetime event count
73             started => time(),
74             };
75              
76 33 100       172 if ( $BACKEND eq 'XS' ) {
77             # packed int64_t ring buffers, scanned in C
78 17         50 $self->{buckets} = "\0" x ( $window * 8 );
79 17         35 $self->{stamps} = "\0" x ( $window * 8 );
80             }
81             else {
82 16         48 $self->{buckets} = [ (0) x $window ]; # counts, indexed by (epoch_sec % window)
83 16         49 $self->{stamps} = [ (0) x $window ]; # epoch second each bucket belongs to
84             }
85              
86 33         98 return bless $self, $class;
87             }
88              
89             # Internal, PP backend: get the bucket for the current second, clearing it if stale.
90             sub _bucket_index {
91 1285     1285   1458 my ($self, $now_sec) = @_;
92 1285         1502 my $i = $now_sec % $self->{window};
93 1285 100       1780 if ($self->{stamps}[$i] != $now_sec) {
94 1280         1469 $self->{buckets}[$i] = 0;
95 1280         1360 $self->{stamps}[$i] = $now_sec;
96             }
97 1285         1442 return $i;
98             }
99              
100             =head2 mark( [$count] )
101              
102             Record one event, or C<$count> events. Returns the meter object, so calls
103             can be chained.
104              
105             =cut
106              
107             sub _mark_pp {
108 1285     1285   11178 my ($self, $count) = @_;
109 1285   100     1691 $count //= 1;
110              
111 1285         1614 my $now_sec = int(time());
112 1285         2671 my $i = $self->_bucket_index($now_sec);
113              
114 1285         1481 $self->{buckets}[$i] += $count;
115 1285         1355 $self->{total} += $count;
116              
117 1285         1516 return $self;
118             }
119              
120             sub _mark_xs {
121 1288     1288   10589 my ($self, $count) = @_;
122 1288   100     1670 $count //= 1;
123              
124             Algorithm::EventsPerSecond::XS::_xs_mark(
125             $self->{buckets}, $self->{stamps},
126 1288         1782 $self->{window}, int(time()), $count,
127             );
128 1288         2684 $self->{total} += $count;
129              
130 1288         1358 return $self;
131             }
132              
133             =head2 count
134              
135             Number of events recorded within the current window.
136              
137             =cut
138              
139             sub _count_pp {
140 1615     1615   128111 my ($self) = @_;
141              
142 1615         2103 my $now_sec = int(time());
143 1615         3509 my $window = $self->{window};
144 1615         1735 my $oldest = $now_sec - $window + 1;
145              
146 1615         1576 my $sum = 0;
147 1615         2078 for my $i (0 .. $window - 1) {
148             $sum += $self->{buckets}[$i]
149 26510 100       36405 if $self->{stamps}[$i] >= $oldest;
150             }
151 1615         2241 return $sum;
152             }
153              
154             sub _count_xs {
155 1616     1616   121519 my ($self) = @_;
156              
157 1616         2025 my $now_sec = int(time());
158             return Algorithm::EventsPerSecond::XS::_xs_count(
159             $self->{buckets}, $self->{stamps},
160 1616         4651 $self->{window}, $now_sec - $self->{window} + 1,
161             );
162             }
163              
164             if ( $BACKEND eq 'XS' ) {
165             *mark = \&_mark_xs;
166             *count = \&_count_xs;
167             }
168             else {
169             *mark = \&_mark_pp;
170             *count = \&_count_pp;
171             }
172              
173             =head2 rate
174              
175             Average events per second over the window. If the meter has been alive
176             for less time than the window, the elapsed lifetime is used instead, so
177             early readings are not artificially deflated.
178              
179             =cut
180              
181             sub rate {
182 10     10 1 22 my ($self) = @_;
183              
184 10         20 my $elapsed = time() - $self->{started};
185 10 100       37 my $span = $elapsed < $self->{window} ? $elapsed : $self->{window};
186 10 100       30 return 0 if $span <= 0;
187              
188 6         11 return $self->count / $span;
189             }
190              
191             =head2 total
192              
193             Lifetime count of all events ever recorded, regardless of window.
194              
195             =cut
196              
197 3215     3215 1 7268 sub total { $_[0]->{total} }
198              
199             =head2 window
200              
201             The configured window length in seconds.
202              
203             =cut
204              
205 4     4 1 768 sub window { $_[0]->{window} }
206              
207             =head2 reset
208              
209             Clear all counts and restart the clock. Returns the meter object.
210              
211             =cut
212              
213             sub reset {
214 2     2 1 13 my ($self) = @_;
215 2 100       9 if ( $BACKEND eq 'XS' ) {
216 1         4 $self->{buckets} = "\0" x ( $self->{window} * 8 );
217 1         3 $self->{stamps} = "\0" x ( $self->{window} * 8 );
218             }
219             else {
220 1         3 @{ $self->{buckets} } = (0) x $self->{window};
  1         4  
221 1         3 @{ $self->{stamps} } = (0) x $self->{window};
  1         3  
222             }
223 2         5 $self->{total} = 0;
224 2         6 $self->{started} = time();
225 2         11 return $self;
226             }
227              
228             =head2 backend
229              
230             Returns C<'XS'> when the accelerated backend is in use, C<'PP'> for the
231             pure Perl fallback. May be called as a class or instance method.
232              
233             =cut
234              
235 3     3 1 399297 sub backend { $BACKEND }
236              
237             =head2 simd
238              
239             Returns which SIMD flavor the XS backend was compiled with: C<'AVX2'>,
240             C<'SSE4.2'>, or C<'scalar'> (plain C, left to the compiler's
241             auto-vectorizer). Returns undef when the pure Perl backend is in use.
242              
243             =cut
244              
245             sub simd {
246 4 100   4 1 24 return undef unless $BACKEND eq 'XS';
247 3         17 return Algorithm::EventsPerSecond::XS::_xs_simd();
248             }
249              
250             =head1 ACCELERATION
251              
252             If a working C compiler is available at install time, an accelerated XS
253             backend, L, is built and loaded
254             automatically. It keeps the ring buffer in packed C buffers and
255             scans the window in C, using SIMD (AVX2 or SSE4.2) when the compiler
256             targets a CPU that has it. If the backend cannot be loaded for any
257             reason (not built, no compiler at install time), a pure Perl
258             implementation with identical behavior is used instead.
259              
260             The following control this.
261              
262             =head2 IF_OPT
263              
264             Environment variable read by C: the C<-O> optimization
265             value used when compiling the XS backend during install. C
266             (or C) compiles with C<-O2>. The default is C<-O3>.
267              
268             =head2 IF_ARCH
269              
270             Environment variable read by C: optionally sets the
271             architecture used for the build during the install. C
272             (or C) compiles with C<-march=native>, enabling
273             the SIMD paths the build host supports. When unset the compiler's
274             baseline architecture is used.
275              
276             =head2 PUREPERL_ONLY
277              
278             C skips building the XS backend.
279              
280             =head2 ALGORITHM_EVENTSPERSECOND_PP
281              
282             Environment variable read at runtime: when true, skip the XS backend
283             entirely and use pure Perl.
284              
285             Which backend is in use can be checked via L and L.
286              
287             =head1 AUTHOR
288              
289             Zane C. Bowers-Hadley, C<< >>
290              
291             =head1 BUGS
292              
293             Please report any bugs or feature requests to C, or through
294             the web interface at L. I will be notified, and then you'll
295             automatically be notified of progress on your bug as I make changes.
296              
297              
298              
299              
300             =head1 SUPPORT
301              
302             You can find documentation for this module with the perldoc command.
303              
304             perldoc Algorithm::EventsPerSecond
305              
306              
307             You can also look for information at:
308              
309             =over 4
310              
311             =item * RT: CPAN's request tracker (report bugs here)
312              
313             L
314              
315             =item * CPAN Ratings
316              
317             L
318              
319             =item * Search CPAN
320              
321             L
322              
323             =back
324              
325              
326             =head1 ACKNOWLEDGEMENTS
327              
328              
329             =head1 LICENSE AND COPYRIGHT
330              
331             This software is Copyright (c) 2026 by Zane C. Bowers-Hadley.
332              
333             This is free software, licensed under:
334              
335             The GNU Lesser General Public License, Version 2.1, February 1999
336              
337              
338             =cut
339              
340             1; # End of Algorithm::EventsPerSecond