view release on metacpan or  search on metacpan

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

	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"