File Coverage

blib/lib/EntityModel/Query/Condition.pm

Criterion	Covered	Total	%
statement	59	69	85.5
branch	20	30	66.6
condition	1	3	33.3
subroutine	7	8	87.5
pod	6	6	100.0
total	93	116	80.1

package EntityModel::Query::Condition;
{
  $EntityModel::Query::Condition::VERSION = '0.102';
}
use EntityModel::Class {
	_isa => [qw{EntityModel::Query::Base}],
	'expr' => { type => 'string' },
	'branch' => 'object'
};
no if $] >= 5.017011, warnings => "experimental::smartmatch";

=head1 NAME

EntityModel::Query::Condition - a condition clause for where, on etc.

=head1 VERSION

version 0.102

=head1 SYNOPSIS

=head1 DESCRIPTION

=cut

sub new {
	my $class = shift;
	my $self = bless { }, $class;
	$self->branch($self->parseCondition(ref $_[0] ? (@_) : ({ @_ })));
	return $self;
}

=head2 inlineSQL

Returns the "inline SQL" representation for this condition. See L description for more details on what this means.

=cut

sub inlineSQL {
	my $self = shift;
	return [ $self->parseBranch($self->branch) ];
}

=head2 parseCondition

An array reference expands out as follows:

 [ x => 3 ]

=cut

sub parseCondition {
	my $self = shift;
	my $data = shift;

# Accept hashrefs, but turn them into arrayref by default.
	$data = [ %$data ] if ref $data ~~ 'HASH';

	my @list = @$data;

	my @node;
	my @tree;
	ITEM:
	while(@list) {
		my $k = shift(@list);
		my $item;
		if(ref $k) {
			$item = $self->parseCondition($k);
		} else {
			my ($start, $directive) = $k =~ /^(.)(.*)$/;
# If we have a directive such as and, or, etc. then we're switching mode
			if($start eq '-') {
				if($directive eq 'subquery') {
					$item = $self->parseQuery(shift(@list));
				} else {
					push @node, $directive;
					next ITEM;
				}
			} else {
				$k = $self->quoteIdentifier($k) unless ref $k;
				my $v = shift(@list);
				if(!ref($v)) {
					$item = [ $k, $v ];
				} elsif(ref($v) ~~ [qw{HASH SCALAR}]) {
					$item = [ $k, $v ];
				} else {
					$v = $self->parseCondition($v);
					$item = [ $k, $v ];
				}
			}
		}
		if(@node) {
			my $prev = pop(@tree);
			die 'no previous item?' unless $prev;

			my $entry = {
				op => join(' ', @node),
				left => $prev,
				right => $item
			};
			$item = $entry;
			@node = ();
		}
		push @tree, $item;
	}
	return $tree[0] if @tree == 1 && ref $tree[0];
	return \@tree;
}

=head2 parseBranch

For a hashref, the following three items should be in the hash:

=over 4

=item * left - left node of the branch, this will be recursed into as appropriate

=item * right - right node of the branch, will be recursed as required

=item * op - the operation to perform, such as =, and, or, etc.

=back

An arrayref will use the '=' operation for all entries unless the second element is
a hashref, in which case the key will be used as the operation and the value as the
RHS.

=cut

sub parseBranch {
	my $self = shift;
	my $item = shift;
	my @query;
	if(ref $item ~~ 'HASH') {
		push @query, '(';
		push @query, $self->parseBranch($item->{left});
		push @query, ' ' . $item->{op} . ' ';
		push @query, $self->parseBranch($item->{right});
		push @query, ')';
	} elsif(ref $item ~~ 'ARRAY') {
		my ($k, $v) = @$item;
		push @query, $k;
		my $op = '=';
		if(ref $v eq 'HASH') {
			($op, $v) = %$v;
		}
		push @query, " $op ";
		push @query, \$v;
	} elsif(ref $item) {
		push @query, $item;
	} else {
		push @query, $item;
	}
	return @query;
}

=head2 parseQuery

=cut

sub parseQuery {
	my $self = shift;
	' Query ';
}

=head2 quoteIdentifier

Convert an identifier to the quoted version.

=cut

sub quoteIdentifier {
	my $self = shift;
	my $k = shift;
	return $k;
	return '"'. $k . '"';
}

1;

__END__