view release on metacpan or search on metacpan
d) If a facility in the modified Library refers to a function or a
table of data to be supplied by an application program that uses
the facility, other than as an argument passed when the facility
is invoked, then you must make a good faith effort to ensure that,
in the event an application does not supply such function or
table, the facility still operates, and performs whatever part of
its purpose remains meaningful.
(For example, a function in a library to compute square roots has
a purpose that is entirely well-defined independent of the
application. Therefore, Subsection 2d requires that any
application-supplied function or table used by this function must
be optional: if the application does not supply it, the square
root function must still compute square roots.)
These requirements apply to the modified work as a whole. If
identifiable sections of that work are not derived from the Library,
and can be reasonably considered independent and separate works in
themselves, then this License, and its terms, do not apply to those
sections when you distribute them as separate works. But when you
distribute the same sections as part of a whole which is a work based
on the Library, the distribution of the whole must be on the terms of
this License, whose permissions for other licensees extend to the
entire whole, and thus to each and every part regardless of who wrote
it.
Thus, it is not the intent of this section to claim rights or contest
your rights to work written entirely by you; rather, the intent is to
exercise the right to control the distribution of derivative or
collective works based on the Library.
In addition, mere aggregation of another work not based on the Library
with the Library (or with a work based on the Library) on a volume of
a storage or distribution medium does not bring the other work under
the scope of this License.
3. You may opt to apply the terms of the ordinary GNU General Public
b) Use a suitable shared library mechanism for linking with the
Library. A suitable mechanism is one that (1) uses at run time a
copy of the library already present on the user's computer system,
rather than copying library functions into the executable, and (2)
will operate properly with a modified version of the library, if
the user installs one, as long as the modified version is
interface-compatible with the version that the work was made with.
c) Accompany the work with a written offer, valid for at
least three years, to give the same user the materials
specified in Subsection 6a, above, for a charge no more
than the cost of performing this distribution.
d) If distribution of the work is made by offering access to copy
from a designated place, offer equivalent access to copy the above
specified materials from the same place.
e) Verify that the user has already received a copy of these
materials or that you have already sent this user a copy.
For an executable, the required form of the "work that uses the
otherwise) that contradict the conditions of this License, they do not
excuse you from the conditions of this License. If you cannot
distribute so as to satisfy simultaneously your obligations under this
License and any other pertinent obligations, then as a consequence you
may not distribute the Library at all. For example, if a patent
license would not permit royalty-free redistribution of the Library by
all those who receive copies directly or indirectly through you, then
the only way you could satisfy both it and this License would be to
refrain entirely from distribution of the Library.
If any portion of this section is held invalid or unenforceable under any
particular circumstance, the balance of the section is intended to apply,
and the section as a whole is intended to apply in other circumstances.
It is not the purpose of this section to induce you to infringe any
patents or other property right claims or to contest validity of any
such claims; this section has the sole purpose of protecting the
integrity of the free software distribution system which is
implemented by public license practices. Many people have made
generous contributions to the wide range of software distributed
through that system in reliance on consistent application of that
system; it is up to the author/donor to decide if he or she is willing
to distribute software through any other system and a licensee cannot
impose that choice.
This section is intended to make thoroughly clear what is believed to
be a consequence of the rest of this License.
12. If the distribution and/or use of the Library is restricted in
certain countries either by patents or by copyrighted interfaces, the
original copyright holder who places the Library under this License may add
an explicit geographical distribution limitation excluding those countries,
so that distribution is permitted only in or among countries not thus
excluded. In such case, this License incorporates the limitation as if
written in the body of this License.
{
"abstract" : "A sliding-window events-per-second rate counter with a optional XS backend for additional zoomies.",
"author" : [
"Zane C. Bowers-Hadley <vvelox@vvelox.net>"
],
"dynamic_config" : 1,
"generated_by" : "ExtUtils::MakeMaker version 7.76, CPAN::Meta::Converter version 2.150010",
"license" : [
"lgpl_2_1"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
---
abstract: 'A sliding-window events-per-second rate counter with a optional XS backend for additional zoomies.'
author:
- 'Zane C. Bowers-Hadley <vvelox@vvelox.net>'
build_requires:
ExtUtils::MakeMaker: '0'
Test::More: '0'
configure_requires:
ExtUtils::MakeMaker: '0'
dynamic_config: 1
generated_by: 'ExtUtils::MakeMaker version 7.76, CPAN::Meta::Converter version 2.150010'
license: lgpl
# Algorithm::EventsPerSecond
A sliding-window events-per-second rate counter for Perl, with an optional
C/SIMD-accelerated backend and an automatic pure-Perl fallback.
`Algorithm::EventsPerSecond` keeps per-second counts in a fixed-size ring
buffer and reports the average event rate over the most recent N seconds
(the "window"). Memory use is constant regardless of event volume, and both
`mark` and `rate` are O(1) averaged out over time.
For extra zoomies XS acceleration is available and SIMD if available.
## Synopsis
```perl
use Algorithm::EventsPerSecond;
my $meter = Algorithm::EventsPerSecond->new( window => 10 ); # 10-second window
while (my $event = get_next_event()) {
# record one event
$meter->mark;
# or record several at once
#$meter->mark(5);
printf "current rate: %.2f events/sec\n", $meter->rate;
}
print "events seen in window: ", $meter->count, "\n";
print "lifetime total: ", $meter->total, "\n";
```
## The iqbi-damiq daemon
The dist ships `iqbi-damiq`, a unix-socket daemon built on
`Algorithm::EventsPerSecond::Sukkal`. Clients mark events against keys of
printf 'MARK requests 5\nRATE requests\nQUIT\n' \
| socat - UNIX:/var/run/iqbi-damiq.sock
# or MARKRATE to mark and read the rate back in a single command
printf 'MARKRATE requests 5\nQUIT\n' \
| socat - UNIX:/var/run/iqbi-damiq.sock
```
Memory is bounded by `max_keys` and the window: each key owns one meter of
two ring buffers with a slot per window second, so worst case is
`max_keys * bytes_per_key`, where per key is roughly `16 * window + 800`
bytes on the XS backend and `48 * window + 2000` bytes pure-Perl â
about 170 MB (XS) or 490 MB (PP) at the defaults of a 60 second window
and 100000 keys. Idle keys are evicted, so the worst case needs that
many distinct keys live at once.
See `perldoc Algorithm::EventsPerSecond::Sukkal` for the protocol and
memory-sizing details, and `iqbi-damiq --help` for options. Example
startup scripts ship in `rc/`: a FreeBSD rc.d script
(`rc/freebsd/iqbi_damiq`) and a systemd unit
(`rc/systemd/iqbi-damiq.service`).
## Installation
benchmark.pl view on Meta::CPAN
BEGIN {
@incs = grep { -d } ( "$FindBin::Bin/blib/arch", "$FindBin::Bin/blib/lib", "$FindBin::Bin/lib" );
unshift @INC, @incs;
}
my $time = 2;
my $windows = '60,600,3600';
GetOptions(
'time=f' => \$time,
'windows=s' => \$windows,
'help' => sub { print "usage: $0 [--time seconds] [--windows csv]\n"; exit 0 },
) or die "usage: $0 [--time seconds] [--windows csv]\n";
my @windows = grep { /^\d+$/ && $_ > 0 } split /,/, $windows;
die "no valid window sizes in --windows\n" unless @windows;
#
# child mode: benchmark whatever backend loads and emit tab-separated
# "label \t ops-per-second" lines for the parent to collate
#
if ( $ENV{AEPS_BENCH_CHILD} ) {
require Algorithm::EventsPerSecond;
require Benchmark;
my $backend = Algorithm::EventsPerSecond->backend;
my $simd = Algorithm::EventsPerSecond->simd;
print "BACKEND\t", ( defined $simd ? "$backend ($simd)" : $backend ), "\n";
my $bench = sub {
benchmark.pl view on Meta::CPAN
return $n;
}
print "Algorithm::EventsPerSecond benchmark (perl $], ${time}s per measurement)\n";
my $pp = run_child( ALGORITHM_EVENTSPERSECOND_PP => 1 );
my $xs = run_child();
if ( $xs->{backend} eq $pp->{backend} ) {
print "XS backend not available (build it with: perl Makefile.PL && make);\n";
print "showing pure Perl only. All figures are calls/second.\n\n";
printf " %-32s %15s\n", '', $pp->{backend};
printf " %-32s %15s\n", $_, commify( $pp->{rate}{$_} ) for @{ $pp->{order} };
exit 0;
}
print "All figures are events or calls per second, higher is better.\n\n";
printf " %-32s %15s %15s %9s\n", '', $pp->{backend}, $xs->{backend}, 'speedup';
for my $label ( @{ $pp->{order} } ) {
my $p = $pp->{rate}{$label};
my $x = $xs->{rate}{$label};
next unless defined $x;
printf " %-32s %15s %15s %8.1fx\n", $label, commify($p), commify($x), $p ? $x / $p : 0;
}
lib/Algorithm/EventsPerSecond.pm view on Meta::CPAN
package Algorithm::EventsPerSecond;
use 5.006;
use strict;
use warnings;
=head1 NAME
Algorithm::EventsPerSecond - A sliding-window events-per-second rate counter with a optional XS backend for additional zoomies.
=head1 VERSION
Version 0.1.0
=cut
our $VERSION = '0.1.0';
our $BACKEND;
lib/Algorithm/EventsPerSecond.pm view on Meta::CPAN
if ( eval { require Algorithm::EventsPerSecond::XS; 1 } ) {
$BACKEND = 'XS';
}
}
}
=head1 SYNOPSIS
use Algorithm::EventsPerSecond;
my $meter = Algorithm::EventsPerSecond->new( window => 10 ); # 10-second window
while (my $event = get_next_event()) {
$meter->mark; # record one event
# $meter->mark(5); # or record several at once
printf "current rate: %.2f events/sec\n", $meter->rate;
}
print "events seen in window: ", $meter->count, "\n";
print "lifetime total: ", $meter->total, "\n";
=head1 DESCRIPTION
Algorithm::EventsPerSecond keeps per-second counts in a fixed-size ring buffer and
reports the average event rate over the most recent N seconds (the
"window"). Memory use is constant regardless of event volume, and both
C<mark> and C<rate> are O(1) averaged out over time.
=head1 METHODS
=head2 new( window => $seconds )
Construct a meter. C<window> is the length of the averaging window in
seconds and defaults to 60.
=cut
sub new {
my ( $class, %args ) = @_;
my $window = $args{window} // 60;
die "window must be a positive integer" unless $window =~ /^\d+$/ && $window > 0;
my $self = {
window => $window,
total => 0, # lifetime event count
started => time(),
};
if ( $BACKEND eq 'XS' ) {
# packed int64_t ring buffers, scanned in C
$self->{buckets} = "\0" x ( $window * 8 );
$self->{stamps} = "\0" x ( $window * 8 );
} else {
$self->{buckets} = [ (0) x $window ]; # counts, indexed by (epoch_sec % window)
$self->{stamps} = [ (0) x $window ]; # epoch second each bucket belongs to
}
return bless $self, $class;
} ## end sub new
# Internal, PP backend: get the bucket for the current second, clearing it if stale.
sub _bucket_index {
my ( $self, $now_sec ) = @_;
my $i = $now_sec % $self->{window};
if ( $self->{stamps}[$i] != $now_sec ) {
$self->{buckets}[$i] = 0;
$self->{stamps}[$i] = $now_sec;
}
return $i;
}
=head2 mark( [$count] )
Record one event, or C<$count> events. C<$count> must be a
non-negative integer; zero is a no-op. Anything else dies. Returns the
meter object, so calls can be chained.
=cut
sub _mark_pp {
my ( $self, $count ) = @_;
if ( defined $count ) {
die "count must be a non-negative integer" unless $count =~ /^\d+$/;
} else {
$count = 1;
}
my $now_sec = int( time() );
my $i = $self->_bucket_index($now_sec);
$self->{buckets}[$i] += $count;
$self->{total} += $count;
return $self;
} ## end sub _mark_pp
sub _mark_xs {
my ( $self, $count ) = @_;
if ( defined $count ) {
lib/Algorithm/EventsPerSecond.pm view on Meta::CPAN
=head2 count
Number of events recorded within the current window.
=cut
sub _count_pp {
my ($self) = @_;
my $now_sec = int( time() );
my $window = $self->{window};
my $oldest = $now_sec - $window + 1;
my $sum = 0;
for my $i ( 0 .. $window - 1 ) {
$sum += $self->{buckets}[$i]
if $self->{stamps}[$i] >= $oldest;
}
return $sum;
} ## end sub _count_pp
sub _count_xs {
my ($self) = @_;
my $now_sec = int( time() );
return Algorithm::EventsPerSecond::XS::_xs_count( $self->{buckets}, $self->{stamps},
$self->{window}, $now_sec - $self->{window} + 1,
);
}
if ( $BACKEND eq 'XS' ) {
*mark = \&_mark_xs;
*count = \&_count_xs;
} else {
*mark = \&_mark_pp;
*count = \&_count_pp;
}
=head2 rate
Average events per second over the window. If the meter has been alive
for less time than the window, the elapsed lifetime is used instead, so
early readings are not artificially deflated.
=cut
sub rate {
my ($self) = @_;
my $elapsed = time() - $self->{started};
my $span = $elapsed < $self->{window} ? $elapsed : $self->{window};
lib/Algorithm/EventsPerSecond.pm view on Meta::CPAN
=head2 total
Lifetime count of all events ever recorded, regardless of window.
=cut
sub total { $_[0]->{total} }
=head2 window
The configured window length in seconds.
=cut
sub window { $_[0]->{window} }
=head2 reset
Clear all counts and restart the clock. Returns the meter object.
=cut
lib/Algorithm/EventsPerSecond.pm view on Meta::CPAN
entirely and use pure Perl.
Which backend is in use can be checked via L</backend> and L</simd>.
=head1 AUTHOR
Zane C. Bowers-Hadley, C<< <vvelox at vvelox.net> >>
=head1 BUGS
Please report any bugs or feature requests to C<bug-algorithm-eventspersecond at rt.cpan.org>, or through
the web interface at L<https://rt.cpan.org/NoAuth/ReportBug.html?Queue=Algorithm-EventsPerSecond>. I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
lib/Algorithm/EventsPerSecond/Sukkal.pm view on Meta::CPAN
=over 4
=item socket
Path of the unix socket to listen on. Required. A stale socket file
left by a dead daemon is removed automatically; a live listener on the
same path is an error.
=item window
Averaging window in seconds for every meter, as in
L<Algorithm::EventsPerSecond/new>. Defaults to 60. Each key's memory
scales linearly with the window; see L</MEMORY USAGE>.
=item max_keys
Maximum number of distinct keys tracked at once. Marks for new keys
beyond the limit are rejected with an error reply. 0 means unlimited.
Defaults to 100000. This is the daemon's memory ceiling: worst case
is C<max_keys> live meters, each of a size fixed by the window; see
L</MEMORY USAGE>.
lib/Algorithm/EventsPerSecond/Sukkal.pm view on Meta::CPAN
=head2 MARK <key> [<count>]
Record one event, or C<count> events, against C<key>, creating the key
if it is new. Nothing is replied on success
so writers never have to read; malformed input or hitting
L</max_keys> replies C<ERR ...>.
=head2 RATE <key>
Reply C<OK n> with the key's events per second averaged over the
window. Unknown keys read as C<OK 0>.
=head2 MARKRATE <key> [<count>]
Record one event, or C<count> events, against C<key> exactly as
L</MARK> would, then reply C<OK n> with the key's rate as L</RATE>
would â a mark and a query in a single round trip. Rejects with
C<ERR ...> under the same conditions as L</MARK>.
=head2 COUNT <key>
lib/Algorithm/EventsPerSecond/Sukkal.pm view on Meta::CPAN
Replies C<OK PONG>.
=head2 QUIT
Replies C<OK BYE> and closes the connection.
=head1 PERFORMANCE NOTES
Batch marks: many C<MARK> lines per write, ideally repeated keys
back-to-back, or a single C<MARK key 1000>. The daemon coalesces
consecutive marks per key into one meter call, so the ceiling is
socket throughput and line parsing rather than the meters â which, on
the XS backend, barely notice.
Memory is bounded by L</max_keys> and L</window>; see L</MEMORY
USAGE> for how to size them.
=head1 MEMORY USAGE
Every key owns one L<Algorithm::EventsPerSecond> meter, and a meter's
size is set entirely by the window: two ring buffers of one slot per
window second, counts in one and timestamps in the other. Event
volume does not matter; a key marked once costs the same as a key
marked a million times. The worst-case daemon footprint is therefore
max_keys * bytes_per_key
where bytes_per_key is the two buffers plus a fixed per-key overhead
(the meter object, the key string, and its slot in the key table).
On the XS backend a slot is a packed C<int64_t>, so
bytes_per_key ~= 2 * 8 * window + 800
lib/Algorithm/EventsPerSecond/Sukkal.pm view on Meta::CPAN
The worst case only materializes if that many distinct keys are all
marked within one L</idle_timeout>; the sweep evicts idle keys and
returns their memory.
=head1 AUTHOR
Zane C. Bowers-Hadley, C<< <vvelox at vvelox.net> >>
=head1 BUGS
Please report any bugs or feature requests to C<bug-algorithm-eventspersecond at rt.cpan.org>, or through
the web interface at L<https://rt.cpan.org/NoAuth/ReportBug.html?Queue=Algorithm-EventsPerSecond>. I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
perldoc Algorithm::EventsPerSecond::Sukkal
You can also look for information at:
rc/freebsd/iqbi_damiq view on Meta::CPAN
# /etc/rc.conf or /etc/rc.conf.local:
#
# iqbi_damiq_enable (bool): Set to "YES" to enable. Default "NO".
# iqbi_damiq_socket (path): Unix socket to listen on.
# Default "/var/run/iqbi-damiq/iqbi-damiq.sock".
# iqbi_damiq_socket_mode (octal): Socket file mode. Clients need write
# permission to connect; tighten to 0660
# and a shared group where any local
# user marking keys is unwanted.
# Default "0666".
# iqbi_damiq_window (int): Averaging window in seconds.
# Default "60".
# iqbi_damiq_max_keys (int): Distinct-key ceiling, 0 for
# unlimited. Default "100000".
# iqbi_damiq_idle_timeout (int): Evict keys unmarked this long, in
# seconds; may not be less than the
# window. Default is twice the window.
# iqbi_damiq_sweep_interval (int): Seconds between eviction sweeps.
# Default "30".
# iqbi_damiq_user (user): User to run as. Default "nobody".
# iqbi_damiq_group (group): Group owning the run directory.
# Default "nobody".
# iqbi_damiq_flags (str): Extra iqbi-damiq flags, e.g. "-x".
. /etc/rc.subr
rc/systemd/iqbi-damiq.service view on Meta::CPAN
# systemd unit for iqbi-damiq, the Algorithm::EventsPerSecond::Sukkal
# daemon. Install as /etc/systemd/system/iqbi-damiq.service, then:
#
# systemctl daemon-reload
# systemctl enable --now iqbi-damiq
#
# Tunables are read from an environment file â set any of these in
# /etc/default/iqbi-damiq (Debian-family) or /etc/sysconfig/iqbi-damiq
# (RHEL-family):
#
# IQBI_DAMIQ_WINDOW=300 # averaging window, seconds
# IQBI_DAMIQ_MAX_KEYS=500000 # distinct-key ceiling, 0 unlimited
# IQBI_DAMIQ_IDLE_TIMEOUT=600 # evict keys unmarked this long;
# # must be at least the window, so
# # raise it when raising the window
# IQBI_DAMIQ_SWEEP_INTERVAL=30 # seconds between eviction sweeps
# IQBI_DAMIQ_SOCKET_MODE=0660 # socket file mode
#
# Neither file existing is fine; everything falls back to the defaults
# below. Adjust other flags with `systemctl edit iqbi-damiq` (an
# override.conf with an emptied and re-set ExecStart), e.g. to add -x.
[Unit]
Description=iqbi-damiq per-key sliding-window event rate daemon
Documentation=man:iqbi-damiq(1)
After=local-fs.target
t/lib/AEPS_TestSuite.pm view on Meta::CPAN
}
sub run_suite {
#
# constructor
#
{
my $meter = Algorithm::EventsPerSecond->new;
isa_ok( $meter, 'Algorithm::EventsPerSecond', 'new with defaults' );
is( $meter->window, 60, 'default window is 60 seconds' );
$meter = Algorithm::EventsPerSecond->new( window => 10 );
is( $meter->window, 10, 'window argument is honored' );
ok( !eval { Algorithm::EventsPerSecond->new( window => 0 ); 1 }, 'window of 0 dies' );
ok( !eval { Algorithm::EventsPerSecond->new( window => -5 ); 1 }, 'negative window dies' );
ok( !eval { Algorithm::EventsPerSecond->new( window => 'abc' ); 1 }, 'non-numeric window dies' );
ok( !eval { Algorithm::EventsPerSecond->new( window => 1.5 ); 1 }, 'fractional window dies' );
}
t/lib/AEPS_TestSuite.pm view on Meta::CPAN
is( $meter->count, 2, 'rejected marks do not change count' );
is( $meter->total, 2, 'rejected marks do not change total' );
is( $meter->count, $meter->total, 'count and total agree after rejected marks' );
is( $meter->mark(0), $meter, 'mark(0) is accepted and returns the meter object' );
is( $meter->count, 2, 'mark(0) is a no-op for count' );
is( $meter->total, 2, 'mark(0) is a no-op for total' );
}
#
# events spread across seconds, then falling out of the window
#
{
my $meter = Algorithm::EventsPerSecond->new( window => 5 );
$meter->mark(2); # second 0
advance(1);
$meter->mark(3); # second 1
advance(1);
$meter->mark(4); # second 2
is( $meter->count, 9, 'count sums events across seconds in the window' );
is( $meter->total, 9, 'total matches while all events are in the window' );
# now at second 2; window of 5 covers seconds -2..2, so nothing has
# expired yet. Advance to second 5: window covers 1..5, dropping the
# 2 events from second 0.
advance(3);
is( $meter->count, 7, 'events older than the window are excluded' );
# advance well past the window: everything expires
advance(10);
is( $meter->count, 0, 'count is 0 once all events age out' );
is( $meter->total, 9, 'total is unaffected by expiry' );
}
#
# ring buffer reuse: marks a full window apart land in the same bucket
# and must not be double counted
#
{
my $meter = Algorithm::EventsPerSecond->new( window => 3 );
$meter->mark(5);
advance(3); # same bucket index, new second
$meter->mark(2);
is( $meter->count, 2, 'stale bucket is cleared before reuse' );
is( $meter->total, 7, 'total still counts events from cleared buckets' );
}
#
# window of 1: smallest ring buffer
#
{
my $meter = Algorithm::EventsPerSecond->new( window => 1 );
$meter->mark(3)->mark(4);
is( $meter->count, 7, 'window of 1 counts the current second' );
advance(1);
is( $meter->count, 0, 'window of 1 expires after one second' );
}
#
# rate
#
{
my $meter = Algorithm::EventsPerSecond->new( window => 10 );
is( $meter->rate, 0, 'rate is 0 when no time has elapsed' );
t/lib/AEPS_TestSuite.pm view on Meta::CPAN
my $meter = Algorithm::EventsPerSecond->new( window => 5 );
$meter->mark(3);
advance(-11); # -11 is not a multiple of the window, so this
$meter->mark(2); # mark lands in a different bucket than the one above
ok( $meter->count >= 0, 'count is non-negative after the clock steps back' );
is( $meter->total, 5, 'total is unaffected by the clock stepping back' );
is( $meter->rate, 0, 'rate reads 0 while the clock is behind the start time' );
advance(13); # two seconds past where the clock originally was
$meter->mark(4);
is( $meter->count, 7, 'only in-window events counted once the clock recovers' );
is( $meter->total, 9, 'total tracks marks made at every clock position' );
advance(10);
is( $meter->count, 0, 'everything ages out normally after recovery' );
is( $meter->total, 9, 'total survives the aging out' );
}
#
# randomized cross-check against an independent reference model.
# Window sizes chosen to exercise the SIMD main loop, its scalar
# tail, and tail-only runs (AVX2 does 4 buckets a step, SSE4.2 2);
# 257 and 1024 add long main-loop runs on odd and even boundaries.
#
for my $window ( 1, 2, 3, 5, 8, 16, 33, 64, 257, 1024 ) {
my $meter = Algorithm::EventsPerSecond->new( window => $window );
my %events; # second => count, the reference model
my $total = 0;
my $bad = 0;
for ( 1 .. 200 ) {
advance( _rnd(4) ); # 0-3 seconds pass
my $n = _rnd(5); # 0-4 events
if ($n) {
$meter->mark($n);
$events{$fake_time} += $n;
$total += $n;
}
my $oldest = $fake_time - $window + 1;
my $expected = 0;
for my $sec ( keys %events ) {
$expected += $events{$sec} if $sec >= $oldest;
}
$bad++ if $meter->count != $expected;
$bad++ if $meter->total != $total;
} ## end for ( 1 .. 200 )
is( $bad, 0, "randomized marks match reference model (window $window)" );
} ## end for my $window ( 1, 2, 3, 5, 8, 16, 33, 64,...)
return;
t/sukkal-lifecycle.t view on Meta::CPAN
#
# max_clients: connections over the cap are closed immediately, and a
# freed slot becomes usable again
#
{
my $d = spawn_daemon( max_clients => 2 );
my $a = connect_daemon($d);
is( req( $a, 'PING' ), 'OK PONG', 'first client served' );
my $b = connect_daemon($d);
is( req( $b, 'PING' ), 'OK PONG', 'second client served' );
like( req( $a, 'STATS' ), qr/\bclients=2\b/, 'STATS counts both clients' );
my $over = connect_daemon($d);
is( read_line($over), undef, 'client over max_clients is closed immediately' );
is( req( $a, 'PING' ), 'OK PONG', 'existing clients unaffected by the rejected one' );
close $b;
my $served;
t/sukkal-lifecycle.t view on Meta::CPAN
is( read_line($b), 'OK PONG', 'B: PING answered next, in order, on B' );
# a tighter interleave: if replies were misrouted, A's PONG could
# surface on B. Confirm each PING is answered on its own socket.
print $a "PING\n";
print $b "PING\n";
print $b "PING\n";
print $a "PING\n";
is( read_line($a), 'OK PONG', 'A: PING answered on A' );
is( read_line($a), 'OK PONG', 'A: second PING answered on A' );
is( read_line($b), 'OK PONG', 'B: PING answered on B' );
is( read_line($b), 'OK PONG', 'B: second PING answered on B' );
like( req( $a, 'STATS' ), qr/\bclients=2\b/, 'both connections live at once' );
close $a;
close $b;
stop_daemon($d);
}
#
# idle keys are evicted by the sweep, and eviction forgets the
} ## end sub req_multi
is( req('PING'), 'OK PONG', 'PING' );
like( req('STATS'), qr/^OK keys=0 clients=1 /, 'daemon STATS while empty' );
print $sock "MARK foo\nMARK foo 4\n";
is( req('COUNT foo'), 'OK 5', 'pipelined marks coalesced and counted' );
is( req('TOTAL foo'), 'OK 5', 'TOTAL' );
# rate uses elapsed lifetime while younger than the window, so give the
# meter a second of life before expecting a non-zero rate
sleep 1;
my ($rate) = ( req('RATE foo') || '' ) =~ /^OK (\S+)\z/;
ok( defined $rate && $rate > 0, 'RATE is positive' );
is( req('RATE nosuch'), 'OK 0', 'unknown key rate reads as zero' );
is( req('COUNT nosuch'), 'OK 0', 'unknown key count reads as zero' );
like( req('STATS foo'), qr/^OK rate=\S+ count=5 total=5 window=5\z/, 'per-key STATS' );
like( req('MARK foo abc'), qr/^ERR bad count/, 'bad count rejected' );
($hdr) = req_multi('KEYS');
is( $hdr, 'OK 3', 'key gone after DEL' );
# a slot is free again: fresh key with marks and query in one write
print $sock "MARK d 2\nMARK d 3\nCOUNT d\n";
my $reply = <$sock>;
$reply =~ s/\r?\n\z//;
is( $reply, 'OK 5', 'marks flushed before pipelined query on new key' );
# MARKRATE: mark and query in a single round trip. foo's clock was
# restarted by RESET above, so give it a second of life first, as the
# rate reply is count over elapsed while younger than the window
sleep 1;
my ($mrate) = ( req('MARKRATE foo 2') || '' ) =~ /^OK (\S+)\z/;
ok( defined $mrate && $mrate > 0, 'MARKRATE replies a positive rate' );
is( req('COUNT foo'), 'OK 2', 'MARKRATE recorded the marks' );
# pipelined marks must land before the MARKRATE mark-and-read
print $sock "MARK foo 3\nMARKRATE foo\n";
my $mr = <$sock>;
like( $mr, qr/^OK \S+/, 'pipelined MARKRATE replies' );