Algorithm-ToNumberMunger
view release on metacpan or search on metacpan
lib/Algorithm/ToNumberMunger.pm view on Meta::CPAN
};
=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
# scalar build can never hand them more than one value. Registering a stub
# keeps known_mungers() honest and turns "used it as a scalar munger" into a
# pointed error instead of an unknown-munger one.
for my $name (qw(ratio combine)) {
lib/Algorithm/ToNumberMunger.pm view on Meta::CPAN
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';
lib/Algorithm/ToNumberMunger.pm view on Meta::CPAN
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;
return sub {
my ($v) = @_;
return $m{$v} if defined $v && exists $m{$v};
return $default if $has_default;
croak "enum munger$where: no mapping for '" . ( defined $v ? $v : 'undef' ) . "'";
};
} ## end sub _build_enum
=head2 frozen_freq_map
{ munger => 'frozen_freq_map', counts => { jpg => 40213, exe => 12, scr => 3 },
total => 67560 }
# defaults: mode => 'neg_log_prob', smoothing => 1, unseen => 'rare'
Frequency-encoding from a B<precomputed, frozen> count table: the rarer a value
was when the table was built, the more anomalous it scores. This is C<enum>'s
cousin -- a value-to-number map -- except the numbers are derived from observed
C<counts> rather than hand-authored, with the smoothing and unseen-value policy
that "rare = interesting" needs. It stays a stateless munger: the table is
computed offline and shipped in C<info.json>; this class only I<applies> it.
C<counts> maps each value to how many times it was seen. C<total> is the overall
observation count; it defaults to the sum of C<counts>, but may be given
explicitly and larger so you can B<prune the long tail> out of C<counts> while
still computing correct probabilities. The emitted number depends on C<mode>:
=over 4
lib/Algorithm/ToNumberMunger.pm view on Meta::CPAN
&& $spec->{base} > 0
&& $spec->{base} != 1;
$ln_base = log( $spec->{base} );
}
return sub {
my ($v) = @_;
croak "log munger$where: '" . ( defined $v ? $v : 'undef' ) . "' is not numeric"
unless looks_like_number($v);
my $x = $v + $offset;
croak "log munger$where: value+offset must be > 0 (got $x)"
unless $x > 0;
my $r = log($x);
$r /= $ln_base if defined $ln_base;
return $r;
}; ## end sub
} ## end sub _build_log
=head2 clamp
{ munger => 'clamp', min => 0 }
{ munger => 'clamp', min => 0, max => 65535 }
Pass the number through, pinned into C<[min, max]>. Either bound may be omitted
to clamp on one side only. Unlike C<scale> this does not rescale; it only caps
outliers before they reach the model.
=cut
sub _build_clamp {
my ( $spec, $where ) = @_;
my ( $min, $max ) = @{$spec}{qw(min max)};
my $have_min = defined $min;
my $have_max = defined $max;
croak "clamp munger$where needs at least one of 'min' or 'max'"
unless $have_min || $have_max;
croak "clamp munger$where: 'min' must be numeric"
if $have_min && !looks_like_number($min);
croak "clamp munger$where: 'max' must be numeric"
if $have_max && !looks_like_number($max);
croak "clamp munger$where: 'min' must be <= 'max'"
if $have_min && $have_max && $min > $max;
return sub {
my ($v) = @_;
croak "clamp munger$where: '" . ( defined $v ? $v : 'undef' ) . "' is not numeric"
unless looks_like_number($v);
$v = $min if $have_min && $v < $min;
$v = $max if $have_max && $v > $max;
return $v;
};
} ## end sub _build_clamp
=head2 num
{ munger => 'num', base => 16 } # '0x1a' or '1a' -> 26
{ munger => 'num' } # plain numeric coercion
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
lib/Algorithm/ToNumberMunger.pm view on Meta::CPAN
} ## end sub _build_hash
# Pure-Perl 32-bit FNV-1a, used only when the XS did not build. On a 64-bit
# perl the intermediate h*16777619 (< 2**57) stays an exact integer, so the
# masked result matches the C version bit for bit. The string is always
# utf8-encoded first so a value hashes as its UTF-8 bytes no matter the internal
# flag -- the same well-defined bytes SvPVutf8 hands the XS.
sub _fnv1a_pp {
my ( $str, $seed ) = @_;
utf8::encode($str);
my $h = ( 2166136261 ^ ( $seed & 0xFFFFFFFF ) ) & 0xFFFFFFFF;
for my $c ( unpack 'C*', $str ) {
$h ^= $c;
$h = ( $h * 16777619 ) & 0xFFFFFFFF;
}
return $h;
} ## end sub _fnv1a_pp
=head2 chain
# Shannon entropy of just the TLD: lowercase, keep the last dot-label
{ munger => 'chain',
steps => [ { op => 'lc' }, { op => 'split', on => '.', index => -1 } ],
then => { munger => 'entropy' } }
# a hex request id buried in a token like 'req-0x2F'
{ munger => 'chain',
steps => [ { op => 'capture', pattern => 'req-(0x[0-9a-fA-F]+)' } ],
then => { munger => 'num', base => 16 } }
Run the input through a list of string pre-transforms (C<steps>, applied in
order), then hand the result to a terminal munger (C<then>) for the actual
number. Every string munger above scores the I<whole> value; C<chain> is how a
feature targets a I<piece> of it -- the entropy of the TLD alone, the length
of the first path segment, an enum over a normalized token -- without asking
the writer's caller to pre-slice its input. Each step is a hashref with an
C<op>:
=over 4
=item * C<lc> / C<uc> - case-fold the value.
=item * C<trim> - strip leading and trailing whitespace.
=item * C<split> - split on the literal separator C<on> and keep piece
C<index> (0-based; negative counts from the end, so C<-1> is a hostname's last
label). An index past either end yields the empty string.
=item * C<capture> - match the regex C<pattern> and keep capture group
C<group> (default C<1>). No match, or a group that did not participate, yields
the empty string. A true C<ignore_case> matches case-insensitively; the
L</match> trust note applies here too.
=item * C<replace> - replace every match of the regex C<pattern> with the
literal string C<with> (default: delete the matches). C<ignore_case> as above.
=back
C<then> is a full munger spec and may be any built-in that takes one value --
including another C<chain>. All step parameters and the terminal spec are
validated at build time. An undef input enters the chain as the empty string;
whether an empty result is acceptable is the terminal's call (C<entropy> and
C<length> score it C<0>, C<num> croaks).
The multi-output form works too: put C<into> on the B<chain> and the C<parts>
on the terminal, e.g. C<trim> a sloppy timestamp before a L</datetime>
C<sin>/C<cos> expansion.
=cut
# op => step builder; each validates its slice of the step spec at build time
# and returns a string-to-string closure. Steps only ever see a defined string
# (the chain entry point turns undef into '').
my %CHAIN_OPS = (
lc => sub {
return sub { return lc $_[0] }
},
uc => sub {
return sub { return uc $_[0] }
},
trim => sub {
return sub { my ($s) = @_; $s =~ s/\A\s+//; $s =~ s/\s+\z//; return $s };
},
split => sub {
my ( $step, $where ) = @_;
my $on = $step->{on};
croak "chain munger$where: split step requires a non-empty 'on' string"
unless defined $on && length $on;
my $idx = defined $step->{index} ? $step->{index} : 0;
croak "chain munger$where: split 'index' must be an integer"
unless $idx =~ /\A-?[0-9]+\z/;
# limit -1 keeps trailing empty pieces, so 'a.' really has two labels
# and index -1 is the empty last one, not 'a'.
return sub {
my @p = split /\Q$on\E/, $_[0], -1;
return ( $idx > $#p || $idx < -@p ) ? '' : $p[$idx];
};
},
capture => sub {
my ( $step, $where ) = @_;
my $pat = $step->{pattern};
croak "chain munger$where: capture step requires a non-empty 'pattern'"
unless defined $pat && length $pat;
my $re = eval { $step->{ignore_case} ? qr/$pat/i : qr/$pat/ };
croak "chain munger$where: cannot compile pattern '$pat': $@"
unless defined $re;
my $group = defined $step->{group} ? $step->{group} : 1;
croak "chain munger$where: capture 'group' must be a positive integer"
unless $group =~ /\A[1-9][0-9]*\z/;
# @-/@+ rather than a list-context match: a pattern with no capture
# groups returns (1) in list context, which would masquerade as a
# captured '1'; $#+ says how many groups the pattern really has.
return sub {
my ($s) = @_;
return '' unless $s =~ $re;
return '' unless $group <= $#+ && defined $-[$group];
return substr( $s, $-[$group], $+[$group] - $-[$group] );
};
},
replace => sub {
my ( $step, $where ) = @_;
my $pat = $step->{pattern};
croak "chain munger$where: replace step requires a non-empty 'pattern'"
unless defined $pat && length $pat;
my $re = eval { $step->{ignore_case} ? qr/$pat/i : qr/$pat/ };
croak "chain munger$where: cannot compile pattern '$pat': $@"
unless defined $re;
my $with = defined $step->{with} ? $step->{with} : '';
return sub { my ($s) = @_; $s =~ s/$re/$with/g; return $s };
},
);
lib/Algorithm/ToNumberMunger.pm view on Meta::CPAN
} ## end sub _build_eps
# Multi-output eps: one key, several reads (rate/count/total), one round trip.
# Returns ($list_returning_code, $arity) for compile()'s 'into' check.
sub _build_eps_multi {
my ( $spec, $where ) = @_;
my $parts = $spec->{parts};
croak "eps munger$where: 'parts' must be a non-empty arrayref"
unless ref $parts eq 'ARRAY' && @$parts;
for my $p (@$parts) {
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'
( run in 1.401 second using v1.01-cache-2.11-cpan-0b5f733616e )