Algorithm-ToNumberMunger

 view release on metacpan or  search on metacpan

LICENSE  view on Meta::CPAN

    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

LICENSE  view on Meta::CPAN

    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

LICENSE  view on Meta::CPAN

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.

lib/Algorithm/ToNumberMunger.pm  view on Meta::CPAN

=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,

lib/Algorithm/ToNumberMunger.pm  view on Meta::CPAN

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,

lib/Algorithm/ToNumberMunger.pm  view on Meta::CPAN

# 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,

lib/Algorithm/ToNumberMunger.pm  view on Meta::CPAN

			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,

lib/Algorithm/ToNumberMunger.pm  view on Meta::CPAN

		},
	},
	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,

lib/Algorithm/ToNumberMunger.pm  view on Meta::CPAN

			'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,

lib/Algorithm/ToNumberMunger.pm  view on Meta::CPAN

		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 {

lib/Algorithm/ToNumberMunger.pm  view on Meta::CPAN

=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.

lib/Algorithm/ToNumberMunger.pm  view on Meta::CPAN

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      = ();

lib/Algorithm/ToNumberMunger.pm  view on Meta::CPAN

	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

lib/Algorithm/ToNumberMunger.pm  view on Meta::CPAN

	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;

lib/Algorithm/ToNumberMunger.pm  view on Meta::CPAN

			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) = @_;

lib/Algorithm/ToNumberMunger.pm  view on Meta::CPAN

			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 );

lib/Algorithm/ToNumberMunger.pm  view on Meta::CPAN

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;

lib/Algorithm/ToNumberMunger.pm  view on Meta::CPAN

    { 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.

lib/Algorithm/ToNumberMunger.pm  view on Meta::CPAN

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

t/mungers-datetime-fast.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';

my $FMT = '%Y-%m-%dT%H:%M:%S';    # fast-eligible: all six numeric codes

my @PARTS = qw(epoch year mon mday hour min sec wday yday
	frac_day frac_week sin_day cos_day sin_week cos_week);

# Stamps chosen to poke the arithmetic: epoch origin, leap day, year edges,
# pre-1970 (negative epoch days), and an ordinary modern stamp.
my @STAMPS = qw(
	1970-01-01T00:00:00
	1969-12-31T23:59:59
	2000-02-29T23:59:59
	1999-12-31T00:00:00
	2024-03-01T00:00:01

t/mungers-datetime-fast.t  view on Meta::CPAN

		# expected value straight off Time::Piece, computed here in the test so
		# the module's slow path is not the oracle for itself.
		my $t   = Time::Piece->strptime( $stamp, $FMT );
		my %exp = (
			epoch     => $t->epoch,
			year      => $t->year,
			mon       => $t->mon,
			mday      => $t->mday,
			hour      => $t->hour,
			min       => $t->min,
			sec       => $t->sec,
			wday      => $t->day_of_week,
			yday      => $t->yday,
			frac_day  => ( $t->hour * 3600 + $t->min * 60 + $t->sec ) / 86400,
			frac_week => ( $t->day_of_week * 86400 + $t->hour * 3600 + $t->min * 60 + $t->sec ) / 604800,
		);
		my $pi = 2 * atan2( 0, -1 );
		$exp{sin_day}  = sin( $pi * $exp{frac_day} );
		$exp{cos_day}  = cos( $pi * $exp{frac_day} );
		$exp{sin_week} = sin( $pi * $exp{frac_week} );
		$exp{cos_week} = cos( $pi * $exp{frac_week} );

		my $got = $fast->($stamp);
		ok( abs( $got - $exp{$part} ) < 1e-9, "$part($stamp) fast == strptime" )
			or diag("got $got, expected $exp{$part}");

t/mungers-datetime-strptime.t  view on Meta::CPAN

		'Apache CLF access log (%b month name)',
		'%d/%b/%Y:%H:%M:%S',
		'05/Jul/2026:13:37:42',
		{
			epoch => $EPOCH,
			year  => 2026,
			mon   => 7,
			mday  => 5,
			hour  => 13,
			min   => 37,
			sec   => 42,
			wday  => 0
		},
	],
	[
		'RFC 2822 email Date header (%a weekday, %b month)',
		'%a, %d %b %Y %H:%M:%S',
		'Sun, 05 Jul 2026 13:37:42',
		{ epoch => $EPOCH, hour => 13, wday => 0 },
	],
	[

t/mungers-datetime-strptime.t  view on Meta::CPAN

	[
		'syslog RFC 3164 (%b, no year -- strptime defaults it to 1970)',
		'%b %d %H:%M:%S',
		'Jul 05 13:37:42',
		{ epoch => 16033062, year => 1970, mon => 7, mday => 5, hour => 13 },
	],
	[
		'European dotted, minute precision (no %S)',
		'%d.%m.%Y %H:%M',
		'05.07.2026 13:37',
		{ epoch => $EPOCH - 42, sec => 0, hour => 13 },
	],
	[
		'ISO date-only (no time codes)', '%Y-%m-%d',
		'2026-07-05', { epoch => 1783209600, mday => 5, hour => 0, frac_day => 0 },
	],
	[ 'ISO 8601 basic compact date (%Y%m%d)', '%Y%m%d', '20260705', { epoch => 1783209600, mon => 7 }, ],
	[ 'epoch seconds (%s)', '%s', "$EPOCH", { epoch => $EPOCH, year => 2026, hour => 13 }, ],
);

for my $row (@FORMATS) {
	my ( $desc, $format, $stamp, $expect ) = @$row;

	# White-box guarantee: the fast engine must refuse this format, leaving
	# strptime as the only way the munger can parse it.
	is( Algorithm::ToNumberMunger::_compile_fast_format($format),
		undef, "$desc: format is not fast-eligible" );

t/mungers-eps.t  view on Meta::CPAN

my $sock = "$dir/eps.sock";
start_daemon($sock) or plan skip_all => 'iqbi-damiq did not come up';

# ---- mark + read ------------------------------------------------------------
{
	my $rate = $M->build( { munger => 'eps', socket => $sock, prefix => 't1:' } );
	my $r;
	$r = $rate->('k') for 1 .. 5;    # five marks against t1:k
	ok( defined $r && $r >= 0, 'marked rate read back a number' );

	# a meter's rate is count/elapsed-seconds, so a brand-new key reads 0
	# until the second boundary passes; age it, then a read-only rate is > 0.
	nap(1.1);
	my $rate_ro = $M->build(
		{
			munger => 'eps',
			socket => $sock,
			prefix => 't1:',
			mark   => 0
		}
	);
	ok( $rate_ro->('k') > 0, 'rate is positive once the meter has aged' );

t/mungers-eps.t  view on Meta::CPAN

				from   => 'ip',
				parts  => [qw(rate count)],
				into   => [qw(req_rate req_count)]
			},
		},
	);
	my $row;
	$row = $plan->apply_named( { ip => '10.0.0.1' } ) for 1 .. 3;
	is( $row->[1], 3, 'multi-output count reflects all three marks' );

	# age the meter past a second boundary, then the fourth call sees rate > 0
	nap(1.1);
	$row = $plan->apply_named( { ip => '10.0.0.1' } );
	ok( $row->[0] > 0, 'multi-output rate is positive once aged' );
	is( $row->[1], 4, 'fourth mark counted' );
}

# ---- on_error ----------------------------------------------------------------
{
	my $quiet = $M->build(
		{

t/mungers-eps.t  view on Meta::CPAN


# ---- MARKRATE's error reply (key limit) is caught, and the munger recovers ---
SKIP: {
	my $sock2 = "$dir/eps-limited.sock";
	start_daemon( $sock2, max_keys => 1 )
		or skip 'limited iqbi-damiq did not come up', 4;

	my $rate = $M->build( { munger => 'eps', socket => $sock2, prefix => 'L:' } );
	ok( defined $rate->('first'), 'first key fits under max_keys=1' );

	# a second key trips the limit; MARKRATE replies ERR in-band, one reply
	eval { $rate->('second') };
	like( $@, qr/iqbi-damiq replied: ERR key limit/, 'MARKRATE key-limit error croaks with the daemon message' );

	# after the error the connection was dropped; the next call reconnects
	ok( defined $rate->('first'), 'munger recovers on the next call' );

	my $quiet = $M->build(
		{
			munger   => 'eps',
			socket   => $sock2,
			prefix   => 'L:',
			on_error => -1
		}
	);
	is( $quiet->('second'), -1, 'numeric on_error absorbs the ERR reply' );
} ## end SKIP:

# ---- build-time validation (no daemon needed) --------------------------------
{
	ok( $M->build( { munger => 'eps', socket => "$dir/nothere.sock" } ), 'building an eps munger never connects' );

	eval { $M->build( { munger => 'eps', read => 'bogus' } ) };
	like( $@, qr/unknown read 'bogus'/, 'bad read mode croaks at build' );

	eval { $M->build( { munger => 'eps', parts => ['rate'] } ) };

t/mungers.t  view on Meta::CPAN

	like( $@, qr/'mode' must be/, 'match rejects bad mode' );
}

# ---- bucket ---------------------------------------------------------------
{
	my $port = $M->build( { munger => 'bucket', bounds => [ 1024, 49152 ] } );
	is( $port->(80),    0, 'bucket well-known port' );
	is( $port->(1023),  0, 'bucket just below first bound' );
	is( $port->(1024),  1, 'bucket at first bound is registered' );
	is( $port->(8080),  1, 'bucket registered port' );
	is( $port->(49152), 2, 'bucket at second bound is ephemeral' );
	is( $port->(60000), 2, 'bucket ephemeral port' );

	eval { $M->build( { munger => 'bucket', bounds => [] } ) };
	like( $@, qr/non-empty 'bounds'/, 'bucket rejects empty bounds' );
	eval { $M->build( { munger => 'bucket', bounds => [ 5, 5 ] } ) };
	like( $@, qr/strictly ascending/, 'bucket rejects non-ascending bounds' );
}

# ---- quantile ---------------------------------------------------------------
{

t/mungers.t  view on Meta::CPAN

	my $sev = $M->build( { munger => 'syslog_severity_enum' } );
	is( $sev->('emerg'), 0, 'syslog_severity_enum emerg' );
	is( $sev->('panic'), 0, 'syslog_severity_enum panic alias' );
	is( $sev->('ERROR'), 3, 'syslog_severity_enum error alias, case-insensitive' );
	is( $sev->('warn'),  4, 'syslog_severity_enum warn alias' );
	is( $sev->('debug'), 7, 'syslog_severity_enum debug' );
	is( $sev->(6),       6, 'syslog_severity_enum passes numeric input through' );

	my $fac = $M->build( { munger => 'syslog_facility_enum' } );
	is( $fac->('kern'),     0,  'syslog_facility_enum kern' );
	is( $fac->('security'), 4,  'syslog_facility_enum security alias for auth' );
	is( $fac->('authpriv'), 10, 'syslog_facility_enum authpriv' );
	is( $fac->('local0'),   16, 'syslog_facility_enum local0' );
	is( $fac->('LOCAL7'),   23, 'syslog_facility_enum local7, case-insensitive' );

	my $proto = $M->build( { munger => 'ip_proto_enum' } );
	is( $proto->('tcp'),       6,   'ip_proto_enum tcp' );
	is( $proto->('UDP'),       17,  'ip_proto_enum UDP, case-insensitive' );
	is( $proto->('icmp'),      1,   'ip_proto_enum icmp' );
	is( $proto->('ipv6-icmp'), 58,  'ip_proto_enum ipv6-icmp alias' );
	is( $proto->('sctp'),      132, 'ip_proto_enum sctp' );

t/mungers.t  view on Meta::CPAN

	is( $dmarc->('quarantine'),    -1, 'dmarc result != disposition (quarantine unlisted)' );

	eval { $M->build( { munger => 'spf_result_enum' } )->(4) };
	like( $@, qr/no mapping for '4'/, 'mail result enums do not pass a number through' );
}

# ---- Apache / Dovecot named enums -------------------------------------------
{
	# The full mechanism set the two SASL mungers share.
	my @mechs = 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
	);
	is( scalar(@mechs), 25, 'fuller SASL registry has 25 mechanisms' );

	my $s = $M->build( { munger => 'sasl_mech_enum',      default => -1 } );
	my $i = $M->build( { munger => 'sasl_mech_iana_enum', default => -1 } );

	# Both mungers cover exactly the same set, distinctly numbered.



( run in 2.157 seconds using v1.01-cache-2.11-cpan-6aa56a78535 )