Algorithm-ToNumberMunger
view release on metacpan or search on metacpan
lib/Algorithm/ToNumberMunger.pm view on Meta::CPAN
require XSLoader;
XSLoader::load( __PACKAGE__, $VERSION );
$HAVE_XS = 1;
1;
};
=head1 SYNOPSIS
use Algorithm::ToNumberMunger;
# one munger from a spec hash
my $code = Algorithm::ToNumberMunger->build(
{ munger => 'enum', map => { GET => 0, POST => 1, PUT => 2 } },
);
my $n = $code->('POST'); # 1
# a whole table of them at once, from a 'field => spec' hash
my $by_tag = Algorithm::ToNumberMunger->build_all(
\%mungers,
);
my $row_value = $by_tag->{method}->($raw{method});
=head1 DESCRIPTION
Many numeric pipelines -- anomaly detectors, feature stores, CSV loaders --
want every column to be a number, but the values they are handed are not always
numbers to begin with: an HTTP method is a string, a timestamp is a formatted
date, a high-cardinality label wants bucketing. An B<input munger> turns such a
raw value into a single number. Munging happens on the input side, before a row
is stored.
Mungers are declared as a plain data spec -- a hash naming a built-in munger and
carrying that munger's parameters -- so a table of them can be read straight out
of JSON or a config file:
{
"method": { "munger": "enum", "map": { "GET": 0, "POST": 1 } },
"bytes": { "munger": "log", "offset": 1 },
"label": { "munger": "hash", "buckets": 1024 }
}
B<Any field without an entry is raw> and is passed through unchanged; this module
is only concerned with fields that name a munger.
This class does not read or write files. It B<compiles> a spec into a closure
that maps one raw value to one number, so a caller can build its mungers once
from configuration and then apply them per row with no re-parsing. All
configuration errors are caught at build time; the returned closure only croaks
on genuinely un-mungeable I<input>.
=head1 CLASS METHODS
=head2 build
my $code = ...->build( \%spec );
my $code = ...->build( \%spec, $tag_name ); # $tag_name only sharpens errors
Compile a single munger spec into a coderef. C<%spec> must contain a C<munger>
key naming one of the L</BUILT-IN MUNGERS>; the remaining keys are that munger's
parameters. Croaks on an unknown munger name or an invalid parameter set. The
optional second argument is only used to make error messages point at a tag.
=cut
# name => builder. Each builder validates its slice of the spec up front and
# returns the per-value closure. Keeping them in a table (rather than a big
# if/elsif) is what makes known_mungers() and has_munger() cheap and honest.
my %BUILDERS = (
enum => \&_build_enum,
frozen_freq_map => \&_build_frozen_freq_map,
bool => \&_build_bool,
length => \&_build_length,
entropy => \&_build_entropy,
ngram => \&_build_ngram,
char => \&_build_char,
run => \&_build_run,
count => \&_build_count,
match => \&_build_match,
bucket => \&_build_bucket,
quantile => \&_build_quantile,
scale => \&_build_scale,
zscore => \&_build_zscore,
log => \&_build_log,
clamp => \&_build_clamp,
num => \&_build_num,
bit => \&_build_bit,
ip_class => \&_build_ip_class,
cidr => \&_build_cidr,
datetime => \&_build_datetime,
hash => \&_build_hash,
chain => \&_build_chain,
eps => \&_build_eps,
mgcp_enum => \&_build_mgcp_enum,
);
# 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"}
= sub { _status_class_munger( $proto, $lo, $hi, $div, @_ ) };
}
# ratio and combine consume several source fields at once, so they are only
# buildable through compile()'s multi-input form ('from' as an arrayref) -- a
lib/Algorithm/ToNumberMunger.pm view on Meta::CPAN
unless looks_like_number($v);
croak "mgcp_enum munger$where: status code '$v' is out of range " . "(100-599 or 800-899)"
if $strict && !( ( $v >= 100 && $v <= 599 ) || ( $v >= 800 && $v <= 899 ) );
return int( $v / 100 );
};
} ## end sub _build_mgcp_enum
=head2 dns_rcode_enum
{ munger => 'dns_rcode_enum' }
{ munger => 'dns_rcode_enum', default => -1 }
The first of the B<named-map enums>: like L</enum>, except the C<map> is baked
in from a well-known registry instead of hand-authored (and inevitably
typo'd). All named-map enums share the same lookup rules: names are matched
B<case-insensitively>; where the emitted numbers are the protocol's own wire
encoding (as here -- rcode C<3> I<is> C<NXDOMAIN>), a numeric input is passed
through unchanged, so mixed feeds (one tool logs C<NXDOMAIN>, another logs
C<3>) land in one consistent column; and an unmapped value croaks unless the
spec supplies a numeric C<default>. As with C<enum>, an unrecognized value is
often exactly the anomaly worth keeping, so C<< default => -1 >> is the usual
escape hatch.
This one maps DNS RCODE names to their IANA values: C<NOERROR> 0, C<FORMERR>
1, C<SERVFAIL> 2, C<NXDOMAIN> 3, C<NOTIMP> 4 (alias C<NOTIMPL>), C<REFUSED> 5,
C<YXDOMAIN> 6, C<YXRRSET> 7, C<NXRRSET> 8, C<NOTAUTH> 9, C<NOTZONE> 10,
C<DSOTYPENI> 11, and the extended rcodes C<BADVERS>/C<BADSIG> 16, C<BADKEY>
17, C<BADTIME> 18, C<BADMODE> 19, C<BADNAME> 20, C<BADALG> 21, C<BADTRUNC> 22,
C<BADCOOKIE> 23.
=head2 dns_qtype_enum
{ munger => 'dns_qtype_enum', default => -1 }
Named-map enum (lookup rules as L</dns_rcode_enum>; numeric inputs pass
through) mapping DNS RR type names to their IANA numbers: C<A> 1, C<NS> 2,
C<CNAME> 5, C<SOA> 6, C<NULL> 10, C<PTR> 12, C<MX> 15, C<TXT> 16, C<AAAA> 28,
C<SRV> 33, C<NAPTR> 35, C<DS> 43, C<RRSIG> 46, C<DNSKEY> 48, C<TLSA> 52,
C<SVCB> 64, C<HTTPS> 65, C<AXFR> 252, C<ANY> (or C<*>) 255, C<URI> 256,
C<CAA> 257, and the rest of the commonly-observed registry. The query-type mix
is a classic DNS-tunneling feature -- C<TXT>/C<NULL>-heavy traffic where
C<A>/C<AAAA> is normal.
=head2 syslog_severity_enum
{ munger => 'syslog_severity_enum' }
Named-map enum (lookup rules as L</dns_rcode_enum>; numeric inputs pass
through) mapping syslog severity names to their RFC 5424 codes: C<emerg> 0
(alias C<panic>), C<alert> 1, C<crit> 2, C<err> 3 (alias C<error>),
C<warning> 4 (alias C<warn>), C<notice> 5, C<info> 6 (alias
C<informational>), C<debug> 7. Genuinely ordinal -- lower is more severe --
so a threshold split on it is meaningful.
=head2 syslog_facility_enum
{ munger => 'syslog_facility_enum' }
Named-map enum (lookup rules as L</dns_rcode_enum>; numeric inputs pass
through) mapping syslog facility names to their RFC 5424 codes: C<kern> 0,
C<user> 1, C<mail> 2, C<daemon> 3, C<auth> 4 (alias C<security>), C<syslog> 5,
C<lpr> 6, C<news> 7, C<uucp> 8, C<cron> 9, C<authpriv> 10, C<ftp> 11, C<ntp>
12, C<audit> 13, C<alert> 14, C<clock> 15, and C<local0>-C<local7> 16-23.
=head2 ip_proto_enum
{ munger => 'ip_proto_enum', default => -1 }
Named-map enum (lookup rules as L</dns_rcode_enum>; numeric inputs pass
through) mapping IP protocol names to their IANA protocol numbers: C<icmp> 1,
C<igmp> 2, C<ipip> 4 (alias C<ipencap>), C<tcp> 6, C<egp> 8, C<udp> 17,
C<dccp> 33, C<ipv6> 41, C<rsvp> 46, C<gre> 47, C<esp> 50, C<ah> 51,
C<icmpv6> 58 (alias C<ipv6-icmp>), C<ospf> 89, C<pim> 103, C<sctp> 132,
C<udplite> 136. The map is frozen here rather than delegated to
C<getprotobyname> so a value munges to the same number on every host.
=head2 tls_version_enum
{ munger => 'tls_version_enum', default => -1 }
Named-map enum (lookup rules as L</dns_rcode_enum>) mapping a TLS/SSL protocol
version name to an B<ordinal>: C<SSLv2> 0, C<SSLv3> 1, C<TLSv1> 2, C<TLSv1.1>
3, C<TLSv1.2> 4, C<TLSv1.3> 5, with the common spelling variants (C<ssl3>,
C<tls1.2>, ...) accepted. Ordinal so "older than expected" is a monotone
feature a threshold split can express. Because these ordinals are this
module's invention rather than a wire encoding, numeric inputs are B<not>
passed through -- a C<1.2> would land on the wrong scale -- and croak like
any other unmapped value (or take the C<default>).
=head2 http_method_enum
{ munger => 'http_method_enum', default => -1 }
Named-map enum (lookup rules as L</dns_rcode_enum>) for the registered HTTP
request methods: C<GET> 0, C<HEAD> 1, C<POST> 2, C<PUT> 3, C<DELETE> 4,
C<CONNECT> 5, C<OPTIONS> 6, C<TRACE> 7, C<PATCH> 8. HTTP has no numeric
method encoding, so these are unordered ordinals of this module's invention
(a canonical map beats every set inventing its own numbering) and numeric
inputs are not passed through. An unlisted -- possibly probing -- method
croaks unless a C<default> is given, and that unlisted-method signal is often
the interesting one.
=head2 sip_method_enum
{ munger => 'sip_method_enum', default => -1 }
Named-map enum (lookup rules as L</dns_rcode_enum>) for the SIP request
methods: C<INVITE> 0, C<ACK> 1, C<BYE> 2, C<CANCEL> 3, C<REGISTER> 4,
C<OPTIONS> 5, C<PRACK> 6, C<SUBSCRIBE> 7, C<NOTIFY> 8, C<PUBLISH> 9,
C<INFO> 10, C<REFER> 11, C<MESSAGE> 12, C<UPDATE> 13. Like
L</http_method_enum> these are ordinals of this module's invention, so
numeric inputs are not passed through.
=head2 dhcp_msgtype_enum
{ munger => 'dhcp_msgtype_enum' }
Named-map enum (lookup rules as L</dns_rcode_enum>; numeric inputs pass
through) mapping DHCP message-type names to their option-53 values:
C<DISCOVER> 1, C<OFFER> 2, C<REQUEST> 3, C<DECLINE> 4, C<ACK> 5, C<NAK> 6,
C<RELEASE> 7, C<INFORM> 8 -- each also accepted with the C<DHCP> prefix
lib/Algorithm/ToNumberMunger.pm view on Meta::CPAN
C<Mobile Apps and Desktop clients> 1) and the B<legacy-auth> protocols -- which
cannot satisfy MFA -- sort high (C<Exchange ActiveSync>, C<IMAP4>, C<POP3>,
C<Authenticated SMTP>, C<MAPI Over HTTP>, C<Exchange Web Services>, C<Exchange
Online PowerShell>, C<AutoDiscover>, C<Offline Address Book>, C<Other
clients>, from 2 up). A "C<< >= 2 >> means legacy auth" threshold is the
intended feature. C<imap>/C<pop>/C<mapi> short forms are accepted as aliases.
Numeric inputs are not passed through.
=head2 risk_state_enum
{ munger => 'risk_state_enum', default => -1 }
Named-map enum (lookup rules as L</dns_rcode_enum>) for the Entra Identity
Protection C<riskState>: C<none> 0, C<confirmedSafe> 1, C<remediated> 2,
C<dismissed> 3, C<atRisk> 4, C<confirmedCompromised> 5. Numeric inputs are not
passed through.
=head2 vpc_flow_log_status_enum
{ munger => 'vpc_flow_log_status_enum', default => -1 }
Named-map enum (lookup rules as L</dns_rcode_enum>) for the AWS VPC Flow Logs
C<log-status>: C<OK> 0, C<NODATA> 1, C<SKIPDATA> 2. (The per-flow
C<ACCEPT>/C<REJECT> action is a plain L</bool>; this is the capture-health
field.) Numeric inputs are not passed through.
=head2 aws_event_type_enum
{ munger => 'aws_event_type_enum', default => -1 }
Named-map enum (lookup rules as L</dns_rcode_enum>) for the CloudTrail
C<eventType>: C<AwsApiCall> 0, C<AwsServiceEvent> 1, C<AwsConsoleAction> 2,
C<AwsConsoleSignIn> 3, C<AwsCloudTrailInsight> 4. C<AwsConsoleSignIn> is the
one worth flagging. Numeric inputs are not passed through.
=head2 conditional_access_result_enum
{ munger => 'conditional_access_result_enum', default => -1 }
Named-map enum (lookup rules as L</dns_rcode_enum>) for the Azure AD sign-in
C<conditionalAccessStatus>: C<success> 0, C<notApplied> 1, C<notEnabled> 2,
C<reportOnly> 3, C<failure> 4. Numeric inputs are not passed through.
=cut
# Named-map enums: baked-in value->number maps for well-known registries,
# registered as "<name>_enum". Keys are stored lowercase; lookup lowercases
# the input, giving the case-insensitive matching the POD promises. 'numeric'
# says whether a numeric input is passed through as-is -- set only where the
# numbers are the protocol's own encoding (a qtype 28 IS AAAA on the wire);
# where they are ordinals of our own invention (tls_version, the method
# enums), passthrough would mix scales, so a number croaks like any other
# unmapped value.
# SASL mechanism names, ordered weakest-to-strongest, for sasl_mech_enum. The
# same set is numbered alphabetically for sasl_mech_iana_enum, so the two
# mungers can never end up covering different mechanisms. Includes the IANA
# registry plus the ubiquitous non-registered login/xoauth2/apop.
my @SASL_MECHS_BY_STRENGTH = qw(
anonymous plain login
apop cram-md5 digest-md5 ntlm skey otp securid rpa kerberos_v4
srp scram-sha-1 scram-sha-1-plus scram-sha-256 scram-sha-256-plus
xoauth2 oauthbearer openid20 saml20
gssapi gs2-krb5 gss-spnego external
);
my %NAMED_ENUM = (
dns_rcode => {
numeric => 1,
map => {
noerror => 0,
formerr => 1,
servfail => 2,
nxdomain => 3,
notimp => 4,
notimpl => 4,
refused => 5,
yxdomain => 6,
yxrrset => 7,
nxrrset => 8,
notauth => 9,
notzone => 10,
dsotypeni => 11,
badvers => 16,
badsig => 16,
badkey => 17,
badtime => 18,
badmode => 19,
badname => 20,
badalg => 21,
badtrunc => 22,
badcookie => 23,
},
},
dns_qtype => {
numeric => 1,
map => {
a => 1,
ns => 2,
cname => 5,
soa => 6,
mb => 7,
mg => 8,
mr => 9,
'null' => 10,
wks => 11,
ptr => 12,
hinfo => 13,
minfo => 14,
mx => 15,
txt => 16,
rp => 17,
afsdb => 18,
sig => 24,
key => 25,
aaaa => 28,
loc => 29,
srv => 33,
naptr => 35,
kx => 36,
cert => 37,
dname => 39,
opt => 41,
ds => 43,
sshfp => 44,
ipseckey => 45,
rrsig => 46,
nsec => 47,
dnskey => 48,
dhcid => 49,
nsec3 => 50,
nsec3param => 51,
tlsa => 52,
smimea => 53,
hip => 55,
cds => 59,
cdnskey => 60,
openpgpkey => 61,
csync => 62,
zonemd => 63,
svcb => 64,
https => 65,
eui48 => 108,
eui64 => 109,
tkey => 249,
tsig => 250,
ixfr => 251,
axfr => 252,
any => 255,
'*' => 255,
uri => 256,
caa => 257,
},
},
syslog_severity => {
numeric => 1,
map => {
emerg => 0,
panic => 0,
alert => 1,
crit => 2,
err => 3,
error => 3,
warning => 4,
warn => 4,
notice => 5,
info => 6,
informational => 6,
debug => 7,
},
},
syslog_facility => {
numeric => 1,
map => {
kern => 0,
user => 1,
mail => 2,
daemon => 3,
auth => 4,
security => 4,
syslog => 5,
lpr => 6,
news => 7,
uucp => 8,
cron => 9,
authpriv => 10,
ftp => 11,
ntp => 12,
audit => 13,
alert => 14,
clock => 15,
( map { ( "local$_" => 16 + $_ ) } 0 .. 7 ),
},
},
ip_proto => {
numeric => 1,
map => {
icmp => 1,
igmp => 2,
ipip => 4,
ipencap => 4,
tcp => 6,
egp => 8,
udp => 17,
dccp => 33,
ipv6 => 41,
rsvp => 46,
gre => 47,
esp => 50,
ah => 51,
icmpv6 => 58,
'ipv6-icmp' => 58,
ospf => 89,
pim => 103,
sctp => 132,
udplite => 136,
},
},
tls_version => {
numeric => 0,
map => {
sslv2 => 0,
ssl2 => 0,
sslv3 => 1,
ssl3 => 1,
tlsv1 => 2,
'tlsv1.0' => 2,
tls1 => 2,
'tls1.0' => 2,
'tlsv1.1' => 3,
'tls1.1' => 3,
'tlsv1.2' => 4,
'tls1.2' => 4,
'tlsv1.3' => 5,
'tls1.3' => 5,
},
},
http_method => {
numeric => 0,
map => {
lib/Algorithm/ToNumberMunger.pm view on Meta::CPAN
$m{'s-1-16-8192'} = 2;
$m{'s-1-16-12288'} = 3;
$m{'s-1-16-16384'} = 4;
%m;
},
},
},
windows_logon_status => {
numeric => 0,
map => {
# Common NTSTATUS sub-status codes on failed logons (4625/4776),
# mapped to a compact reason category -- the raw 32-bit value is
# not itself a useful feature. Keys are the hex codes as logged.
'0xc0000064' => 0, # user name does not exist
'0xc000006a' => 1, # bad password
'0xc000006d' => 2, # bad user name or password (generic)
'0xc000006f' => 3, # outside authorized hours
'0xc0000070' => 4, # workstation restriction
'0xc0000071' => 5, # password expired
'0xc0000072' => 6, # account disabled
'0xc0000193' => 7, # account expired
'0xc0000133' => 8, # clock skew between client and server
'0xc0000224' => 9, # must change password at next logon
'0xc0000234' => 10, # account locked out
'0xc000015b' => 11, # logon type not granted
},
},
windows_impersonation_level => {
numeric => 0,
map => {
# 4624 ImpersonationLevel; ordinal by reach. Text labels plus the
# two "%%18xx" message tokens Windows most often emits in place.
anonymous => 0,
identification => 1,
impersonation => 2,
delegation => 3,
'%%1832' => 1,
'%%1833' => 2,
},
},
aad_signin_error => {
numeric => 0,
map => {
# Azure AD / Entra sign-in ResultType codes collapsed to a compact
# reason category -- the raw code is a huge sparse space whose
# magnitude carries no signal. Keys are the numeric codes as
# logged; only the common subset is baked in, the rest take the
# default.
'0' => 0, # success
'50126' => 1, # invalid username or password
'50056' => 1, # invalid or null password
'50034' => 2, # user does not exist in directory
'50057' => 3, # account disabled
'50053' => 4, # account locked / smart lockout
'50055' => 5, # password expired
'50144' => 5, # AD password expired
'50074' => 6, # strong auth (MFA) required
'50076' => 6, # MFA required by conditional access
'50079' => 6, # user must enroll for MFA
'500121' => 7, # MFA denied / authentication failed
'50158' => 7, # external security challenge not satisfied
'53003' => 8, # blocked by conditional access
'53000' => 8, # device not compliant (CA)
'53001' => 8, # device not domain joined (CA)
'530032' => 8, # blocked by security policy (CA)
'50173' => 9, # fresh auth token required (session expired)
},
},
risk_level => {
numeric => 0,
map => {
# Entra Identity Protection riskLevel, ordinal. hidden /
# unknownFutureValue are left to the default.
none => 0,
low => 1,
medium => 2,
high => 3,
},
},
aws_principal_type => {
numeric => 0,
map => {
# CloudTrail userIdentity.type. Nominal (distinct stable numbers);
# 'root' is the value you actually alert on.
do {
my @o = qw(
root iamuser assumedrole federateduser samluser
webidentityuser directory identitycenteruser
awsaccount awsservice unknown
);
map { $o[$_] => $_ } 0 .. $#o;
},
},
},
aad_client_app => {
numeric => 0,
map => {
# Azure AD ClientAppUsed. Numbered so the modern clients sort low
# and the legacy-auth protocols (which cannot do MFA) sort high --
# a ">= 2 means legacy auth" threshold is the feature you want.
do {
my %m = (
'browser' => 0,
'mobile apps and desktop clients' => 1,
);
my @legacy = (
'exchange activesync',
'imap4',
'pop3',
'authenticated smtp',
'smtp',
'mapi over http',
'exchange web services',
'exchange online powershell',
'autodiscover',
'offline address book',
'other clients',
);
my $i = 2;
$m{$_} = $i++ for @legacy;
$m{'imap'} = $m{'imap4'};
$m{'pop'} = $m{'pop3'};
$m{'mapi'} = $m{'mapi over http'};
%m;
},
lib/Algorithm/ToNumberMunger.pm view on Meta::CPAN
Parse a string as a number in C<base> (2-36, default 10). Base 10 simply
validates and numifies. Other bases accept the digits C<0-9a-z> below the
base, case-insensitively, an optional leading C<->, and the conventional
prefix for that base (C<0x> for 16, C<0b> for 2, C<0o> for 8). Plenty of
tooling logs flag words and IDs in hex (C<0x2f>), which the Writer would
reject as non-numeric; this munger is the bridge. Croaks on anything that is
not a clean number in the chosen base.
=cut
sub _build_num {
my ( $spec, $where ) = @_;
my $base = defined $spec->{base} ? $spec->{base} : 10;
croak "num munger$where: 'base' must be an integer from 2 to 36"
unless $base =~ /\A[0-9]+\z/ && $base >= 2 && $base <= 36;
if ( $base == 10 ) {
return sub {
my ($v) = @_;
croak "num munger$where: '" . ( defined $v ? $v : 'undef' ) . "' is not numeric"
unless looks_like_number($v);
return $v + 0;
};
}
my %digit;
my $i = 0;
$digit{$_} = $i++ for ( '0' .. '9', 'a' .. 'z' );
# Strip only the base's own conventional prefix; for other bases a letter
# like 'b' is just a digit, so there is nothing to disambiguate.
my $prefix
= $base == 16 ? qr/\A0x/
: $base == 8 ? qr/\A0o/
: $base == 2 ? qr/\A0b/
: undef;
return sub {
my ($v) = @_;
my $s = defined $v ? lc "$v" : '';
my $err = "num munger$where: '" . ( defined $v ? $v : 'undef' ) . "' is not a base-$base number";
my $neg = $s =~ s/\A-//;
$s =~ s/$prefix// if defined $prefix;
croak $err unless length $s;
my $n = 0;
for my $c ( split //, $s ) {
my $d = $digit{$c};
croak $err unless defined $d && $d < $base;
$n = $n * $base + $d;
}
return $neg ? -$n : $n;
}; ## end sub
} ## end sub _build_num
=head2 ratio
# 'io_ratio' is a tag; bytes_out and bytes_in are input fields
"io_ratio": { "munger": "ratio", "from": ["bytes_out", "bytes_in"] }
{ munger => 'ratio', from => [qw(bytes_out bytes_in)], zero => -1 }
First source divided by the second: with C<< from => [a, b] >> the column gets
C<a / b>. Asymmetry between two counters is a classic feature the counters
alone cannot express -- bytes out over bytes in flags exfiltration, requests
over responses flags scanning -- and the division has to happen at munge time
because a forest split only ever sees one column. A zero denominator yields
C<zero> (default C<0>) instead of dying, since "nothing came back" is a
legitimate row, not bad input; pick a C<zero> outside the ratio's normal range
if you want those rows to stand out. Both inputs must be numeric.
This is a B<multi-input> munger: it only makes sense with several sources, so
it is only usable through L</compile> with C<from> as an arrayref of exactly
two field names (and thus C<apply_named> / C<write_named>). The sources are
raw input fields, not other columns.
=head2 combine
{ munger => 'combine', op => 'sum', from => [qw(bytes_in bytes_out)] }
{ munger => 'combine', op => 'max', from => [qw(req_time resp_time)] }
Fold two or more numeric source fields into one column with C<op>: C<sum>,
C<diff> (first minus second; exactly two sources), C<product>, C<min>, C<max>,
or C<mean>. The general-purpose sibling of L</ratio> for when the interesting
feature is a total, a gap, or an extreme across fields rather than any one
field. Every input must be numeric.
Like C<ratio>, this is a B<multi-input> munger: only usable through
L</compile> with C<from> as an arrayref of source field names.
=cut
sub _build_ratio {
my ( $spec, $where, $nsrc ) = @_;
croak "ratio munger$where takes exactly 2 source fields (numerator, denominator), not $nsrc"
unless $nsrc == 2;
my $zero = defined $spec->{zero} ? $spec->{zero} : 0;
croak "ratio munger$where: 'zero' must be numeric"
unless looks_like_number($zero);
return sub {
for my $v (@_) {
croak "ratio munger$where: '" . ( defined $v ? $v : 'undef' ) . "' is not numeric"
unless looks_like_number($v);
}
return $zero if $_[1] == 0;
return $_[0] / $_[1];
};
} ## end sub _build_ratio
# op => fold over the already numeric-checked source values. A table so the
# error message can enumerate them and a new op is one line.
my %COMBINE_OPS = (
sum => sub { my $t = 0; $t += $_ for @_; return $t },
diff => sub { return $_[0] - $_[1] },
product => sub { my $t = 1; $t *= $_ for @_; return $t },
min => sub {
my $t = shift;
for (@_) { $t = $_ if $_ < $t }
return $t;
},
max => sub {
my $t = shift;
for (@_) { $t = $_ if $_ > $t }
return $t;
},
mean => sub { my $t = 0; $t += $_ for @_; return $t / @_ },
);
sub _build_combine_op {
my ( $spec, $where, $nsrc ) = @_;
my $op = $spec->{op};
croak "combine munger$where requires an 'op' (one of: " . join( ', ', sort keys %COMBINE_OPS ) . ')'
unless defined $op && length $op;
my $fold = $COMBINE_OPS{$op}
or croak "combine munger$where: unknown op '$op' (known: " . join( ', ', sort keys %COMBINE_OPS ) . ')';
croak "combine munger$where: op 'diff' takes exactly 2 source fields, not $nsrc"
if $op eq 'diff' && $nsrc != 2;
return sub {
lib/Algorithm/ToNumberMunger.pm view on Meta::CPAN
unless ref $nets eq 'ARRAY' && @$nets;
# [family, masked network, mask] per net; & on the 16-byte v6 strings is
# Perl's bitwise string AND, so both families match the same way.
my @match;
for my $i ( 0 .. $#$nets ) {
my $net = $nets->[$i];
croak "cidr munger$where: nets[$i] ('"
. ( defined $net ? $net : 'undef' )
. "') is not in 'address/prefix' form"
unless defined $net && $net =~ m{\A(.+)/([0-9]{1,3})\z};
my ( $addr, $len ) = ( $1, $2 );
my ( $fam, $p ) = _parse_ip($addr);
croak "cidr munger$where: nets[$i] ('$net') has an unparseable address"
unless $fam;
my $max = $fam == 4 ? 32 : 128;
croak "cidr munger$where: nets[$i] ('$net') prefix length must be 0-$max"
if $len > $max;
my $mask
= $fam == 4
? ( $len == 0 ? 0 : ( 0xffffffff << ( 32 - $len ) ) & 0xffffffff )
: _v6_mask($len);
push @match, [ $fam, $p & $mask, $mask ];
} ## end for my $i ( 0 .. $#$nets )
my $has_default = exists $spec->{default};
my $default = $spec->{default};
croak "cidr munger$where: 'default' must be numeric"
if $has_default && !looks_like_number($default);
return sub {
my ($v) = @_;
my ( $fam, $p ) = _parse_ip( defined $v ? "$v" : '' );
if ($fam) {
for my $i ( 0 .. $#match ) {
my ( $f, $network, $mask ) = @{ $match[$i] };
next unless $f == $fam;
return $i
if $fam == 4
? ( ( $p & $mask ) == $network )
: ( ( $p & $mask ) eq $network );
}
return $default if $has_default;
croak "cidr munger$where: '$v' is in none of the listed networks (and no 'default')";
} ## end if ($fam)
return $default if $has_default;
croak "cidr munger$where: '" . ( defined $v ? $v : 'undef' ) . "' is not a parseable IP address";
}; ## end sub
} ## end sub _build_cidr
=head2 datetime
{ munger => 'datetime', format => '%Y-%m-%dT%H:%M:%S', part => 'epoch' }
{ munger => 'datetime', format => '%Y-%m-%d %H:%M:%S', part => 'hour' }
Parse a formatted timestamp with L<Time::Piece> (C<strptime>, so C<format> is a
standard strptime pattern) and extract one numeric C<part>:
=over 4
=item * C<epoch> (default) - seconds since the epoch.
=item * C<year>, C<mon> (1-12), C<mday> (1-31), C<hour>, C<min>, C<sec>.
=item * C<wday> - day of week, C<0>=Sunday .. C<6>=Saturday.
=item * C<yday> - day of year, C<0>-based.
=item * C<frac_day> - time of day as a fraction in C<[0, 1)>, i.e.
C<(hour*3600 + min*60 + sec) / 86400>. Handy as a cyclic-ish time-of-day feature.
=item * C<frac_week> - position within the week as a fraction in C<[0, 1)>, the
week starting Sunday to match C<wday>: C<(wday*86400 + hour*3600 + min*60 + sec)
/ 604800>. Like C<frac_day> but cycling over a week, so a weekly rhythm (weekend
vs. weekday, or a Monday-morning batch) shows up as a feature.
=item * C<sin_day> / C<cos_day>, C<sin_week> / C<cos_week> - the C<frac_*> value
mapped onto a circle, C<sin(2*pi*frac)> and C<cos(2*pi*frac)>. Prefer these over
the raw C<frac_*> when feeding the forest: a plain fraction has a false seam at
the wrap (23:59 and 00:00 sit at opposite ends, 1 vs 0, though they are a minute
apart), whereas the sin/cos pair is continuous across midnight/Sunday. Store
I<both> of a pair in two columns so the position is unambiguous.
=back
Time features often carry the anomaly (a job that normally runs at 03:00
suddenly firing at noon, or a weekday task firing on a Sunday), which is why this
is a first-class munger.
B<Multi-output form.> A cyclic pair belongs together -- C<sin> alone collides
(C<sin> is symmetric about its peak, so two different times map to one value) and
the forest then treats distinct times as identical. To emit a pair atomically,
give C<parts> (plural) and route them to two columns with C<into> (see
L</compile>):
"time_of_week": {
"munger": "datetime", "from": "timestamp",
"format": "%Y-%m-%dT%H:%M:%S",
"parts": [ "sin_week", "cos_week" ],
"into": [ "time_sin", "time_cos" ]
}
The timestamp is parsed once and both columns are filled together, so they can
never drift apart or be half-configured. C<parts> and C<into> must be the same
length. (Using C<parts> without C<into>, or C<part> with C<into>, is an error.)
B<Performance.> Two transparent accelerations, both value-identical to the plain
path: a one-slot memo returns the previous result when the same stamp string
repeats (the common case in bursty event streams); and when the format is built
from only the six numeric codes C<%Y %m %d %H %M %S> (once each, e.g.
C<%Y-%m-%dT%H:%M:%S>), parsing skips C<strptime> for a compiled regex plus
integer date math, falling back to C<strptime> for any value the regex does not
match B<or whose fields are out of range> (a month C<13>, an hour C<24>, a
C<Feb 30>) -- so an invalid stamp croaks or normalizes exactly as C<strptime>
would, never silently feeding nonsense to the date math. Like C<strptime>
without a zone code, stamps are treated as UTC.
=cut
# Fraction (in [0,1)) of the way through the day / week, shared by the frac_*
# parts and their sin/cos cyclic encodings.
sub _frac_day {
my $t = shift;
return ( $t->hour * 3600 + $t->min * 60 + $t->sec ) / 86400;
}
sub _frac_week {
my $t = shift;
return ( $t->day_of_week * 86400 + $t->hour * 3600 + $t->min * 60 + $t->sec ) / 604800;
}
my $TWO_PI = 2 * atan2( 0, -1 ); # atan2(0,-1) == pi, core-only, no POSIX
# part name => how to pull it off a Time::Piece object.
my %DATETIME_PART = (
epoch => sub { $_[0]->epoch },
year => sub { $_[0]->year },
mon => sub { $_[0]->mon },
mday => sub { $_[0]->mday },
hour => sub { $_[0]->hour },
min => sub { $_[0]->min },
sec => sub { $_[0]->sec },
wday => sub { $_[0]->day_of_week },
yday => sub { $_[0]->yday },
frac_day => \&_frac_day,
frac_week => \&_frac_week,
sin_day => sub { sin( $TWO_PI * _frac_day( $_[0] ) ) },
cos_day => sub { cos( $TWO_PI * _frac_day( $_[0] ) ) },
sin_week => sub { sin( $TWO_PI * _frac_week( $_[0] ) ) },
cos_week => sub { cos( $TWO_PI * _frac_week( $_[0] ) ) },
);
# ---- fast fixed-format engine ----------------------------------------------
#
# Time::Piece->strptime costs microseconds per call. When the format is built
# from only the six all-numeric codes below (once each, e.g. the ubiquitous
# '%Y-%m-%dT%H:%M:%S'), we can compile it to a capture regex and derive every
# part with integer math instead -- several times faster, and bit-identical:
# both paths treat the stamp as UTC (strptime with no zone does the same).
# Anything fancier (%b, %z, %j, ...) stays on strptime.
# strptime code => [ field name, capture pattern ].
my %FAST_CODE = (
Y => [ 'year', '[0-9]{4}' ],
m => [ 'mon', '[0-9]{2}' ],
d => [ 'mday', '[0-9]{2}' ],
H => [ 'hour', '[0-9]{2}' ],
M => [ 'min', '[0-9]{2}' ],
S => [ 'sec', '[0-9]{2}' ],
);
# Compile a strptime format into { re, idx } for the arithmetic fast path --
# idx maps field name (year/mon/...) to its capture position -- or return undef
# when the format is not fast-eligible. All six codes must appear exactly once
# so every part can be derived.
sub _compile_fast_format {
my ($format) = @_;
my $re = '';
my %idx = ();
my $n = 0;
my $rest = $format;
while ( length $rest ) {
if ( $rest =~ s/\A%(.)//s ) {
my $f = $FAST_CODE{$1} or return undef;
return undef if exists $idx{ $f->[0] };
$idx{ $f->[0] } = $n++;
$re .= '(' . $f->[1] . ')';
} elsif ( $rest =~ s/\A([^%]+)//s ) {
$re .= quotemeta($1);
} else {
return undef; # lone trailing '%' -- not fast-eligible
}
} ## end while ( length $rest )
return undef unless keys %idx == 6;
return { re => qr/\A$re\z/, idx => \%idx };
} ## end sub _compile_fast_format
# A regex match only proves each fast-path field is digits of the right width,
# not that the six of them form a real timestamp: '2026-13-01T25:00:00' matches
# the shape. Fields out of range (month 13, hour 24, Feb 30) must not reach the
# blind integer date math -- they are routed to strptime instead, which stays
# the judge of whether such a stamp croaks or normalizes (Time::Piece rolls
# Feb 30 over into March), keeping the two paths value-identical. Seconds stop
# at 59: a :60 leap second is not representable in epoch math, so strptime
# arbitrates it too.
my @DAYS_IN_MONTH = ( 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 );
sub _fast_fields_in_range {
my ( $c, $idx ) = @_;
my ( $y, $m, $d, $H, $M, $S ) = @{$c}[ @{$idx}{qw(year mon mday hour min sec)} ];
return 0 if $m < 1 || $m > 12;
my $dim = $DAYS_IN_MONTH[ $m - 1 ];
$dim = 29 if $m == 2 && ( ( !( $y % 4 ) && $y % 100 ) || !( $y % 400 ) );
return 0 if $d < 1 || $d > $dim;
return 0 if $H > 23 || $M > 59 || $S > 59;
return 1;
} ## end sub _fast_fields_in_range
# Days since 1970-01-01 for a proleptic-Gregorian date (Howard Hinnant's
# days-from-civil). Pure integer math; Perl's % already yields a non-negative
# result for the wday derivation even on pre-1970 dates.
sub _days_from_civil {
my ( $y, $m, $d ) = @_;
$y -= $m <= 2;
my $era = int( ( $y >= 0 ? $y : $y - 399 ) / 400 );
my $yoe = $y - $era * 400;
my $doy = int( ( 153 * ( $m + ( $m > 2 ? -3 : 9 ) ) + 2 ) / 5 ) + $d - 1;
my $doe = $yoe * 365 + int( $yoe / 4 ) - int( $yoe / 100 ) + $doy;
return $era * 146097 + $doe - 719468;
}
# part name => factory(\%idx) => getter(\@captures). Mirrors %DATETIME_PART;
# t/mungers-datetime-fast.t asserts the two stay value-identical. The factories
# bake the capture positions in at build time so a per-row getter indexes the
# raw capture array directly -- no intermediate hash per row, which is where
# the fast path's time would otherwise go. Slot 6 of the capture array caches
# days-from-civil so a multi-part (sin/cos) extraction computes it once.
my %DATETIME_PART_FAST;
{
my $days_of = sub {
my ( $iy, $im, $id ) = @{ $_[0] }{qw(year mon mday)};
return sub {
my $c = shift;
return defined $c->[6]
? $c->[6]
: ( $c->[6] = _days_from_civil( $c->[$iy], $c->[$im], $c->[$id] ) );
};
};
my $sod_of = sub {
my ( $ih, $in, $is ) = @{ $_[0] }{qw(hour min sec)};
return sub { $_[0][$ih] * 3600 + $_[0][$in] * 60 + $_[0][$is] };
};
my $frac_day_of = sub {
my $sod = $sod_of->( $_[0] );
return sub { $sod->( $_[0] ) / 86400 };
};
my $frac_week_of = sub {
my ( $days, $sod ) = ( $days_of->( $_[0] ), $sod_of->( $_[0] ) );
return sub {
my $c = shift;
return ( ( ( $days->($c) + 4 ) % 7 ) * 86400 + $sod->($c) ) / 604800;
};
};
my $field_of = sub {
my ($name) = @_;
return sub {
my $i = $_[0]{$name};
return sub { $_[0][$i] + 0 }
};
};
%DATETIME_PART_FAST = (
year => $field_of->('year'),
mon => $field_of->('mon'),
mday => $field_of->('mday'),
hour => $field_of->('hour'),
min => $field_of->('min'),
sec => $field_of->('sec'),
epoch => sub {
my ( $days, $sod ) = ( $days_of->( $_[0] ), $sod_of->( $_[0] ) );
return sub { $days->( $_[0] ) * 86400 + $sod->( $_[0] ) };
},
wday => sub { # epoch day 0 = Thursday = 4
my $days = $days_of->( $_[0] );
return sub { ( $days->( $_[0] ) + 4 ) % 7 };
},
yday => sub {
my ($idx) = @_;
my $days = $days_of->($idx);
my $iy = $idx->{year};
return sub {
my $c = shift;
return $days->($c) - _days_from_civil( $c->[$iy], 1, 1 );
};
},
frac_day => $frac_day_of,
frac_week => $frac_week_of,
sin_day => sub {
my $f = $frac_day_of->( $_[0] );
return sub { sin( $TWO_PI * $f->( $_[0] ) ) };
},
cos_day => sub {
my $f = $frac_day_of->( $_[0] );
return sub { cos( $TWO_PI * $f->( $_[0] ) ) };
},
sin_week => sub {
my $f = $frac_week_of->( $_[0] );
return sub { sin( $TWO_PI * $f->( $_[0] ) ) };
},
cos_week => sub {
my $f = $frac_week_of->( $_[0] );
return sub { cos( $TWO_PI * $f->( $_[0] ) ) };
},
);
}
# Build the parse/getter machinery for a datetime spec: ($parse, $getter_for),
# where $parse->($v) yields whatever the getters consume (a capture array on
# the fast path, a Time::Piece object otherwise) and $getter_for->($part)
# resolves a part name to a getter closure, croaking on an unknown part.
# Shared by the scalar and multi-output builders so the choice is made in
# exactly one place.
sub _datetime_engine {
my ( $format, $where ) = @_;
croak "datetime munger$where requires a strptime 'format'"
unless defined $format && length $format;
# Time::Piece is not core on the ancient perls Makefile.PL still nominally
# supports, so only pull it in for the one munger that needs it. The fast
# path keeps it loaded too: a regex mismatch falls back to strptime so the
# fast path can never reject a value the slow path would have accepted.
require Time::Piece;
my $strptime = sub {
my ($v) = @_;
my $t = eval { Time::Piece->strptime( $v, $format ) };
croak "datetime munger$where: cannot parse '$v' with '$format'"
unless $t;
return $t;
};
if ( my $fast = _compile_fast_format($format) ) {
my ( $re, $idx ) = @{$fast}{qw(re idx)};
my $parse = sub {
my ($v) = @_;
croak "datetime munger$where: undefined value" unless defined $v;
if ( my @c = $v =~ $re ) {
return \@c if _fast_fields_in_range( \@c, $idx );
}
# Regex mismatch or out-of-range fields: let strptime be the judge,
# rebuilding the capture array (normalized, when strptime chooses
# to normalize rather than reject) in this format's capture order.
my $t = $strptime->($v);
my @c;
@c[ @{$idx}{qw(year mon mday hour min sec)} ]
= ( $t->year, $t->mon, $t->mday, $t->hour, $t->min, $t->sec );
return \@c;
}; ## end $parse = sub
my $getter_for = sub {
my ($part) = @_;
my $factory = $DATETIME_PART_FAST{$part}
or croak "datetime munger$where: unknown part '$part' (known: "
. join( ', ', sort keys %DATETIME_PART ) . ')';
return $factory->($idx);
};
return ( $parse, $getter_for );
} ## end if ( my $fast = _compile_fast_format($format...))
my $parse = sub {
my ($v) = @_;
croak "datetime munger$where: undefined value" unless defined $v;
return $strptime->($v);
};
my $getter_for = sub {
my ($part) = @_;
my $get = $DATETIME_PART{$part}
or croak "datetime munger$where: unknown part '$part' (known: "
. join( ', ', sort keys %DATETIME_PART ) . ')';
return $get;
};
return ( $parse, $getter_for );
} ## end sub _datetime_engine
sub _build_datetime {
my ( $spec, $where ) = @_;
croak "datetime munger$where: 'parts' is for the multi-output form (needs "
. "'into'); use 'part' for a single column"
if defined $spec->{parts};
my ( $parse, $getter_for ) = _datetime_engine( $spec->{format}, $where );
my $get = $getter_for->( defined $spec->{part} ? $spec->{part} : 'epoch' );
# One-slot memo: event streams repeat the same stamp within a second
# constantly, so the previous input usually answers the next call with a
# string compare. A parse failure leaves the memo untouched.
my ( $memo_in, $memo_out );
return sub {
my ($v) = @_;
return $memo_out
if defined $v && defined $memo_in && $v eq $memo_in;
my $out = $get->( $parse->($v) );
( $memo_in, $memo_out ) = ( $v, $out );
return $out;
};
} ## end sub _build_datetime
# Multi-output datetime: parse once, emit one number per part, in 'parts' order
# (which lines up with the caller's 'into'). Returns ($list_returning_code,
# $arity) so compile() can check the arity against 'into'. Memoized like the
# scalar form, caching the whole output list per input stamp.
sub _build_datetime_multi {
my ( $spec, $where ) = @_;
my $parts = $spec->{parts};
croak "datetime munger$where: 'parts' must be a non-empty arrayref"
unless ref $parts eq 'ARRAY' && @$parts;
my ( $parse, $getter_for ) = _datetime_engine( $spec->{format}, $where );
my @get = map { $getter_for->($_) } @$parts;
my ( $memo_in, @memo_out );
my $code = sub {
my ($v) = @_;
return @memo_out
if defined $v && defined $memo_in && $v eq $memo_in;
my $t = $parse->($v);
my @out = map { $_->($t) } @get;
( $memo_in, @memo_out ) = ( $v, @out );
return @out;
};
return ( $code, scalar @$parts );
} ## end sub _build_datetime_multi
=head2 hash
{ munger => 'hash', buckets => 1024 }
{ munger => 'hash', buckets => 1024, seed => 7 }
{ munger => 'hash' } # raw 32-bit FNV-1a value
Feature hashing for high-cardinality categoricals you do not want to (or cannot)
enumerate with C<enum>. The input is stringified and run through 32-bit FNV-1a;
with C<buckets> the result is reduced modulo that many buckets (C<[0, buckets)>),
otherwise the full 32-bit hash is returned. An optional C<seed> lets you decorrelate
two hashed columns.
This is the one munger that is XS-accelerated: FNV-1a is a per-byte loop with a
32-bit modular multiply, which is slow in pure Perl and (on a 32-bit perl) fussy
to get exactly right. C<$Algorithm::ToNumberMunger::HAVE_XS>
reports whether the compiled path is in use; a pure-Perl fallback (exact on a
64-bit perl) is used otherwise, and both produce identical values.
=cut
lib/Algorithm/ToNumberMunger.pm view on Meta::CPAN
croak "chain munger$where requires a 'then' hashref -- the terminal munger that produces the number"
unless ref $then eq 'HASH';
my $name = $then->{munger};
croak "chain munger$where: 'then' has no 'munger' name"
unless defined $name && length $name;
return ( $then, $name );
} ## end sub _chain_terminal_spec
sub _build_chain {
my ( $spec, $where ) = @_;
my $ops = _chain_steps( $spec, $where );
my ( $then, $name ) = _chain_terminal_spec( $spec, $where );
my $builder = $BUILDERS{$name}
or croak "chain munger$where: unknown terminal munger '$name' (known: "
. join( ', ', sort keys %BUILDERS ) . ')';
my $term = $builder->( $then, "$where (chain terminal)" );
return sub {
my $s = defined $_[0] ? "$_[0]" : '';
$s = $_->($s) for @$ops;
return $term->($s);
};
} ## end sub _build_chain
# Multi-output chain: the same pre-transforms, but the terminal is one of the
# multi-output ('into') mungers. Returns ($list_returning_code, $arity) like
# every multi builder; the arity is the terminal's.
sub _build_chain_multi {
my ( $spec, $where ) = @_;
my $ops = _chain_steps( $spec, $where );
my ( $then, $name ) = _chain_terminal_spec( $spec, $where );
my $builder = $MULTI_BUILDERS{$name}
or croak "chain munger$where: terminal munger '$name' does not support "
. "multiple outputs ('into'); only these do: "
. join( ', ', sort keys %MULTI_BUILDERS );
my ( $term, $arity ) = $builder->( $then, "$where (chain terminal)" );
my $code = sub {
my $s = defined $_[0] ? "$_[0]" : '';
$s = $_->($s) for @$ops;
return $term->($s);
};
return ( $code, $arity );
} ## end sub _build_chain_multi
=head2 eps
{ munger => 'eps', prefix => 'http-req:', from => 'src_ip' }
{ munger => 'eps', prefix => 'dns-nxd:', from => 'src_ip',
read => 'rate', mark => 0 }
# multi-output: one daemon round trip fills several columns
{ munger => 'eps', prefix => 'http-req:', from => 'src_ip',
parts => [ 'rate', 'count' ], into => [ 'req_rate', 'req_count' ] }
Per-entity sliding-window event rates via the C<iqbi-damiq> daemon shipped with
L<Algorithm::EventsPerSecond> (see
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>).
=item * C<prefix> - string prepended to the input to form the key, namespacing
this column's meters (two columns keyed on the same field need different
prefixes or they share meters). No whitespace/control characters. Default C<''>.
=item * C<mark> - whether to mark the key (default C<1>). Marking rides
C<MARKRATE>: with C<< read => 'rate' >> that one command is the whole exchange;
with C<count>/C<total> the read is pipelined after it (the C<MARKRATE> rate
reply is discarded), so a marking failure still comes back as an ordinary
first reply. With C<< mark => 0 >> the munger only reads, for columns whose
marking is done elsewhere -- e.g. an NXDOMAIN rate is I<marked> by the pipeline
only on NXDOMAIN responses but I<read> on every row.
=item * C<read> - what to read: C<rate> (events/sec over the daemon's window,
default), C<count> (events inside the window), or C<total> (lifetime).
=item * C<parts> + C<into> - multi-output form (see L</compile>): read several
of C<rate>/C<count>/C<total> for the one key in a single round trip, filling one
column each. When marking, the C<MARKRATE> reply itself serves the first C<rate>
part, so C<< parts => ['rate', 'count'] >> costs exactly two commands.
=item * C<on_error> - C<'die'> (default) croaks the write when the daemon is
unreachable or replies C<ERR>; a number is returned instead as a quiet fallback.
Note C<0> is indistinguishable from a genuinely idle key, so quiet fallback
biases the column -- loud is the default on purpose.
=item * C<timeout> - per-operation socket timeout in seconds (default 5,
best-effort via C<SO_RCVTIMEO>/C<SO_SNDTIMEO>), so a wedged daemon cannot hang a
writer forever.
=back
Semantics worth knowing: a marked read B<includes the event just marked>; keys
have whitespace/control bytes replaced with C<_> to satisfy the daemon's key
rules; connections are made lazily on first use and kept open (reconnecting
transparently after a fork or an error), so compiling a plan -- including the
eager validation in C<write_info> -- needs no running daemon. Each eps column
costs one unix-socket round trip per row; the multi-output form exists so
rate+count of the same key costs one round trip, not two.
=cut
# Default socket path of the iqbi-damiq daemon.
our $EPS_SOCKET = '/var/run/iqbi-damiq.sock';
# Persistent daemon connections, keyed by socket path, shared by every eps
# munger in the process. Entries record the pid that opened them so a forked
# writer transparently reopens instead of sharing a socket with its parent.
# Connections are made lazily on first use -- never at munger build time, so a
# plan can compile (eager validation) with no daemon running.
my %EPS_CONN;
sub _eps_conn {
my ( $path, $timeout ) = @_;
my $c = $EPS_CONN{$path};
return $c->{fh} if $c && $c->{pid} == $$;
require Socket;
require IO::Socket::UNIX;
my $fh = IO::Socket::UNIX->new(
Type => Socket::SOCK_STREAM(),
Peer => $path,
) or die "cannot connect to iqbi-damiq at $path: $!\n";
# Best-effort read/write timeouts so a wedged daemon cannot hang a writer.
eval {
my $tv = pack( 'l!l!', $timeout, 0 );
setsockopt( $fh, Socket::SOL_SOCKET(), Socket::SO_RCVTIMEO(), $tv );
setsockopt( $fh, Socket::SOL_SOCKET(), Socket::SO_SNDTIMEO(), $tv );
};
$EPS_CONN{$path} = { fh => $fh, pid => $$ };
return $fh;
} ## end sub _eps_conn
# One pipelined transaction: send $cmd (possibly several lines) and read
# $nreplies "OK n" lines, one per command sent. The munger only ever sends
# commands that reply exactly once -- MARKRATE (which marks AND returns the
# rate in one go), RATE, COUNT, TOTAL; never a bare MARK, whose reply-only-on-
# error behavior would let a failure desynchronize the reply stream. Dies on
# ERR, EOF, or timeout; the caller still drops the cached connection on error
# as belt and braces.
sub _eps_txn {
my ( $path, $timeout, $cmd, $nreplies ) = @_;
my $fh = _eps_conn( $path, $timeout );
print {$fh} $cmd or die "write to iqbi-damiq failed: $!\n";
my @out;
( run in 1.594 second using v1.01-cache-2.11-cpan-6aa56a78535 )