File Coverage

blib/lib/Struct/Conditional.pm

Criterion	Covered	Total	%
statement	136	139	97.8
branch	74	100	74.0
condition	42	68	61.7
subroutine	11	11	100.0
pod	5	7	71.4
total	268	325	82.4

package Struct::Conditional;
use 5.006; use strict; use warnings; our $VERSION = '1.00';
use Clone qw/clone/;

sub new {
	bless ($_[1] || {}), $_[0];
}

sub compile {
	my ($self, $struct, $params, $return_struct) = @_;
	$struct = $self->itterate(clone($struct), $params);
	die "failed to compile conditional json"
		if (defined $struct && ! ref $struct && $struct eq 'compiled_null');
	return $struct;
}

sub itterate {
	my ($self, $json, $params) = @_;
	my $ref = ref $json;
	if ($ref eq 'HASH') {
		$json = $self->loops(
			$self->conditionals($json, $params),
			$params
		);
		for my $key ( keys %{$json} ) {
			my $value = $self->itterate($json->{$key}, $params);
			$value && $value eq 'compiled_null'
				? delete $json->{$key}
				: do {
					$json->{$key} = $value;
				};
		}
		return keys %{$json} ? $json : 'compiled_null';
	} elsif ($ref eq 'ARRAY') {
		my $i = 0;
		for my $item (@{ $json }) {
			my $value = $self->itterate($item, $params);
			$value && $value eq 'compiled_null'
				? do {
					splice @{$json}, $i, 1;
				}
				: $i++;
		}
	}
	return $self->make_replacement($json, $params);
}

sub loops {
	my ($self, $json, $params) = @_;
	my %loops = map {
		($_ => delete $json->{$_})
	} qw/for/;
	if ($loops{for}) {
		my $key = delete $loops{for}{key};
		die "no key defined for loop" unless defined $key;
		if ($loops{for}{each}) {
			my @each = ();
			my $map = delete $loops{for}{each};
			die "param $key must be an arrayref"
				unless (ref($params->{$key}) || "") eq 'ARRAY';
			for (@{$params->{$key}}) {
				my $jsn = $self->conditionals(clone($loops{for}), $_);
				push @each, $self->make_replacement($jsn, $_) if scalar keys %{$jsn};
			}
			$json->{$map} = \@each if scalar @each;
		}
		if ($loops{for}{keys}) {
			my %keys = ();
			my $map = delete $loops{for}{keys};
			die "param $key muse be an hashref"
				unless (ref($params->{$key}) || "") eq 'HASH';
			for my $k (keys %{$params->{$key}}) {
				my $jsn = $self->conditionals(
					clone($loops{for}),
					$params->{$key}->{$k}
				);
				$keys{$k} = $self->make_replacement($jsn, $params->{$key}->{$k}) if scalar keys %{$jsn};
			}
			if (scalar %keys) {
				$map =~ m/^1$/ ? do {
					for my $k (keys %keys) {
						$json->{$k} = $keys{$k};
					}
				} : do {
					$json->{$map} = \%keys;
				}
			}
		}
	}
	return $json;
}

sub conditionals {
	my ($self, $json, $params) = @_;
	my %keywords = map {
		($_ => delete $json->{$_})
	} qw/if elsif else given/;
	my $expression;
	if ($keywords{if}) {
		($expression) = $self->expressions($keywords{if}, $params);
		unless ($expression) {
			if ($keywords{elsif}) {
				($expression) = $self->expressions($keywords{elsif}, $params);
			}
			unless ($expression) {
				if ($keywords{else}) {
					($expression) = $keywords{else}->{then};
				}
			}
		}
		if ($expression) {
			$json->{$_} = $expression->{$_} for ( keys %{$expression} );
		}
	}
	if ($keywords{given}) {
		die "no key provided for given" if ! $keywords{given}{key};
		die "no when provided for given" if ! ref $keywords{given}{when};
		my $default = delete $keywords{given}{default};
		my $ref = ref $keywords{given}{when};
		if ($ref eq 'ARRAY') {
			for (@{ $keywords{given}{when} }) {
				$_->{key} ||= $keywords{given}{key};
				($expression) = $self->expressions($_, $params);
				last if $expression;
			}
		} elsif ($ref eq 'HASH') {
			$default ||= delete $keywords{given}{when}{default};
			for my $k (keys %{ $keywords{given}{when} }) {
				($expression) = $self->expressions(
					{
						key => $keywords{given}{key},
						m => $k,
						then => $keywords{given}{when}{$k}
					},
					$params
				);
				last if $expression;
			}
		} else {
			die "given cannot handle ref $ref";
		}
		$expression = $default if ! $expression;
		if ($expression) {
			$json->{$_} = $expression->{$_} for ( keys %{$expression} );
		}
	}
	return $json;
}

sub expressions {
	my ($self, $keyword, $params) = @_;
	my $success = 0;
	$success = exists $params->{$keyword->{key}}
		if defined $keyword->{exists};
	my $key = $params->{$keyword->{key}};
	if (defined $key) {
		$success = $key =~ m/\Q$keyword->{m}\E/
			if !$success && defined $keyword->{m};
		$success = $key =~ m/\Q$keyword->{m}\E/i
			if !$success && defined $keyword->{im};
		$success = $key !~ m/\Q$keyword->{nm}\E/
			if !$success && defined $keyword->{nm};
		$success = $key !~ m/\Q$keyword->{nm}\E/i
			if !$success && defined $keyword->{inm};
		$success = $key eq $keyword->{eq}
			if !$success && defined $keyword->{eq};
		$success = $key ne $keyword->{ne}
			if !$success && defined $keyword->{ne};
		$success = $key > $keyword->{gt}
			if !$success && defined $keyword->{gt};
		$success = $key < $keyword->{lt}
			if !$success && defined $keyword->{lt}
	}
	if ($keyword->{or} && !$success) {
		$keyword->{or}->{then} = $keyword->{then};
		($success, $keyword) = $self->expressions($keyword->{or}, $params)
	}
	if ($keyword->{and} && $success) {
		$keyword->{and}->{then} = $keyword->{then};
		($success, $keyword) = $self->expressions($keyword->{and}, $params)
	}
	if ($keyword->{elsif} && !$success) {
		$keyword = $keyword->{elsif};
		($success, $keyword) = $self->expressions($keyword, $params);
	}
	($success, $keyword) = ($keyword->{else}->{then}, $keyword->{else})
		if ($keyword->{else} && !$success);
	return (($success ? $keyword->{then} : 0), $keyword);
}

sub make_replacement {
	my ($self, $then, $params, $params_reg) = @_;
	$params_reg ||= join "|", keys %{$params};
	my $ref = ref $then || "";
	if ($ref eq 'HASH') {
		$then->{$_} = $self->make_replacement($then->{$_}, $params, $params_reg)
			for keys %{$then};
	} elsif ($ref eq 'ARRAY') {
		$then = [map { $self->make_replacement($_, $params, $params_reg) } @{ $then }];
	} elsif (defined $then && $then =~ m/\{($params_reg)\}/) {
		$then = $params->{$1};
	}
	return $then;
}

1;

__END__