Algorithm-ToNumberMunger
view release on metacpan or search on metacpan
lib/Algorithm/ToNumberMunger.pm view on Meta::CPAN
# Shared closure for the status-class mungers registered from %STATUS_PROTO.
sub _status_class_munger {
my ( $proto, $lo, $hi, $div, $spec, $where ) = @_;
my $strict = $spec->{strict} ? 1 : 0;
return sub {
my ($v) = @_;
croak "${proto}_enum munger$where: '" . ( defined $v ? $v : 'undef' ) . "' is not a numeric status code"
unless looks_like_number($v);
croak "${proto}_enum munger$where: status code '$v' is out of range " . "($lo-$hi)"
if $strict && ( $v < $lo || $v > $hi );
return int( $v / $div );
};
} ## end sub _status_class_munger
=head2 mgcp_enum
{ munger => 'mgcp_enum' }
{ munger => 'mgcp_enum', strict => 1 }
The MGCP counterpart of L</http_enum>, for MGCP (RFC 3435) response codes:
C<int(code / 100)>. MGCP's classes are C<1xx> provisional, C<2xx> success,
C<4xx> transient error, C<5xx> permanent error, and C<8xx> package-specific --
there are no C<6xx> or C<7xx> codes, so the valid set has a B<hole> in it.
With a true C<strict>, inputs outside C<100>-C<599> B<and> outside
C<800>-C<899> croak. (That hole is why this is a hand-written builder rather
than another row of the shared status-class table, which can only express one
contiguous range.)
=cut
# MGCP's strict range is [100,599] union [800,899] -- 8xx package-specific
# codes are real, 6xx/7xx are not -- which %STATUS_PROTO's single [lo, hi]
# cannot express, hence this dedicated builder.
sub _build_mgcp_enum {
my ( $spec, $where ) = @_;
my $strict = $spec->{strict} ? 1 : 0;
return sub {
my ($v) = @_;
croak "mgcp_enum munger$where: '" . ( defined $v ? $v : 'undef' ) . "' is not a numeric status code"
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>
lib/Algorithm/ToNumberMunger.pm view on Meta::CPAN
my $s = defined $v ? "$v" : '';
my $max = 0;
while ( $s =~ /$re/g ) {
$max = length $1 if length $1 > $max;
}
return $max;
};
} ## end sub _build_run
=head2 count
{ munger => 'count', of => '/' } # url_path_depth, topic_depth
{ munger => 'count', of => '.', plus => 1 } # label_count (dots + 1)
Count non-overlapping occurrences of a literal substring C<of> in the input,
optionally adding a constant C<plus>. This is the segment/depth feature behind
C<url_path_depth> and C<topic_depth> (count of C<`/`>) and C<label_count> (dots
plus one). C<of> is matched literally, not as a pattern, so C<.> means a literal
dot.
=cut
sub _build_count {
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++;
$p += $oflen;
}
return $n + $plus;
}; ## end sub
} ## end sub _build_count
=head2 match
{ munger => 'match', pattern => '^xn--' } # punycode label
{ munger => 'match', pattern => '%[0-9A-Fa-f]{2}', mode => 'count' }
Match the input against a Perl regular expression C<pattern>: C<1>/C<0> under
the default C<< mode => 'bool' >>, or the number of non-overlapping matches
with C<< mode => 'count' >>. A true C<ignore_case> makes the match
case-insensitive. This is the catch-all shape test behind flags like "is this
label punycode" or "is the Host an IP literal", and counters like
percent-escapes in a URL -- anything L</char> and L</count> are not expressive
enough for. The pattern is compiled at build time, so a broken one fails at
C<write_info> rather than per row.
B<Trust note:> a pattern cannot execute code (Perl requires C<use re 'eval'>
for that, which this module does not enable), but a pathological pattern can
still backtrack catastrophically and stall a writer. Treat munger specs --
like the rest of C<info.json> -- as configuration from a trusted operator,
not as untrusted input.
=cut
sub _build_match {
my ( $spec, $where ) = @_;
my $pat = $spec->{pattern};
croak "match munger$where requires a non-empty 'pattern'"
unless defined $pat && length $pat;
my $mode = defined $spec->{mode} ? $spec->{mode} : 'bool';
croak "match munger$where: 'mode' must be 'bool' or 'count'"
unless $mode eq 'bool' || $mode eq 'count';
# qr// on spec text cannot run code -- (?{...}) needs 'use re "eval"',
# which is not enabled here -- but it can be syntactically invalid, so
# compile eagerly and croak at build time.
my $re = eval { $spec->{ignore_case} ? qr/$pat/i : qr/$pat/ };
croak "match munger$where: cannot compile pattern '$pat': $@"
unless defined $re;
if ( $mode eq 'bool' ) {
return sub {
my $s = defined $_[0] ? "$_[0]" : '';
return $s =~ $re ? 1 : 0;
};
}
return sub {
my $s = defined $_[0] ? "$_[0]" : '';
my $n = () = $s =~ /$re/g;
return $n;
};
} ## end sub _build_match
=head2 bucket
{ munger => 'bucket', bounds => [ 1024, 49152 ] } # dest_port classes
Map a number to a bucket index by ascending C<bounds>: the result is how many
bounds the value is greater than or equal to. With C<< bounds => [1024, 49152] >>
a value under C<1024> is C<0> (well-known), C<1024>-C<49151> is C<1> (registered),
and C<49152>+ is C<2> (ephemeral) -- the classic port classing, where the literal
port number is meaningless to a threshold split but the I<class> is a real
signal. C<bounds> must be strictly ascending; N bounds yield indices C<0>..C<N>.
This generalises the C<*_enum> status-class mungers, which are the special case
of bucketing a reply code by its leading digit.
=cut
sub _build_bucket {
my ( $spec, $where ) = @_;
lib/Algorithm/ToNumberMunger.pm view on Meta::CPAN
for my $bound (@b) {
last if $v < $bound;
$idx++;
}
return $idx;
}; ## end sub
} ## end sub _build_bucket
=head2 quantile
{ munger => 'quantile', bounds => [ 40, 180, 460, 2200, 64000 ] }
Piecewise-linear ECDF: map a number onto C<[0, 1]> by where it falls among
ascending C<bounds> taken from the training data's quantiles (e.g. its
min / p25 / p50 / p75 / max). Values at or below the first bound map to C<0>,
at or above the last to C<1>, and anything between two adjacent bounds
interpolates linearly between their positions. This is L</bucket>'s continuous
sibling and the heavy-tail normaliser to reach for when L</log> is not enough
and L</zscore> would let one outlier stretch the whole scale: after the
transform the training distribution is roughly uniform, so a forest threshold
split lands anywhere in it with equal ease. C<bounds> must be strictly
ascending with at least two values; like C<zscore>, the parameters are
supplied rather than learned, so munging stays stateless.
=cut
sub _build_quantile {
my ( $spec, $where ) = @_;
my $bounds = $spec->{bounds};
croak "quantile munger$where requires a 'bounds' arrayref with at least 2 values"
unless ref $bounds eq 'ARRAY' && @$bounds >= 2;
my @b = @$bounds;
for my $i ( 0 .. $#b ) {
croak "quantile munger$where: bound[$i] ('" . ( defined $b[$i] ? $b[$i] : 'undef' ) . "') is not numeric"
unless looks_like_number( $b[$i] );
croak "quantile munger$where: 'bounds' must be strictly ascending"
if $i && $b[$i] <= $b[ $i - 1 ];
}
my $segs = $#b;
return sub {
my ($v) = @_;
croak "quantile munger$where: '" . ( defined $v ? $v : 'undef' ) . "' is not numeric"
unless looks_like_number($v);
return 0 if $v <= $b[0];
return 1 if $v >= $b[-1];
my $i = 0;
$i++ while $v >= $b[ $i + 1 ];
return ( $i + ( $v - $b[$i] ) / ( $b[ $i + 1 ] - $b[$i] ) ) / $segs;
}; ## end sub
} ## end sub _build_quantile
=head2 scale
{ munger => 'scale', min => 0, max => 1000, clamp => 1 }
Min-max normalisation: C<(v - min) / (max - min)>, mapping C<[min, max]> onto
C<[0, 1]>. C<min> and C<max> must differ. With a true C<clamp>, results are
pinned into C<[0, 1]> so out-of-range inputs cannot escape the unit interval.
=cut
sub _build_scale {
my ( $spec, $where ) = @_;
my ( $min, $max ) = @{$spec}{qw(min max)};
croak "scale munger$where requires numeric 'min' and 'max'"
unless looks_like_number($min) && looks_like_number($max);
my $range = $max - $min;
croak "scale munger$where: 'min' and 'max' must differ"
if $range == 0;
my $clamp = $spec->{clamp} ? 1 : 0;
return sub {
my ($v) = @_;
croak "scale munger$where: '" . ( defined $v ? $v : 'undef' ) . "' is not numeric"
unless looks_like_number($v);
my $s = ( $v - $min ) / $range;
if ($clamp) { $s = 0 if $s < 0; $s = 1 if $s > 1; }
return $s;
};
} ## end sub _build_scale
=head2 zscore
{ munger => 'zscore', mean => 42.0, std => 7.5 }
Standardise: C<(v - mean) / std>. C<std> must be non-zero. The C<mean>/C<std>
are supplied (this module does not learn them) so munging stays stateless and a
row can be munged in isolation.
=cut
sub _build_zscore {
my ( $spec, $where ) = @_;
my ( $mean, $std ) = @{$spec}{qw(mean std)};
croak "zscore munger$where requires numeric 'mean' and 'std'"
unless looks_like_number($mean) && looks_like_number($std);
croak "zscore munger$where: 'std' must be non-zero"
if $std == 0;
return sub {
my ($v) = @_;
croak "zscore munger$where: '" . ( defined $v ? $v : 'undef' ) . "' is not numeric"
unless looks_like_number($v);
return ( $v - $mean ) / $std;
};
} ## end sub _build_zscore
=head2 log
{ munger => 'log' } # natural log
{ munger => 'log', offset => 1 } # log1p-style, so 0 is allowed
{ munger => 'log', base => 10, offset => 1 }
Logarithm of C<v + offset>. Heavy-tailed counts (bytes, durations) compress well
under a log, which keeps a few huge values from dominating the forest. C<offset>
( run in 2.218 seconds using v1.01-cache-2.11-cpan-54e63673c56 )