File Coverage

blib/lib/LittleORM/Filter.pm

Criterion	Covered	Total	%
statement	21	401	5.2
branch	0	104	0.0
condition	0	59	0.0
subroutine	7	50	14.0
pod	0	27	0.0
total	28	641	4.3

#!/usr/bin/perl

use strict;

package LittleORM::Model;
use LittleORM::Model::Field ();

# Extend LittleORM::Model capabilities with filter support:

sub f
{
	my $self = shift;
	return $self -> filter( @_ );
}

sub _disambiguate_filter_args
{
	my ( $self, $args ) = @_;

	{
		assert( ref( $args ) eq 'ARRAY', 'sanity assert' );

		my $argsno = scalar @{ $args };
		my $class = ( ref( $self ) or $self );
		my @disambiguated = ();

		my $i = 0;
		foreach my $arg ( @{ $args } )
		{
			if( blessed( $arg ) and $arg -> isa( 'LittleORM::Filter' ) )
			{
				unless( $i % 2 )
				{
					# this will wrk only with single column PKs

					if( my $attr_co_connect = &LittleORM::Filter::find_corresponding_fk_attr_between_models( $class,
															   $arg -> model() ) )
					{
						push @disambiguated, $attr_co_connect;
						$i ++;

					} elsif( my $rev_connect = &LittleORM::Filter::find_corresponding_fk_attr_between_models( $arg -> model(),
															    $class ) )
					{
						# print $class, "\n";
						# print $arg -> model(), "\n";
						# print $rev_connect, "\n";

						my $to_connect_with = 0;

						{
							assert( my $attr = $arg -> model() -> meta() -> find_attribute_by_name( $rev_connect ) );

							if( my $foreign_key_attr_name = &LittleORM::Model::__descr_attr( $attr, 'foreign_key_attr_name' ) )
							{
								$to_connect_with = $foreign_key_attr_name;
							} else
							{
								$to_connect_with = $class -> __find_primary_key() -> name();
							}

						}

						push @disambiguated, $to_connect_with;
						unless( $arg -> returning() )
						{
							$arg -> returning( $rev_connect );
						}

						$i ++;


					} else
					{
						assert( 0,
							sprintf( "Can not automatically connect %s and %s - do they have FK between?",
								 $class,
								 $arg -> model() ) );
					}
				}
			} elsif( blessed( $arg ) and $arg -> isa( 'LittleORM::Clause' ) )
			{
				unless( $i % 2 )
				{
					push @disambiguated, '_clause';
					$i ++;
				}
			}

			push @disambiguated, $arg;
			$i ++;
		}
		$args = \@disambiguated;
	}

	return $args;
}

sub filter
{
	my ( $self, @args ) = @_;

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

	my $rv = LittleORM::Filter -> new( model => $class );

	$rv -> push_anything_appropriate( @args );

	return $rv;
}


package LittleORM::Filter;

# Actual filter implementation:

use Moose;

has 'model' => ( is => 'rw', isa => 'Str', required => 1 );
has 'table_alias' => ( is => 'rw', isa => 'Str', default => \&get_uniq_alias_for_table );
has 'returning' => ( is => 'rw', isa => 'Maybe[Str]' ); # return column name for connecting with other filter
has 'returning_field' => ( is => 'rw', isa => 'Maybe[LittleORM::Model::Field]', default => undef );
has 'clauses' => ( is => 'rw', isa => 'ArrayRef[LittleORM::Clause]', default => sub { [] } );
has 'joined_tables' => ( is => 'rw', isa => 'ArrayRef[HashRef]', default => sub { [] } );

use Carp::Assert 'assert';
use List::MoreUtils 'uniq';
use LittleORM::Filter::Update ();
use LittleORM::Clause ();

{
	my $counter = 0;

	sub get_uniq_alias_for_table
	{
		$counter ++;

		return "T" . $counter;
	}

}

sub borrow_field
{
	my $self = shift;

	my $rv = $self -> model() -> borrow_field( @_ );
	$rv -> table_alias( $self -> table_alias() );
	return $rv;
}

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

	my @clauseargs = ();
	assert( my $class = $self -> model(), 'must know my model' );

	@args = @{ $self -> model() -> _disambiguate_filter_args( \@args ) };
	assert( scalar @args % 2 == 0 );

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

		if( $arg eq '_return' )
		{
			if( LittleORM::Model::Field -> this_is_field( $val ) )
			{
				$val -> assert_model( $class );
				$self -> returning_field( $val );
			} else
			{

				assert( $self -> model() -> meta() -> find_attribute_by_name( $val ), sprintf( 'Incorrect %s attribute "%s" in return',
													       $class,
													       $val ) );
				$self -> returning( $val );
			}

		} elsif( $arg eq '_sortby' )
		{
			assert( 0, '_sortby is not allowed in filter' );

		} elsif( $arg eq '_exists' )
		{
			assert( $val and ( ( ref( $val ) eq 'HASH' )
					   or
					   $val -> isa( 'LittleORM::Filter' ) ) );
			$self -> connect_filter_exists( 'EXISTS', $val );

		} elsif( $arg eq '_not_exists' )
		{
			assert( $val and ( ( ref( $val ) eq 'HASH' )
					   or
					   $val -> isa( 'LittleORM::Filter' ) ) );
			$self -> connect_filter_exists( 'NOT EXISTS', $val );

		} elsif( blessed( $val ) and $val -> isa( 'LittleORM::Filter' ) )
		{

			$self -> connect_filter( $arg => $val );

		} elsif( blessed( $val ) and $val -> isa( 'LittleORM::Clause' ) )
		{
			$self -> push_clause( $val );
		} else
		{
			push @clauseargs, ( $arg, $val );
		}

	}

	{
		unless( @clauseargs )
		{
			@clauseargs = ( _where => '1=1' );
		}
		my $clause = LittleORM::Clause -> new( model => $class,
						 cond => \@clauseargs,
						 table_alias => $self -> table_alias() );

		$self -> push_clause( $clause );
	}

}

sub form_conn_sql
{
	my ( $self, $arg, $filter ) = @_;

	my $conn_sql = '';

	{
		my $ta1 = $self -> table_alias();
		my $ta2 = $filter -> table_alias();

		my $attr1_t = '';
		my $attr2_t = '';
		my $cast = '';

		my $arg1 = $arg;
		my $arg2 = $filter -> get_returning();

		my ( $f1, $f2 ) = ( '', '' );

		{
			my $attr1 = $self -> model() -> meta() -> find_attribute_by_name( $arg1 );

			assert( ( $attr1 or LittleORM::Model::Field -> this_is_field( $arg1 ) ),
				'Injalid attribute 1 in filter: ' . $arg1 );

			my $attr2 = $filter -> model() -> meta() -> find_attribute_by_name( $arg2 );
			assert( ( $attr2 or LittleORM::Model::Field -> this_is_field( $arg2 ) ),
				'Injalid attribute 2 in filter (much rarer case)' );


			if( ( $attr1 and $attr2 ) and ( my $fk = &LittleORM::Model::__descr_attr( $attr1, 'foreign_key' ) ) )
			{
				if( ( $fk eq $filter -> model() )
				    and
				    ( my $fkattr = &LittleORM::Model::__descr_attr( $attr1, 'foreign_key_attr_name' ) ) )
				{
					assert( $attr2 = $filter -> model() -> meta() -> find_attribute_by_name( $fkattr ),
						'Injalid attribute 2 in filter (subcase of much rarer case)' );
				}
			}
			if( $attr1 )
			{
				$attr1_t = &LittleORM::Model::__descr_attr( $attr1, 'db_field_type' );
				$f1 = sprintf( "%s.%s",
					       $ta1,
					       &LittleORM::Model::__get_db_field_name( $attr1 ) );

			} else
			{
				$f1 = $arg1 -> form_field_name_for_db_select( $ta1 );
			}

			if( $attr2 )
			{
				$attr2_t = &LittleORM::Model::__descr_attr( $attr2, 'db_field_type' );
				$f2 = sprintf( "%s.%s",
					       $ta2,
					       &LittleORM::Model::__get_db_field_name( $attr2 ) );

			} else
			{
				$f2 = $arg2 -> form_field_name_for_db_select( $ta2 );
			}

			if( $attr1_t and $attr2_t and ( $attr1_t ne $attr2_t ) )
			{
				$cast = '::' . $attr1_t;
			}

		}



		$conn_sql = sprintf( "%s=%s%s",
				     $f1,
				     $f2,
				     $cast );
	}

	return $conn_sql;

}


sub _look_for_connecting_args_in_args_and_do_it_in_a_compatible_way
{
	my $self = shift;

	my @kws = ( '_clause' );
	my %kws = map { $_ => 1 } @kws;

	my @rest_args = ();
	my $connecting_args = {};

	my $next_arg_is_what_we_need = undef;

	foreach my $t ( @_ )
	{
		if( $next_arg_is_what_we_need )
		{
			assert( not exists $kws{ $t } );
			$connecting_args -> { $next_arg_is_what_we_need } = $t;
			$next_arg_is_what_we_need = undef;

		} elsif( exists $kws{ $t } )
		{
			$next_arg_is_what_we_need = $t;
		} else
		{
			push @rest_args, $t;
		}
	}
	assert( not defined $next_arg_is_what_we_need );

	return ( \@rest_args, $connecting_args );
}

sub _get_connecting_clause_from_connecting_args
{
	my ( $self, $args ) = @_;

	my $rv = $args -> { '_clause' };

	if( ref( $rv ) eq 'ARRAY' )
	{
		$rv = $self -> model() -> clause( @{ $rv } );
	}

	return $rv;
}

sub connect_filter
{
	my $self = shift;

	my ( $rest_args, $connecting_args ) = $self -> _look_for_connecting_args_in_args_and_do_it_in_a_compatible_way( @_ );

	@_ = @{ $rest_args };
	my $connecting_clause = $self -> _get_connecting_clause_from_connecting_args( $connecting_args );

	my ( $arg, $filter ) = $self -> _sanitize_args_for_connecting( ArgAndFilter => \@_,
								       ConnectingClause => $connecting_clause );

	map { $self -> push_clause( $_, $filter -> table_alias() ) } @{ $filter -> clauses() };

	unless( $connecting_clause )
	{
		my $conn_sql = $self -> form_conn_sql( $arg, $filter );

		$connecting_clause = $self -> model() -> clause( cond => [ _where => $conn_sql ],
								 table_alias => $self -> table_alias() );

	}

	$self -> push_clause( $connecting_clause );

	map { $self -> _self_add_table_join( $_ ) } @{ $filter -> joined_tables() };
}

sub _valid_join_type
{
	my ( $self, $jtype ) = @_;

	my @known = ( 'JOIN', 'INNER JOIN', 'LEFT JOIN', 'RIGHT JOIN', 'LEFT OUTER JOIN', 'RIGHT OUTER JOIN', 'MEGAJOIN 3000' );
	my %known = map { $_ => 1 } @known;

	my $rv = 0;

	if( exists $known{ uc( $jtype ) } )
	{
		$rv = 1;
	}

	return $rv;
}

sub connect_filter_right_join
{
	my $self = shift;
	$self -> connect_filter_complex( 'RIGHT JOIN', @_ );
}

sub connect_filter_right_outer_join
{
	my $self = shift;
	$self -> connect_filter_complex( 'RIGHT OUTER JOIN', @_ );
}

sub connect_filter_left_join
{
	my $self = shift;
	$self -> connect_filter_complex( 'LEFT JOIN', @_ );
}

sub connect_filter_left_outer_join
{
	my $self = shift;
	$self -> connect_filter_complex( 'LEFT OUTER JOIN', @_ );
}

sub connect_filter_inner_join
{
	my $self = shift;
	$self -> connect_filter_complex( 'INNER JOIN', @_ );
}


sub connect_filter_join
{
	my $self = shift;
	$self -> connect_filter_complex( 'JOIN', @_ );
}

sub connect_filter_complex
{
	my $self = shift;
	my $type = shift;

	if( $type )
	{
		assert( $self -> _valid_join_type( $type ), 'I dont know this join type: ' . $type );

		my ( $rest_args, $connecting_args ) = $self -> _look_for_connecting_args_in_args_and_do_it_in_a_compatible_way( @_ );
		@_ = @{ $rest_args };

		my $connecting_clause = $self -> _get_connecting_clause_from_connecting_args( $connecting_args );
		my ( $arg, $filter ) = $self -> _sanitize_args_for_connecting( ArgAndFilter => \@_,
									       ConnectingClause => $connecting_clause );

		map { $self -> push_clause( $_, $filter -> table_alias() ) } @{ $filter -> clauses() };

		my $conn_sql = undef;

		if( $connecting_clause )
		{
			$conn_sql = $connecting_clause -> sql();
		} else
		{
			$conn_sql = $self -> form_conn_sql( $arg, $filter );
		}

		my %join_spec = ( type => $type,
				  to => { $self -> model() -> _db_table() => $self -> table_alias() },
				  table => { $filter -> model() -> _db_table() => $filter -> table_alias() },
				  on => $conn_sql );

		$self -> _self_add_table_join( \%join_spec );

		map { $self -> _self_add_table_join( $_ ) } @{ $filter -> joined_tables() };

	} else
	{
		$self -> connect_filter( @_ );
	}
}

sub _self_add_table_join
{
	my ( $self, $join_spec ) = @_;

	push @{ $self -> joined_tables() }, $join_spec;
}

sub _sanitize_args_for_connecting
{

	my $self = shift;

	my %args = @_;
	my ( $arg_and_filter,
	     $connecting_clause ) = @args{ 'ArgAndFilter',
					   'ConnectingClause' };

	my ( $arg, $filter ) = @{ $arg_and_filter };

	unless( $filter )
	{
		if( ref( $arg ) eq 'HASH' )
		{
			assert( scalar keys %{ $arg } == 1 );
			( $arg, $filter ) = %{ $arg };
		}
	}

	unless( $filter )
	{
		if( $arg and blessed( $arg ) and $arg -> isa( 'LittleORM::Filter' ) )
		{
			$filter = $arg;

			unless( $connecting_clause )
			{
				my $args = $self -> model() -> _disambiguate_filter_args( [ $arg ] );

				( $arg, $filter ) = @{ $args };
			}

		} else
		{
			assert( 0, 'check args sanity' );
		}
	}

	return ( $arg, $filter );
}

sub connect_filter_exists
{
	my $self = shift;
	my $exists_keyword = shift;

	my ( $arg, $filter ) = $self -> _sanitize_args_for_connecting( ArgAndFilter => \@_ );

	my $exf = LittleORM::Filter -> new( model => $filter -> model(),
				      table_alias => $filter -> table_alias() );


	map { $exf -> push_clause( $_, $filter -> table_alias() ) } @{ $filter -> clauses() };

	my $conn_sql = $self -> form_conn_sql( $arg, $filter );

	{
		my $c1 = $self -> model() -> clause( cond => [ _where => $conn_sql ],
						     table_alias => $self -> table_alias() );


		$exf -> push_clause( $c1 );
	}

	{

		my $select_from_sql_part = '';

		{
			my %t = $exf -> all_tables_used_in_filter();
			# do not include outer table inside EXISTS select:
			$select_from_sql_part = join( ',', map { $t{ $_ } .
								 " " .
								 $_ }
						           grep { $_ ne $self -> table_alias() }
						           keys %t );

		}

		my $sql = sprintf( " %s (SELECT 1 FROM %s WHERE %s LIMIT 1) ",
				   $exists_keyword,
				   $select_from_sql_part,
				   join( ' AND ', $exf -> translate_into_sql_clauses() ) );

		my $c1 = $self -> model() -> clause( cond => [ _where => $sql ],
						     table_alias => $self -> table_alias() );


		$self -> push_clause( $c1 );
	}

	return 0;
}

sub push_clause
{
	my ( $self, $clause, $table_alias ) = @_;


	unless( $clause -> table_alias() )
	{
		unless( $table_alias )
		{
			if( $self -> model() eq $clause -> model() )
			{
				$table_alias = $self -> table_alias();

				# maybe clone here to preserve original clause obj ?
				my $copy = bless( { %{ $clause } }, ref $clause );
				$clause = $copy;
				$clause -> table_alias( $table_alias );
			}
		}
	}

	if( $clause -> table_alias() )
	{

		push @{ $self -> clauses() }, $clause;

	} else
	{
		assert( $self -> model() ne $clause -> model(), 'sanity assert' );

		my $other_model_filter = $clause -> model() -> filter( $clause );
		$self -> connect_filter( $other_model_filter );


	}



	# if( $self -> model() eq $clause -> model() )
	# {

	# } else
	# {
	# 	my $other_model_filter = $clause -> model() -> filter( _clause => $clause );
	# 	$self -> connect_filter( $other_model_filter );
	# }


	return $self -> clauses();
}

sub get_returning
{
	my $self = shift;

	my $rv = $self -> returning();

	if( $rv )
	{
		1;
	} elsif( my $rv_f = $self -> returning_field() )
	{
		$rv = $rv_f;

	} else
	{
		assert( my $pk = $self -> model() -> __find_primary_key(),
			sprintf( 'Model %s must have PK or specify "returning" manually',
				 $self -> model() ) );
		$rv = $pk -> name();
	}

	return $rv;

}

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

	my $clauses_number = scalar @{ $self -> clauses() };

	my @all_clauses_together = ();

	for( my $i = 0; $i < $clauses_number; $i ++ )
	{
		my $clause = $self -> clauses() -> [ $i ];
		my $sql = $clause -> sql( $self -> _grep_out_non_system( @args ) );
		push @all_clauses_together, $sql;
	}

	return @all_clauses_together;
}

sub _grep_out_non_system
{
	my $self = shift;

	my @args = @_;
	my @rv = ();

	while( my $arg = shift @args )
	{
		my $val = shift @args;
		if( $arg =~ /^_/ )
		{
			push @rv, ( $arg, $val );
		}
	}

	return @rv;
}

sub _table_spec_with_join_support
{
	my ( $self, $table, $depth ) = @_;

	$depth = ( $depth or 0 );

	assert( $depth < 100, 'Too deep in.' );

	my ( $tn, $ta ) = %{ $table };

	my $rv = '';

	if( ( $depth == 0 ) and &__in_skip_list( my $s = $tn . ' ' . $ta ) )
	{
		return $rv;

	} elsif( $depth ) # or &__in_skip_list( $s ) )
	{
		1;
	} else
	{
		$rv = $s;
	}

	foreach my $jt ( @{ $self -> joined_tables() } )
	{
		my ( $jt_to_n, $jt_to_a ) = %{ $jt -> { 'to' } };

		if( ( $jt_to_n eq $tn )
		    and
		    ( $jt_to_a eq $ta ) )
		{

			my ( $jt_n, $jt_a ) = %{ $jt -> { 'table' } };
			my $jspec = $jt_n . ' ' . $jt_a;

			$rv .= ' ' .
			    $jt -> { 'type' } .
			    ' ' .
			    $jspec .
			    ' ON ( ' . $jt -> { 'on' } . ' ) ';

			&__add_to_skip_list( $jspec );
			$rv .= $self -> _table_spec_with_join_support( $jt -> { 'table' }, $depth + 1 );
		}
	}
	return $rv;
}

{
	# revisit later TODO

	my %skip_list = ();

	sub __clear_skip_list
	{
		%skip_list = ();
	}

	sub __add_to_skip_list
	{
		my $what = shift;
		$skip_list{ $what } = 1;
	}

        sub __in_skip_list
        {
		my $what = shift;

		my $rv = 0;

		if( exists $skip_list{ $what } )
		{
			$rv = 1;
		}
		return $rv;
	}
}


sub _all_tables_used_in_filter_joinable # TODO
{
	my $self = shift;

	my @rv = ();

	my %skip_duplicates = ();

	&__clear_skip_list();

J1Dz1VhnaYMJllvy:
	foreach my $c ( @{ $self -> clauses() } )
	{
		my $t = $c -> model() -> _db_table();
		assert( my $ta = $c -> table_alias(), 'Unknown clause origin' );

		if( exists $skip_duplicates{ $ta } )
		{
			1;
		} else
		{
			if( my $spec = $self -> _table_spec_with_join_support( { $t => $ta } ) )
			{
				push @rv, $spec;
			}

			$skip_duplicates{ $ta } = 1;
		}
	}

	&__clear_skip_list();

	return \@rv;
}

sub all_tables_used_in_filter
{
	my $self = shift;

	my %rv = ();

J1Dz1VhnaYMJllvy:
	foreach my $c ( @{ $self -> clauses() } )
	{
		my $t = $c -> model() -> _db_table();
		assert( my $ta = $c -> table_alias(), 'Unknown clause origin' );

		# foreach my $join_spec ( @{ $self -> joined_tables() } )
		# {
		# 	if( exists $join_spec -> { 'table' } -> { $t } )
		# 	{
		# 		next J1Dz1VhnaYMJllvy;
		# 	}
		# }
		$rv{ $ta } = $t;
	}

	return %rv;
}

sub get_many
{
	my $self = shift;

	return $self -> call_orm_method( 'get_many', @_,
					 &LittleORM::Model::__for_read() );
}

sub get
{
	my $self = shift;

	return $self -> call_orm_method( 'get', @_,
					 &LittleORM::Model::__for_read() );
}

sub count
{
	my $self = shift;

	return $self -> call_orm_method( 'count', @_,
					 &LittleORM::Model::__for_read() );
}

sub max
{
	my $self = shift;

	return $self -> call_orm_method( 'max', @_,
					 &LittleORM::Model::__for_read() );
}

sub min
{
	my $self = shift;

	return $self -> call_orm_method( 'min', @_,
					 &LittleORM::Model::__for_read() );
}

sub delete
{
	assert( 0, 'Delete is not supported in LittleORM::Filter. Just map { $_ -> delete() } at what get_many() returns.' );
}

sub call_orm_method
{
	my $self = shift;
	my $method = shift;

	my @args = @_;

	my %all = $self -> all_tables_used_in_filter();
	my $all = $self -> _all_tables_used_in_filter_joinable();

	my @targs = $self -> _correct_args_for_sql_translation_when_calling_certain_orm_methods( $method, @args );

	return $self -> model() -> $method( $self -> _correct_args_for_calling_certain_orm_methods( $method, @args ),
					    _table_alias => $self -> table_alias(),
					    _tables_used => [ map { sprintf( "%s %s", $all{ $_ }, $_ ) } keys %all ],
					    _tables_to_select_from => $all,
					    _where => join( ' AND ', $self -> translate_into_sql_clauses( @targs ) ) );
}

sub _correct_args_for_calling_certain_orm_methods
{
	my $self = shift;
	my $method = shift;

	my @args = @_;

	my $replace_attr_with_field = sub { my $method = shift;
					    my @attrs = @_;
					    my $aname = $attrs[ 0 ];
					    unless( LittleORM::Model::Field -> this_is_field( $aname ) )
					    {
						    assert( my $attr = $self -> model() -> meta() -> find_attribute_by_name( $aname ) );
						    my $f = $self -> model() -> borrow_field( $aname,
											      select_as => $method );
						    $attrs[ 0 ] = $f;
					    }
					    return @attrs; };

	my %cleanse = ( min => $replace_attr_with_field,
			max => $replace_attr_with_field );

	if( my $code = $cleanse{ $method } )
	{
		@args = $code -> ( $method, @args );
	}

	return @args;
}

sub _correct_args_for_sql_translation_when_calling_certain_orm_methods
{
	my $self = shift;
	my $method = shift;

	my @args = @_;

	my $skip_first_arg = sub { shift @_ ; return @_; };

	my %cleanse = ( 'min' => $skip_first_arg,
			'max' => $skip_first_arg );

	if( my $code = $cleanse{ $method } )
	{
		@args = $code -> ( @args );
	}

	return @args;
}

sub find_corresponding_fk_attr_between_models
{
	my ( $model1, $model2 ) = @_;

	my $rv = undef;

DQoYV7htzKfc5YJC:
	foreach my $attr ( $model1 -> meta() -> get_all_attributes() )
	{
		if( my $fk = &LittleORM::Model::__descr_attr( $attr, 'foreign_key' ) )
		{
			if( $fk eq 'yes' )
			{
				assert( my $tc = $attr -> type_constraint(),
					sprintf( '%s attr type_constraint() is missing, did you specify "isa"?',
						 $attr -> name() ) );
				assert( $fk = $tc -> name() );
			}

			if( $model2 eq $fk )
			{
				$rv = $attr -> name();
			}
		}
	}

	return $rv;
}

42;