File Coverage

blib/lib/LittleORM/Clause.pm

Criterion	Covered	Total	%
statement	12	57	21.0
branch	0	12	0.0
condition	0	9	0.0
subroutine	4	8	50.0
pod	0	3	0.0
total	16	89	17.9

use strict;

package LittleORM::Model;

# Extend LittleORM::Model capabilities with clause support:

sub clause
{
	my $self = shift;

	my @args = @_;

	my $class = ( ref( $self ) or $self );

	my @clause_creation_args = ( model => $class,
				     LittleORM::Clause -> __smart_clause_creation_args( @args ) );

	return LittleORM::Clause -> new( @clause_creation_args );
}

package LittleORM::Clause;

use Moose;

has 'logic' => ( is => 'rw', isa => 'Str', default => 'AND' );
has 'model' => ( is => 'rw', isa => 'Str', required => 1 );
has 'table_alias' => ( is => 'rw', isa => 'Maybe[Str]' );
has 'cond' => ( is => 'rw', isa => 'ArrayRef', default => sub { [] } );

use Carp::Assert 'assert';
use Data::Dumper 'Dumper';

sub __smart_clause_creation_args
{
	my $self = shift;
	my @args = @_;

	my %my_attrs = map { $_ -> name() => 1 } $self -> meta() -> get_all_attributes();
	my @goes_into_cond = ();
	my @goes_as_is = ();
	my $seen_cond = 0;

	while( my $arg = shift @args )
	{
		my $value = shift @args;

		if( exists $my_attrs{ $arg } )
		{
			if( $arg eq 'cond' )
			{
				$seen_cond = 1;
			}

			push @goes_as_is, ( $arg => $value );
		} else
		{
			push @goes_into_cond, ( $arg => $value );
		}
	}

	if( @goes_into_cond )
	{
		assert( ( $seen_cond == 0 ),
			'ambiguous clause creation arguments: ' . Dumper( \@args ) );
		push @goes_as_is, ( cond => \@goes_into_cond );
	}

	return @goes_as_is;
}

sub sql
{
	my $self = shift;

	my @rv = $self -> gen_clauses( &LittleORM::Model::__for_read(), # default, can be overwritten with following in @_
				       @_ );

	return sprintf( ' ( %s ) ', join( ' '. $self -> logic() . ' ', @rv ) );
}

sub gen_clauses
{
	my $self = shift;
	my @args = @_;

	my @rv = ();

	my @c = @{ $self -> cond() };

	while( @c )
	{
		my $item = shift @c;

		if( ref( $item ) eq 'LittleORM::Clause' )
		{
			if( ( $item -> model() eq $self -> model() ) and ( my $ta = $self -> table_alias() ) and ( not $item -> table_alias() ) )
			{
				# copy obj ?
				my $copy = bless( { %{ $item } }, ref $item );
				$item = $copy;
				$item -> table_alias( $ta );
			}

			push @rv, $item -> sql();
		} else
		{
			my $value = shift @c;

			push @rv, $self -> model() -> __form_where( @args,
								    $item => $value,
								    _table_alias => $self -> table_alias() );

		}
	}

	unless( @rv )
	{
		@rv = ( '2=2' );
	}

	return @rv;

}


42;