view release on metacpan or  search on metacpan

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

			. "via compile() with 'from' as an arrayref of source fields";
	};
}

sub build {
	my ( $class, $spec, $tag ) = @_;
	my $where = defined $tag ? " for tag '$tag'" : '';

	croak "munger spec$where must be a hashref"
		unless ref $spec eq 'HASH';

	my $name = $spec->{munger};
	croak "munger spec$where has no 'munger' name"
		unless defined $name && length $name;

	my $builder = $BUILDERS{$name}
		or croak "unknown munger '$name'$where (known: " . join( ', ', $class->known_mungers ) . ')';

	return $builder->( $spec, $where );
} ## end sub build

=head2 build_all

    my $by_tag = ...->build_all( $info->{mungers} );

Compile a whole C<mungers> hash (tag name => spec) into a hash of tag name =>
coderef. A false/absent argument yields an empty hashref (every tag is raw).
Croaks if any spec is invalid, naming the offending tag.

=cut

sub build_all {
	my ( $class, $mungers ) = @_;
	return {} unless $mungers;

	croak "'mungers' must be a hashref"
		unless ref $mungers eq 'HASH';

	my %by_tag;
	for my $tag ( keys %$mungers ) {
		$by_tag{$tag} = $class->build( $mungers->{$tag}, $tag );
	}
	return \%by_tag;
} ## end sub build_all

=head2 compile

    my $plan = ...->compile( tags => \@tags, mungers => $info->{mungers} );
    my $row  = $plan->apply_named( \%named_input );   # numbers, in tags order

Compile a set's C<tags> and (optional) C<mungers> into a B<plan> object that maps
one input record to a fully-numeric row in tag order. Unlike L</build_all> (which
just compiles each spec in isolation), C<compile> understands the whole set:

=over 4

=item * a scalar munger, keyed by its output tag, fills that one column; its
input is read from the tag's own name, or from C<< from => 'other' >> to alias a
source field;

=item * an B<expanding> munger, keyed by any label and carrying C<< into =>
[tag, ...] >>, reads one source (C<from>, defaulting to the label) and fills
several columns at once -- this is how a single timestamp becomes both a
C<sin>/C<cos> pair without the two ever drifting apart (see L</datetime>);

=item * a B<combining> munger, keyed by its output tag and carrying a C<from>
B<list> (C<< from => ['bytes_out', 'bytes_in'] >>), reads several source
fields and fills that one column -- this is how a ratio becomes a single
feature without precomputing it upstream (see L</ratio> and L</combine>). The
sources are raw input fields, not other (possibly munged) columns;

=item * every remaining tag is B<raw> and passed through unchanged.

=back

Coverage is validated up front: C<compile> croaks if two mungers write the same
column, if an C<into> names a column not in C<tags>, if a munger key is neither a
tag nor an expander, if an expander's output count does not match its C<into>,
or if a C<from> list is given to a munger that cannot combine inputs. The
returned plan has two methods, both returning an arrayref of numbers in C<tags>
order: C<apply_named(\%hash)> (keyed by field name, the only form that supports
expanders and combiners) and C<apply_positional(\@row)> (positional; croaks if
the set has any expanding or combining munger, since a shared or combined
source cannot be expressed by position).

=cut

# name => builder returning ($list_returning_code, $arity), for the mungers that
# can fan one input out into several columns via 'into'.
my %MULTI_BUILDERS = (
	datetime => \&_build_datetime_multi,
	eps      => \&_build_eps_multi,
	chain    => \&_build_chain_multi,
);

sub _build_multi {
	my ( $class, $spec, $where ) = @_;
	my $name = $spec->{munger};
	croak "munger spec$where has no 'munger' name"
		unless defined $name && length $name;
	my $builder = $MULTI_BUILDERS{$name}
		or croak "munger '$name'$where does not support multiple outputs "
		. "('into'); only these do: "
		. join( ', ', sort keys %MULTI_BUILDERS );
	return $builder->( $spec, $where );
} ## end sub _build_multi

# name => builder returning the N-input closure, for the mungers that combine
# several source fields ('from' as an arrayref) into one column. The builder is
# handed the source count so arity errors surface at compile time.
my %COMBINE_BUILDERS = (
	ratio   => \&_build_ratio,
	combine => \&_build_combine_op,
);

sub _build_combine {
	my ( $class, $spec, $where, $nsrc ) = @_;
	my $name = $spec->{munger};
	croak "munger spec$where has no 'munger' name"
		unless defined $name && length $name;
	my $builder = $COMBINE_BUILDERS{$name}
		or croak "munger '$name'$where does not support multiple inputs "
		. "(a 'from' list); only these do: "
		. join( ', ', sort keys %COMBINE_BUILDERS );
	return $builder->( $spec, $where, $nsrc );
} ## end sub _build_combine

sub compile {
	my ( $class, %args ) = @_;

	my $tags = $args{tags};
	croak "compile requires a non-empty 'tags' arrayref"
		unless ref $tags eq 'ARRAY' && @$tags;
	my $mungers = $args{mungers} || {};
	croak "compile: 'mungers' must be a hashref"
		unless ref $mungers eq 'HASH';

	my %pos;
	for my $i ( 0 .. $#$tags ) {
		croak "compile: duplicate tag '$tags->[$i]'"
			if exists $pos{ $tags->[$i] };
		$pos{ $tags->[$i] } = $i;
	}

	my ( @scalar, @expand, @combine, %claimed );
	my $claim = sub {
		my ( $tag, $by ) = @_;
		croak "munger '$by' targets unknown column '$tag'"
			unless exists $pos{$tag};
		croak "two mungers write column '$tag'"
			if $claimed{$tag}++;
	};

	for my $key ( sort keys %$mungers ) {
		my $spec = $mungers->{$key};
		croak "munger '$key' spec must be a hashref"
			unless ref $spec eq 'HASH';
		my $from = defined $spec->{from} ? $spec->{from} : $key;

		if ( ref $from eq 'ARRAY' ) {
			croak "munger '$key': a 'from' list needs at least 2 source fields"
				unless @$from >= 2;
			croak "munger '$key': 'into' cannot be combined with a 'from' list"
				if defined $spec->{into};
			croak "munger '$key' is not a declared tag and has no 'into'"
				unless exists $pos{$key};
			my $code = $class->_build_combine( $spec, " for '$key'", scalar @$from );
			$claim->( $key, $key );
			push @combine, { tag => $key, from => [@$from], code => $code };
		} elsif ( defined $spec->{into} ) {
			my $into = $spec->{into};
			croak "munger '$key': 'into' must be a non-empty arrayref"
				unless ref $into eq 'ARRAY' && @$into;
			my ( $code, $arity ) = $class->_build_multi( $spec, " for '$key'" );
			croak "munger '$key' produces $arity value(s) but 'into' lists " . scalar(@$into)
				unless $arity == @$into;
			$claim->( $_, $key ) for @$into;
			push @expand, { from => $from, into => [@$into], code => $code };
		} else {
			croak "munger '$key' is not a declared tag and has no 'into'"
				unless exists $pos{$key};
			$claim->( $key, $key );
			push @scalar, { tag => $key, from => $from, code => $class->build( $spec, $key ) };
		}
	} ## end for my $key ( sort keys %$mungers )

	for my $tag (@$tags) {
		push @scalar, { tag => $tag, from => $tag, code => undef }
			unless $claimed{$tag};
	}

	return bless {
		tags    => [@$tags],
		pos     => \%pos,
		scalar  => \@scalar,
		expand  => \@expand,
		combine => \@combine,
		},
		"${class}::Plan";
} ## end sub compile

=head2 known_mungers

    my @names = ...->known_mungers;

The sorted list of built-in munger names this version understands.

=head2 has_munger

    if ( ...->has_munger('enum') ) { ... }

True if the named munger is built in.

=cut

sub known_mungers { my @names = sort keys %BUILDERS; return @names }
sub has_munger    { return exists $BUILDERS{ $_[1] } }

=head1 BUILT-IN MUNGERS

Every munger returns a plain number and, where the input cannot be interpreted,
croaks -- the Writer would reject a non-numeric field anyway, so failing at the
munger gives a better message. Parameters are validated when the munger is
built, not per row.

=head2 enum

    { munger => 'enum', map => { GET => 0, POST => 1 }, default => -1 }

Categorical string to number via an explicit C<map>. All map values must be
numeric. Without a C<default>, an unmapped input croaks; with one, unmapped
inputs (including C<undef>) yield the default.

=cut

sub _build_enum {
	my ( $spec, $where ) = @_;

	my $map = $spec->{map};
	croak "enum munger$where requires a 'map' hashref"
		unless ref $map eq 'HASH';

	for my $k ( keys %$map ) {
		croak "enum munger$where: map value for '$k' ('"
			. ( defined $map->{$k} ? $map->{$k} : 'undef' )
			. "') is not numeric"
			unless looks_like_number( $map->{$k} );
	}

	my $has_default = exists $spec->{default};
	my $default     = $spec->{default};
	croak "enum munger$where: 'default' must be numeric"
		if $has_default && !looks_like_number($default);

	# Copy so a later edit of the caller's spec cannot mutate a live munger.
	my %m = %$map;

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

		croak "eps munger$where: unknown part '"
			. ( defined $p ? $p : 'undef' )
			. "' (known: "
			. join( ', ', sort keys %EPS_READ ) . ')'
			unless defined $p && $EPS_READ{$p};
	}

	my ( $socket, $prefix, $mark, $timeout, $on_error ) = _eps_spec( $spec, $where );

	# Command plan, fixed at build time. When marking, the mark is a MARKRATE
	# whose own reply serves the first 'rate' part for free; the remaining
	# parts become one read command each. @take maps each part to the reply
	# index that answers it, so the output stays in 'parts' order.
	my ( @cmds, @take );
	my $rate_served = 0;
	push @cmds, 'MARKRATE' if $mark;
	for my $i ( 0 .. $#$parts ) {
		if ( $mark && !$rate_served && $parts->[$i] eq 'rate' ) {
			$take[$i] = 0;       # MARKRATE's reply is the rate
			$rate_served = 1;
			next;
		}
		push @cmds, uc $parts->[$i];
		$take[$i] = $#cmds;
	}
	my $n        = @$parts;
	my $nreplies = @cmds;

	my $code = sub {
		my ($v) = @_;
		my $key = $prefix . ( defined $v ? "$v" : '' );
		$key =~ s/[\s[:cntrl:]]/_/g;
		my @replies = eval {
			die "empty key\n" unless length $key;
			_eps_txn( $socket, $timeout, join( '', map { "$_ $key\n" } @cmds ), $nreplies );
		};
		if ($@) {
			my $err = $@;
			delete $EPS_CONN{$socket};
			croak "eps munger$where: $err" if $on_error eq 'die';
			return ( $on_error + 0 ) x $n;
		}
		return @replies[@take];
	}; ## end $code = sub
	return ( $code, $n );
} ## end sub _build_eps_multi

# A compiled munging plan for one set, produced by Mungers->compile. It turns an
# input record into a fully-numeric row in tags order; the Writer then only has
# to validate and append. Kept in its own package so the assembly logic is
# testable without a Writer or the filesystem.
package Algorithm::ToNumberMunger::Plan;

use strict;
use warnings;
use Carp qw(croak);

sub tags { return $_[0]->{tags} }

# Assemble a row from a name-keyed record. Scalar/raw columns read their own tag
# (or the munger's 'from'); expanding mungers read one source and fill several
# columns; combining mungers read several sources and fill one. This is the only
# form that supports expanders and combiners.
sub apply_named {
	my ( $self, $hash ) = @_;
	croak 'apply_named requires a hashref' unless ref $hash eq 'HASH';

	my @row;
	for my $s ( @{ $self->{scalar} } ) {
		croak "missing value for '$s->{from}'"
			unless exists $hash->{ $s->{from} };
		my $v = $hash->{ $s->{from} };
		$row[ $self->{pos}{ $s->{tag} } ] = $s->{code} ? $s->{code}->($v) : $v;
	}

	for my $e ( @{ $self->{expand} } ) {
		croak "missing value for '$e->{from}'"
			unless exists $hash->{ $e->{from} };
		my @vals = $e->{code}->( $hash->{ $e->{from} } );
		croak "expanding munger for [@{ $e->{into} }] returned "
			. scalar(@vals)
			. ' value(s), expected '
			. scalar( @{ $e->{into} } )
			unless @vals == @{ $e->{into} };
		for my $i ( 0 .. $#{ $e->{into} } ) {
			$row[ $self->{pos}{ $e->{into}[$i] } ] = $vals[$i];
		}
	} ## end for my $e ( @{ $self->{expand} } )

	for my $c ( @{ $self->{combine} } ) {
		my @vals;
		for my $f ( @{ $c->{from} } ) {
			croak "missing value for '$f'"
				unless exists $hash->{$f};
			push @vals, $hash->{$f};
		}
		$row[ $self->{pos}{ $c->{tag} } ] = $c->{code}->(@vals);
	}

	return \@row;
} ## end sub apply_named

# Assemble a row from an already-ordered positional row, applying scalar mungers
# in place. Expanding and combining mungers cannot be expressed positionally
# (there is no named source), so a set that has any is a hard error here -- use
# apply_named.
sub apply_positional {
	my ( $self, $row ) = @_;
	croak 'apply_positional requires an arrayref row' unless ref $row eq 'ARRAY';
	croak 'positional write is unsupported for a set with expanding mungers; ' . 'use write_named'
		if @{ $self->{expand} };
	croak 'positional write is unsupported for a set with multi-input mungers; ' . 'use write_named'
		if @{ $self->{combine} };
	croak 'row has ' . scalar(@$row) . ' fields but info.json declares ' . scalar( @{ $self->{tags} } )
		unless @$row == @{ $self->{tags} };

	my @out = @$row;
	for my $s ( @{ $self->{scalar} } ) {
		next unless $s->{code};
		my $i = $self->{pos}{ $s->{tag} };
		$out[$i] = $s->{code}->( $out[$i] );
	}
	return \@out;
} ## end sub apply_positional

=head1 AUTHOR

Zane C. Bowers-Hadley, C<< <vvelox at vvelox.net> >>

=head1 LICENSE AND COPYRIGHT

This software is Copyright (c) 2026 by Zane C. Bowers-Hadley.

This is free software, licensed under:

  The GNU Lesser General Public License, Version 2.1, February 1999

=cut

1;    # End of Algorithm::ToNumberMunger