view release on metacpan or  search on metacpan

t/mungers.t  view on Meta::CPAN

	is( $d->(undef),       -1, 'ip_class default for undef' );
	eval { $M->build( { munger => 'ip_class', default => 'x' } ) };
	like( $@, qr/'default' must be numeric/, 'ip_class validates default at build time' );
}

# ---- cidr -------------------------------------------------------------------
{
	my $c = $M->build(
		{
			munger  => 'cidr',
			nets    => [ '10.10.0.0/16', '10.0.0.0/8', '2001:db8:5::/48' ],
			default => -1,
		}
	);
	is( $c->('10.10.3.4'),      0, 'cidr: most-specific first match wins' );
	is( $c->('10.99.0.1'),      1, 'cidr: falls through to the wider net' );
	is( $c->('2001:db8:5::7'),  2, 'cidr: v6 net matches' );
	is( $c->('2001:db8:6::7'), -1, 'cidr: v6 outside the /48 takes default' );
	is( $c->('192.168.1.1'),   -1, 'cidr: unmatched v4 takes default' );
	is( $c->('not-an-ip'),     -1, 'cidr: garbage takes default' );

	# a v4 address is never tested against v6 nets (and vice versa)
	my $v6only = $M->build( { munger => 'cidr', nets => ['::/0'], default => -1 } );
	is( $v6only->('8.8.8.8'), -1, 'cidr: ::/0 does not swallow v4' );
	my $v4any = $M->build( { munger => 'cidr', nets => ['0.0.0.0/0'], default => -1 } );
	is( $v4any->('8.8.8.8'), 0, 'cidr: 0.0.0.0/0 matches any v4' );

	my $strict = $M->build( { munger => 'cidr', nets => ['10.0.0.0/8'] } );
	eval { $strict->('192.168.1.1') };
	like( $@, qr/none of the listed networks/, 'cidr croaks on no match without default' );
	eval { $strict->('nope') };
	like( $@, qr/not a parseable IP address/, 'cidr croaks on garbage without default' );

	eval { $M->build( { munger => 'cidr', nets => [] } ) };
	like( $@, qr/non-empty 'nets'/, 'cidr rejects empty nets' );
	eval { $M->build( { munger => 'cidr', nets => ['10.0.0.0'] } ) };
	like( $@, qr/'address\/prefix' form/, 'cidr rejects a bare address' );
	eval { $M->build( { munger => 'cidr', nets => ['10.0.0.0/33'] } ) };
	like( $@, qr/prefix length must be 0-32/, 'cidr rejects an oversized v4 prefix' );
	eval { $M->build( { munger => 'cidr', nets => ['wat/8'] } ) };
	like( $@, qr/unparseable address/, 'cidr rejects an unparseable net address' );
}

# ---- datetime -------------------------------------------------------------
SKIP: {
	eval { require Time::Piece; 1 }
		or skip 'Time::Piece not available', 3;

	my $ep = $M->build( { munger => 'datetime', format => '%Y-%m-%dT%H:%M:%S', part => 'epoch' } );
	# 2026-07-06T12:00:00 UTC via strptime (Time::Piece strptime is UTC)
	my $t = Time::Piece->strptime( '2026-07-06T12:00:00', '%Y-%m-%dT%H:%M:%S' );
	is( $ep->('2026-07-06T12:00:00'), $t->epoch, 'datetime epoch part' );

	my $hr = $M->build( { munger => 'datetime', format => '%Y-%m-%dT%H:%M:%S', part => 'hour' } );
	is( $hr->('2026-07-06T12:00:00'), 12, 'datetime hour part' );

	my $fd = $M->build( { munger => 'datetime', format => '%Y-%m-%dT%H:%M:%S', part => 'frac_day' } );
	is( $fd->('2026-07-06T12:00:00'), 0.5, 'datetime frac_day at noon' );

	my $fw = $M->build( { munger => 'datetime', format => '%Y-%m-%dT%H:%M:%S', part => 'frac_week' } );
	# 2026-07-05 is a Sunday (wday 0): midnight Sunday is the week origin.
	is( $fw->('2026-07-05T00:00:00'), 0, 'datetime frac_week at Sunday midnight' );
	# 2026-07-06 is Monday (wday 1) noon: (1*86400 + 43200)/604800.
	is( $fw->('2026-07-06T12:00:00'), ( 86400 + 43200 ) / 604800, 'datetime frac_week at Monday noon' );

	# cyclic parts: noon is frac_day 0.5 -> sin(pi)=0, cos(pi)=-1.
	my $sd = $M->build( { munger => 'datetime', format => '%Y-%m-%dT%H:%M:%S', part => 'sin_day' } );
	my $cd = $M->build( { munger => 'datetime', format => '%Y-%m-%dT%H:%M:%S', part => 'cos_day' } );
	ok( abs( $sd->('2026-07-06T12:00:00') - 0 ) < 1e-9, 'sin_day at noon ~ 0' );
	ok( abs( $cd->('2026-07-06T12:00:00') + 1 ) < 1e-9, 'cos_day at noon ~ -1' );
	# continuity across midnight: sin/cos barely move over a one-minute wrap.
	# a 60s wrap moves sin by ~2*pi*(60/86400) ~ 0.0044, vs the ~1.0 jump
	# frac_day would show at the same seam.
	my $near_mid_a = $sd->('2026-07-06T23:59:30');
	my $near_mid_b = $sd->('2026-07-07T00:00:30');
	ok( abs( $near_mid_a - $near_mid_b ) < 1e-2, 'sin_day is continuous across midnight' );

	my $cw = $M->build( { munger => 'datetime', format => '%Y-%m-%dT%H:%M:%S', part => 'cos_week' } );
	# Sunday midnight is frac_week 0 -> cos(0) = 1.
	ok( abs( $cw->('2026-07-05T00:00:00') - 1 ) < 1e-9, 'cos_week at week origin ~ 1' );
} ## end SKIP:

# ---- hash (XS or PP; both must agree with these fixed FNV-1a values) -------
{
	diag( 'hash munger path: HAVE_XS = ' . $Algorithm::ToNumberMunger::HAVE_XS );

	my $raw = $M->build( { munger => 'hash' } );
	# Known FNV-1a 32-bit vectors.
	is( $raw->(''),       2166136261, 'fnv1a empty string' );
	is( $raw->('a'),      3826002220, 'fnv1a "a"' );
	is( $raw->('foobar'), 3214735720, 'fnv1a "foobar"' );

	my $b = $M->build( { munger => 'hash', buckets => 100 } );
	ok( $b->('anything') >= 0 && $b->('anything') < 100, 'hash respects buckets' );

	# Same key + same bucket count is stable; seed decorrelates.
	my $s0 = $M->build( { munger => 'hash', buckets => 1_000_000, seed => 0 } );
	my $s7 = $M->build( { munger => 'hash', buckets => 1_000_000, seed => 7 } );
	isnt( $s0->('shared'), $s7->('shared'), 'seed changes the hash' );

	eval { $M->build( { munger => 'hash', buckets => 0 } ) };
	like( $@, qr/positive integer/, 'hash rejects zero buckets' );
}

# ---- chain ------------------------------------------------------------------
{
	my $tld = $M->build(
		{
			munger => 'chain',
			steps  => [ { op => 'lc' }, { op => 'split', on => '.', index => -1 } ],
			then   => { munger => 'length' },
		}
	);
	is( $tld->('WWW.Example.COM'), 3, 'chain: lc + split[-1] + length takes the last label' );
	is( $tld->('nodots'),          6, 'chain: split with no separator keeps the whole string' );
	is( $tld->(undef),             0, 'chain: undef enters as the empty string' );

	my $oob = $M->build(
		{
			munger => 'chain',
			steps  => [ { op => 'split', on => '.', index => 5 } ],
			then   => { munger => 'length' },
		}
	);
	is( $oob->('a.b'), 0, 'chain: out-of-range split index yields empty' );

	my $cap = $M->build(
		{
			munger => 'chain',
			steps  => [ { op => 'capture', pattern => 'req-(0x[0-9a-f]+)', ignore_case => 1 } ],
			then   => { munger => 'num', base => 16 },
		}
	);
	is( $cap->('REQ-0x2F done'), 47, 'chain: capture feeds num base 16' );

	my $nogroup = $M->build(
		{
			munger => 'chain',
			steps  => [ { op => 'capture', pattern => 'xyz' } ],
			then   => { munger => 'length' },