Algorithm-ToNumberMunger
view release on metacpan or search on metacpan
lib/Algorithm/ToNumberMunger.pm view on Meta::CPAN
# Status-class mungers (http_enum, smtp_enum, sip_enum, ...) are one transform
# -- collapse a numeric reply code to its leading digit, int(code/div), with a
# divisor of 100 (10 for gemini's two-digit codes) -- differing only in which
# range 'strict' accepts. Register them all from this table so a new protocol
# is a single line and they can never drift apart. mgcp_enum is deliberately
# NOT a row here: its strict range has a hole (8xx exists, 6xx/7xx do not),
# which a single [lo, hi] cannot express, so it has its own builder below.
my %STATUS_PROTO = (
http => [ 100, 599 ], # 1xx-5xx
smtp => [ 200, 599 ], # 2xx-5xx; SMTP never issues 1yz in practice
sip => [ 100, 699 ], # 1xx-6xx; SIP adds a 6xx global-failure class
ftp => [ 100, 599 ], # 1xx-5xx FTP reply codes
rtsp => [ 100, 599 ], # RTSP (RFC 2326) reuses HTTP's status scheme
nntp => [ 100, 599 ], # 1xx-5xx NNTP (RFC 3977), SMTP-convention codes
dict => [ 100, 599 ], # DICT (RFC 2229) uses SMTP-style codes
gemini => [ 10, 69, 10 ], # two-digit codes, 1x-6x; class = int(code/10)
);
for my $proto ( keys %STATUS_PROTO ) {
my ( $lo, $hi, $div ) = @{ $STATUS_PROTO{$proto} };
$div = 100 unless defined $div;
$BUILDERS{"${proto}_enum"}
lib/Algorithm/ToNumberMunger.pm view on Meta::CPAN
C<http_enum>'s C<100>.
=head2 sip_enum
{ munger => 'sip_enum' }
{ munger => 'sip_enum', strict => 1 }
The SIP counterpart of L</http_enum>: collapse a SIP status code to its leading
digit (C<int(code / 100)>). SIP reuses HTTP's class scheme but adds a sixth
class -- C<1xx> provisional, C<2xx> success, C<3xx> redirection, C<4xx> client
error, C<5xx> server error, C<6xx> global failure.
With a true C<strict>, inputs outside the valid SIP status range (C<100>-C<699>)
croak. The ceiling is C<699> rather than C<http_enum>'s C<599> precisely because
of that C<6xx> global-failure class.
=head2 ftp_enum
{ munger => 'ftp_enum' }
{ munger => 'ftp_enum', strict => 1 }
The FTP counterpart of L</http_enum>, for FTP reply codes: C<int(code / 100)>,
bucketing into C<1yz>-C<5yz>. With a true C<strict>, inputs outside C<100>-C<599>
croak.
lib/Algorithm/ToNumberMunger.pm view on Meta::CPAN
my ( $spec, $where ) = @_;
my $of = $spec->{of};
croak "count munger$where requires a non-empty 'of' string"
unless defined $of && length $of;
my $plus = defined $spec->{plus} ? $spec->{plus} : 0;
croak "count munger$where: 'plus' must be numeric"
unless looks_like_number($plus);
# index() beats a global regex match here: no pattern engine, and no
# per-call list of matches just to count them. Advancing by length($of)
# keeps the non-overlapping semantics m//g had.
my $oflen = length $of;
return sub {
my ($v) = @_;
my $s = defined $v ? "$v" : '';
my $n = 0;
my $p = 0;
while ( ( $p = index( $s, $of, $p ) ) >= 0 ) {
$n++;
lib/Algorithm/ToNumberMunger.pm view on Meta::CPAN
=head2 ip_class
{ munger => 'ip_class' }
{ munger => 'ip_class', default => -1 }
Collapse an IPv4 or IPv6 address to its address-space class -- to addresses
what the status-class enums are to reply codes: the literal address is
high-cardinality noise, but "an internal host suddenly talking multicast" is
a class-level signal. Classes and their emitted numbers:
0 global anything not covered below
1 private 10/8, 172.16/12, 192.168/16, 100.64/10 (CGNAT), fc00::/7 (ULA)
2 loopback 127/8, ::1
3 link_local 169.254/16, fe80::/10
4 multicast 224/4, ff00::/8
5 broadcast 255.255.255.255
6 unspecified 0.0.0.0, ::
7 reserved 0/8, 192.0.0/24, the documentation nets (192.0.2/24,
198.51.100/24, 203.0.113/24, 2001:db8::/32), benchmarking
(198.18/15), 240/4, and the 100::/64 discard prefix
lib/Algorithm/ToNumberMunger.pm view on Meta::CPAN
if ( index( $s, ':' ) >= 0 ) {
require Socket;
my $b = eval { Socket::inet_pton( Socket::AF_INET6(), $s ) };
return ( 6, $b ) if defined $b && length $b == 16;
}
return;
} ## end sub _parse_ip
# The ip_class class names, pinned to their emitted numbers.
my %IP_CLASS = (
global => 0,
private => 1,
loopback => 2,
link_local => 3,
multicast => 4,
broadcast => 5,
unspecified => 6,
reserved => 7,
);
sub _ip4_class {
lib/Algorithm/ToNumberMunger.pm view on Meta::CPAN
return 'loopback' if $a == 127;
return 'link_local' if $a == 169 && $b == 254;
return 'private' if $a == 172 && $b >= 16 && $b <= 31;
return 'reserved' if $a == 192 && $b == 0 && ( $c == 0 || $c == 2 );
return 'private' if $a == 192 && $b == 168;
return 'reserved' if $a == 198 && ( $b == 18 || $b == 19 ); # benchmarking
return 'reserved' if $a == 198 && $b == 51 && $c == 100; # TEST-NET-2
return 'reserved' if $a == 203 && $b == 0 && $c == 113; # TEST-NET-3
return 'multicast' if $a >= 224 && $a <= 239;
return 'reserved' if $a >= 240; # 240/4 future use
return 'global';
} ## end sub _ip4_class
sub _ip6_class {
my ($bytes) = @_;
my @o = unpack 'C16', $bytes;
my $lead0 = 1;
for my $i ( 0 .. 14 ) { $lead0 &&= $o[$i] == 0 }
if ($lead0) {
return 'unspecified' if $o[15] == 0;
return 'loopback' if $o[15] == 1;
lib/Algorithm/ToNumberMunger.pm view on Meta::CPAN
for my $i ( 0 .. 9 ) { $map &&= $o[$i] == 0 }
return _ip4_class( ( $o[12] << 24 ) | ( $o[13] << 16 ) | ( $o[14] << 8 ) | $o[15] )
if $map && $o[10] == 0xff && $o[11] == 0xff;
return 'multicast' if $o[0] == 0xff;
return 'private' if ( $o[0] & 0xfe ) == 0xfc; # ULA fc00::/7
return 'link_local' if $o[0] == 0xfe && ( $o[1] & 0xc0 ) == 0x80; # fe80::/10
return 'reserved' if $o[0] == 0x20 && $o[1] == 0x01 && $o[2] == 0x0d && $o[3] == 0xb8; # 2001:db8::/32
my $discard = $o[0] == 0x01; # 100::/64
for my $i ( 1 .. 7 ) { $discard &&= $o[$i] == 0 }
return 'reserved' if $discard;
return 'global';
} ## end sub _ip6_class
sub _build_ip_class {
my ( $spec, $where ) = @_;
my $has_default = exists $spec->{default};
my $default = $spec->{default};
croak "ip_class munger$where: 'default' must be numeric"
if $has_default && !looks_like_number($default);
lib/Algorithm/ToNumberMunger.pm view on Meta::CPAN
L<Algorithm::EventsPerSecond::Sukkal>). The input value becomes a meter B<key>
(after C<prefix> is prepended); by default the munger B<marks> one event against
that key and returns the key's current events-per-second, using the daemon's
C<MARKRATE> command -- mark and query in a single command with a single reply.
This is the munger behind rate columns like a per-source request rate: every
event marks its source's meter and stores the rate the meter now reads.
Unlike every other munger this one consults external state -- but the state
lives in the daemon, not here, so the munger itself remains a stateless client
and rows stay reproducible I<given> the daemon. Because the daemon is shared,
multiple writer processes marking the same keys see one B<global> rate, which an
in-process meter could never give.
Spec keys:
=over 4
=item * C<socket> - unix socket path of the daemon. Defaults to
C<$Algorithm::ToNumberMunger::EPS_SOCKET>
(C</var/run/iqbi-damiq.sock>).
t/mungers-datetime-strptime.t view on Meta::CPAN
BEGIN {
eval { require Time::Piece; 1 }
or plan skip_all => 'Time::Piece not available';
}
use Algorithm::ToNumberMunger;
my $M = 'Algorithm::ToNumberMunger';
# Count real strptime calls. The munger resolves Time::Piece->strptime at call
# time, so wrapping the glob here is seen by code inside Mungers.pm too.
my $STRPTIME_CALLS = 0;
{
no warnings 'redefine';
my $orig = \&Time::Piece::strptime;
*Time::Piece::strptime = sub { $STRPTIME_CALLS++; goto &$orig };
}
# One reference instant expressed in many notations: Sunday 2026-07-05
# 13:37:42 UTC. The expected numbers are literals (not re-derived via
# Time::Piece) so the module is never its own oracle.
t/mungers.t view on Meta::CPAN
}
# ---- sip_enum -------------------------------------------------------------
{
my $c = $M->build( { munger => 'sip_enum' } );
is( $c->(100), 1, 'sip_enum 1xx -> 1' );
is( $c->(200), 2, 'sip_enum 2xx -> 2' );
is( $c->(302), 3, 'sip_enum 3xx -> 3' );
is( $c->(404), 4, 'sip_enum 4xx -> 4' );
is( $c->(503), 5, 'sip_enum 5xx -> 5' );
is( $c->(603), 6, 'sip_enum 6xx -> 6 (global failure)' );
my $s = $M->build( { munger => 'sip_enum', strict => 1 } );
is( $s->(699), 6, 'sip_enum strict passes the 6xx high boundary' );
eval { $s->(700) };
like( $@, qr/out of range \(100-699\)/, 'sip_enum strict rejects >= 700' );
eval { $s->(99) };
like( $@, qr/out of range \(100-699\)/, 'sip_enum strict rejects < 100' );
}
# ---- frozen_freq_map -------------------------------------------------------------
t/mungers.t view on Meta::CPAN
eval { $M->build( { munger => 'aws_principal_type_enum' } )->(0) };
like( $@, qr/no mapping for '0'/, 'cloud category enums do not pass a number through' );
}
# ---- ip_class ---------------------------------------------------------------
{
my $c = $M->build( { munger => 'ip_class' } );
# v4: one probe per class
is( $c->('8.8.8.8'), 0, 'ip_class v4 global' );
is( $c->('10.1.2.3'), 1, 'ip_class 10/8 private' );
is( $c->('172.16.0.1'), 1, 'ip_class 172.16/12 private' );
is( $c->('172.32.0.1'), 0, 'ip_class 172.32 is NOT private' );
is( $c->('192.168.99.1'), 1, 'ip_class 192.168/16 private' );
is( $c->('100.64.0.1'), 1, 'ip_class CGNAT counts as private' );
is( $c->('100.128.0.1'), 0, 'ip_class just past CGNAT is global' );
is( $c->('127.0.0.53'), 2, 'ip_class loopback' );
is( $c->('169.254.1.1'), 3, 'ip_class v4 link-local' );
is( $c->('224.0.0.251'), 4, 'ip_class v4 multicast' );
is( $c->('239.255.255.250'), 4, 'ip_class multicast high edge' );
is( $c->('255.255.255.255'), 5, 'ip_class broadcast' );
is( $c->('0.0.0.0'), 6, 'ip_class v4 unspecified' );
is( $c->('0.1.2.3'), 7, 'ip_class rest of 0/8 reserved' );
is( $c->('192.0.2.55'), 7, 'ip_class TEST-NET-1 reserved' );
is( $c->('198.51.100.7'), 7, 'ip_class TEST-NET-2 reserved' );
is( $c->('203.0.113.9'), 7, 'ip_class TEST-NET-3 reserved' );
is( $c->('198.18.0.1'), 7, 'ip_class benchmarking reserved' );
is( $c->('240.0.0.1'), 7, 'ip_class 240/4 reserved' );
# v6
is( $c->('2600:1700::1'), 0, 'ip_class v6 global' );
is( $c->('fd12:3456:789a::1'), 1, 'ip_class ULA private' );
is( $c->('::1'), 2, 'ip_class v6 loopback' );
is( $c->('fe80::1'), 3, 'ip_class v6 link-local' );
is( $c->('ff02::fb'), 4, 'ip_class v6 multicast' );
is( $c->('::'), 6, 'ip_class v6 unspecified' );
is( $c->('2001:db8::1'), 7, 'ip_class v6 documentation reserved' );
is( $c->('100::1'), 7, 'ip_class discard prefix reserved' );
is( $c->('::ffff:10.0.0.1'), 1, 'ip_class v4-mapped classifies the embedded v4' );
is( $c->('::ffff:8.8.8.8'), 0, 'ip_class v4-mapped global' );
eval { $c->('not-an-ip') };
like( $@, qr/not a parseable IP address/, 'ip_class croaks on garbage without default' );
eval { $c->('10.0.0.256') };
like( $@, qr/not a parseable IP address/, 'ip_class rejects out-of-range octets' );
my $d = $M->build( { munger => 'ip_class', default => -1 } );
is( $d->('not-an-ip'), -1, 'ip_class default for garbage' );
is( $d->(undef), -1, 'ip_class default for undef' );
eval { $M->build( { munger => 'ip_class', default => 'x' } ) };
( run in 0.804 second using v1.01-cache-2.11-cpan-0fb53d1c279 )