package Local::Class::DBI::Plugin::DeepAbstractSearch;

our $VERSION = '0.08';

use strict;
use warnings;
use base 'Local::Class::DBI::Plugin';
use SQL::Abstract::Limit;

sub init {
	my $class = shift;
	$class->set_sql( deeply_and_broadly => qq{%s} );
}

sub deep_search_where : Plugged
{
	my $class = shift;
    
	my ($what, $from, $where, $bind, $order, $limit) = $class->get_deep_where(@_);
    
	my $distinct_on = join(', ', defined $order ? map { "__sort_field$_" } 0..$#{$order} : ( ), map { "t_0.$_" } $class->primary_columns);
	my $order_fields = defined $order ? ', ' . join(', ', map { "$order->[$_]->{'field'} AS __sort_field$_" } 0..$#{$order}) : '';
	my $sql = <<EOF;
		SELECT DISTINCT ON ($distinct_on) 
			$what
			$order_fields
		FROM
			$from
		WHERE
			$where
EOF
	
	if (defined $order) {
		my $order_by = join(', ', map { "__sort_field$_ $order->[$_]->{'options'}" } 0..$#{$order});
		$sql .= <<EOF;
ORDER BY
	$order_by
EOF
	}

	$sql .= $limit if (defined $limit);

	return $class->sth_to_objects($class->sql_deeply_and_broadly($sql), $bind);
}

sub count_deep_search_where : Plugged
{
    my $class = shift;
    
    my ($what, $from, $where, $bind) = $class->get_deep_where(@_);
    
	my $sql = <<"";
SELECT COUNT(*)
FROM $from
WHERE $where

	return $class->sql_deeply_and_broadly($sql)->select_val(@$bind);
}

# my ($what, $from, $where, $bind) = CDBI->get_deep_where($where, $attr);
sub get_deep_where : Plugged
{
    my $class = shift;
    my $where = (ref $_[0]) ? $_[0]          : { @_ };
    my $attr  = (ref $_[0]) ? $_[1]          : undef;
    my $order = ($attr)     ? delete($attr->{order_by}) : undef;
    my $limit  = ($attr)    ? delete($attr->{limit})    : undef;
    my $offset = ($attr)    ? delete($attr->{offset})   : undef;
    my $left_joins = ($attr) ? delete($attr->{left_joins}) : undef;
    my $no_default_joins = ($attr) ? delete($attr->{no_default_joins}) : undef;
    my $also_select = ($attr) ? delete($attr->{also_select}) : undef;
	my $joins = {};
	my $abbr = {};

	## Collect tables
	$where = _transform_where($class, $joins, $abbr, $where);
	if ($order) {
		$order = _transform_order($class, $joins, $abbr, $order);
	}

	# Pass DBI handle for autodetection if limit_dialect is not specified 
	$attr->{'limit_dialect'} = $class->db_Main unless (exists $attr->{'limit_dialect'});

	## Translate to SQL
    my $sql = SQL::Abstract::Limit->new(%$attr);
    my($filter, @bind) = $sql->where($where, undef, $limit, $offset);
    $filter = "WHERE 1=1 $filter"
    	unless $filter =~ /^\s*WHERE/i;
    $filter =~ s/^\s*WHERE//i;

    $filter =~ s/((LIMIT|OFFSET).*)//;
    $limit = $1;

	my ($tables, $join, $essential_alias);
	$tables = '__TABLE__';
	if (%$joins) {
		my @sorted_joins = sort { $a->{'join_order'} <=> $b->{'join_order'} } values %$joins;
		my $root = shift @sorted_joins;
		my $join_type = $left_joins ? 'LJOIN' : 'IJOIN';

		$tables = "__TABLE($root->{class}=$root->{alias})__ ";
		$essential_alias = $root->{alias};
		$tables .= join(' ', map {
			if ($_->{fclass}) {
				"__${join_type}($_->{fclass}" . (exists $_->{fkey} ? ".$_->{fkey}" : '') . " $_->{class}=$_->{alias}" . (exists $_->{key} ? ".$_->{key}" : '') . ")__"
			} else {
				()
			}
		} @sorted_joins);
	}

	# Always left join also_selects
	my $ajoins = { };
	{
		unless ($no_default_joins) {
			push @{$also_select}, @{ $class->DefaultJoin } if ($class->can('DefaultJoin'));
		}
		map { _get_join($class, $ajoins, $abbr, split(/\./, $_)) } @{ $also_select } if (ref($also_select));

		map { delete $ajoins->{$_} } keys %$joins;

		my @sorted_joins = sort { $a->{'join_order'} <=> $b->{'join_order'} } values %$ajoins;

		if ($tables eq "__TABLE__") {
		  my $root = shift @sorted_joins;
		  $tables = "__TABLE($root->{class}=$root->{alias})__ ";
		  $essential_alias = $root->{alias};
		}

		map { $_->{'ljoin'} = $_->{fclass} ? "__LJOIN($_->{fclass}" . (exists $_->{fkey} ? "\.$_->{fkey}" : '') . " $_->{class}=$_->{alias}" . (exists $_->{key} ? "\.$_->{key}" : '') . ")__" : die $_->{class} } @sorted_joins;

		# Left join against the correct root table
		my @tables = split (/, /, $tables);
		foreach my $also_join (@sorted_joins) {
		  foreach my $ii (0..$#tables) {
		    $tables[$ii] .= " " . $also_join->{ljoin} if ($tables[$ii] =~ /\W$also_join->{fclass}\W/);
		  }
		}
		$tables = join(", ", @tables);
	}

	## Build pseudo-query
	my $essential = defined ($essential_alias) ? "__ESSENTIAL($essential_alias)__" : "__ESSENTIAL__";

	if (ref($also_select)) {
		foreach my $join (@{ $also_select }) {
			$essential .= ", __JOINED_ESSENTIAL($joins->{$join}->{class}, $joins->{$join}->{alias}, $join)__" if (exists $joins->{$join});
			$essential .= ", __JOINED_ESSENTIAL($ajoins->{$join}->{class}, $ajoins->{$join}->{alias}, $join)__" if (exists $ajoins->{$join});
		}
	}

	$sql = join("\0", "$essential", $tables, join(" AND ", grep { defined && length } ($join, $filter)));

	## Transform to real SQL
	$sql = $class->transform_sql($sql);

	return (split(/\0/, $sql), \@bind, $order, $limit);
}


# Replace field names with fully qualified (table_alias.field) names
sub _transform_where {
    my ($class, $joins, $abbr, $where, $hint) = @_;
    my $ref  = ref $where || '';
    my $val;
    my $field_re = qr/^(:::)?[a-z]/i;

    $hint ||= '';

    if($ref eq 'ARRAY') {
    	my @where = @$where;
        if ($hint ne 'exps' || $where->[0] !~ $field_re) {
            ## transforming [ operator, expr1, expr2 ]
            ## or array in  { operator => ['assigned', 'in-progress']}
            $val = [];
            while ($_ = shift @where) {
                push @$val, ((ref $_) ? _transform_where($class, $joins, $abbr, $_) : $_);
            }
        } else {
            ## transforming [ field1 => expr1, field2 => expr2 ]
            ## or array in  { operator => [ field1 => expr1, field2 => expr2 ]}
            $val = [];
            while (my $field = shift @where) {
                ## don't transform operator in mixed case [ field1 => expr1, operator => expr2 ]
                push @$val, ($field !~ $field_re) ? $field : _transform_field($class, $joins, $abbr, $field);
                push @$val, _transform_where($class, $joins, $abbr, shift @where);
            }
        }
    } elsif ($ref eq 'HASH') {
        $val = {};
        foreach my $key (keys %$where) {
            if($key !~ $field_re) {
                ## transforming   { operator => expr }
                ## or operator in   field => { operator => [ values ] }
                if($key =~ /^-?\s*(not[\s_]+)?(in|between)\s*$/i) {
                	## special case for IN and BETWEEN
	                $hint = 'val';
                } else {
	                $hint ||= 'exps';
	            }
                $val->{$key} = _transform_where($class, $joins, $abbr, $where->{$key}, $hint);
            } else {
                ## transforming { field => expr }
                $val->{_transform_field($class, $joins, $abbr, $key)} =
                    _transform_where($class, $joins, $abbr, $where->{$key}, 'val');
            }
        }
    } elsif ($ref eq 'SCALAR') {
      # If pass through value looks like a field, transform it
      if (${$where} =~ /^\w+(\.\w+)+$/) {
        $val = \_transform_field($class, $joins, $abbr, ${$where});
      } else {
        $val = $where;
      }
    } else {
        ## literal or SQL
        $val = $where;
    }
    $val;
}

# Change "table.field1.field2, table.field3.field4 DESC" into
#     "t_table_field1.field2, t_table_field3.field4 DESC"
sub _transform_order {
	my ($class, $joins, $abbr, $order) = @_;

	unless (ref($order) eq 'ARRAY') {
		$order = [ split /\s*,\s*/, $order ];
	}

	my $transformed_order;
	foreach my $field (@{ $order }) {
		my $options = '';
		$options = $1 if ($field =~ s/((?:\s+(?:ASC|DESC|NULLS\s+(?:LAST|FIRST))\b)+)\s*$//i);
		my $ord = _transform_field($class, $joins, $abbr, $field);
		push @{$transformed_order}, { field => $ord, options => $options };
	}

	return $transformed_order;
}

# Change "table.field1.field2" into "t_table_field1.field2"
sub _transform_field {
    my ($class, $joins, $abbr, $field) = @_;

    if ((my @pieces = split(/:::/, $field, -1)) > 1) {
      if (@pieces % 2 == 1) {
        my $transformed_field;
  
        while (@pieces) {
          $transformed_field .= shift @pieces;
  
          if (@pieces) {
            my $field_name = shift @pieces;
            $transformed_field .= _transform_field($class, $joins, $abbr, $field_name);
          }
        }

        return $transformed_field;
      } else {
        warn "Encountered odd number of ::: field name delimiters";
      }
    }

    # Strip simple functions a(b(c(field)))
    my @functions;
    {
      while ($field =~ s/\(([^()]+)\)//)
      {
        push @functions, $1;
      }

      push @functions, $field;
    }

        $field = shift @functions;
	my @path = split /\./, $field;

	$field = pop @path;
	my $join = _get_join($class, $joins, $abbr, @path);
	unshift @functions, "$join->{alias}.$field";

	# Rewrap in simple functions a(b(c(t_table_field)))
	return join('(', reverse @functions) . (')' x $#functions);
}

# Return the join for (table, field1, field2, field3)
sub _get_join {
    my ($class, $joins, $abbr, @path) = @_;

	my $join_key = lc join('.', @path);
	my $join = $joins->{$join_key};
	if(!$join) {
		if(my $field = pop @path) {
			## Joined table
			my $prev_join = _get_join($class, $joins, $abbr, @path);
			my $fcl = $prev_join->{class};
			my $falias = $prev_join->{alias};

			if (defined (my $col = $fcl->find_column($field))) {
				my $cl;

				my $meta = $fcl->meta_info;
				if (exists $meta->{'has_a'} && exists $meta->{'has_a'}->{$col}) {
					$cl = $meta->{'has_a'}->{$col}->foreign_class;
				} elsif (exists $meta->{'extends'} && exists $meta->{'extends'}->{$col}) {
					$cl = $meta->{'extends'}->{$col}->foreign_class;
				}

				$cl or $class->_croak("$fcl column '$col' doesn't have a relationship");

				$join = { fclass => $falias, fkey => "$col", class => $cl, alias => "${falias}_$col" }
			} elsif (defined (my $has_many = $fcl->meta_info('has_many' => $field))) {
				my $cl = $has_many->foreign_class;
				my $table = $cl->table;
				$table =~ s/\./_/g;
				$join = { fclass => $falias, class => $cl, alias => "${falias}_$field" };

				# Capture the remote key in the join for the simple single key case
				if ((my @foreign_key = @{ $has_many->{'args'}->{'foreign_key'} }) == 1) {
					$join->{key} = $foreign_key[0];
				}
			} elsif (defined (my $might_have = $fcl->meta_info('might_have' => $field))) {
				my $cl = $might_have->foreign_class;
				my $table = $cl->table;
				$table =~ s/\./_/g;
				$join = { fclass => $falias, class => $cl, alias => "${falias}_$field" };

				if (defined $might_have->{'args'}->{'foreign_key'}) {
				  $join->{'key'} = $might_have->{'args'}->{'foreign_key'};
				}
			} elsif (defined (my $has_a_mk = $fcl->meta_info('has_a_mk' => $field))) {
				my $cl = $has_a_mk->foreign_class;
				my $table = $cl->table;
				$table =~ s/\./_/g;
				$join = { fclass => $falias, class => $cl, alias => "${falias}_$field" }
			} elsif (defined $fcl->__hasa_list && $fcl->__hasa_list->{$field}) { # Support BSN style fully qualified class fields
				my $table = $field->table;
				$table =~ s/\./_/g;
				$join = { fclass => $falias, class => $field, alias => 't_' . $table };
			} else {
				$class->_croak("$fcl doesn't contain column or a relation named '$field'");
			}
		} else {
			## Primary table
			my $table = $class->table;
			$table =~ s/\./_/g;
			$join = { class => $class, alias => 't_' . $table }
		}

		$join->{'join_order'} = scalar(keys %$joins);

		# XXX Abbreviate alias to try to fit under 63 characters
		$abbr->{$join_key} = 't_' . scalar(keys %{$abbr}) unless (exists $abbr->{$join_key});
		$join->{alias} = $abbr->{$join_key};

		## Add join to list of joins
		$joins->{$join_key} = $join;
	}

	$join;
}

1;

__END__

=head1 NAME

Local::Class::DBI::Plugin::DeepAbstractSearch - deep_search_where() for Local::Class::DBI

=head1 SYNOPSIS

	use base 'Local::Class::DBI';
	use Local::Class::DBI::Plugin::DeepAbstractSearch;

	my @cds = Music::CD->deep_search_where(
		{
			'artist.name' => $artist_name
		}
	);

=head1 DESCRIPTION

This plugin provides a L<SQL::Abstract> search method for L<Local::Class::DBI>.
It is similar to L<Local::Class::DBI::AbstractSearch>, but allows you to search
and sort by fields from joined tables.

Note: When searching and sorting by the fields of the current class only,
it is more efficient to use L<Local::Class::DBI::AbstractSearch>.

=head1 METHODS

=head2 deep_search_where

	my @cds = Music::CD->deep_search_where(
		{
			'artist.name' => $artist_name
		}
	);

This method will be exported into the calling class, and allows for searching
of objects using L<SQL::Abstract> format based on fields from the calling
class as well as using fields in classes related through a (chain of) 'has_a'
relationships to the calling class.

When specifying a field in a related class, you separate it with a period
from the corresponding foreign key field in the primary class.

	package Music::Artist;
	use base 'Local::Class::DBI';
	Music::Artist->table('artist');
	Music::Artist->columns(All => qw/artistid name/);
	Music::Artist->has_many(cds => 'Music::CD');

	package Music::CD;
	use base 'Local::Class::DBI';
	Music::CD->table('cd');
	Music::CD->columns(All => qw/cdid artist title year/);
	Music::CD->has_many(tracks => 'Music::Track');
	Music::CD->has_a(artist => 'Music::Artist');

	package Music::Track;
	use base 'Local::Class::DBI';
	Music::Track->table('track');
	Music::Track->columns(All => qw/trackid cd position title/); 

	## Tracks on all CDs with the title "Greatest Hits"
	@tracks = Music::Track->deep_search_where(
		{
			'cd.title' => "Greatest Hits"
		},
		{
			sort_by => 'cd.title'
		}
	);

	## Tracks on CDs by Willie Nelson, sorted by CD Title and Track Position
	@tracks = Music::Track->deep_search_where(
		{
			'cd.artist.name' => "Willie Nelson"
		},
		{
			sort_by => 'cd.title, position'
		}
	);

	## First 3 Tracks on CDs, whose title contains "Outlaw", by Willie Nelson
	@tracks = Music::Track->deep_search_where(
		{
			'cd.artist.name' => "Willie Nelson",
			'cd.title' => { -like => '%Outlaw%' },
			position => { '<=' => 3 }
		},
		{
			sort_by => 'cd.title, position'
		}
	);

=head2 count_deep_search_where

	my $num_cds = Music::CD->count_deep_search_where(
		{
			'artist.name' => $artist_name
		}
	);

This method will be exported into the calling class, and allows for counting
of objects using L<SQL::Abstract> format based on fields from the calling
class as well as using fields in classes related through a (chain of) 'has_a'
relationships to the calling class.

=head2 get_deep_where

    my ($what, $from, $where, $bind) = $class->get_deep_where($where, $attr);

This method will be exported into the calling class, and allows for retrieving
SQL fragments used for creating queries.  The parameters are the same as to
deep_search_where.

=head1 AUTHOR

Stepan Riha, C<sriha@cpan.org>

=head1 COPYRIGHT

Copyright (C) 2005, 2007, 2008 Stepan Riha. All rights reserved.

This module is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=head1 SEE ALSO

L<Local::Class::DBI>, L<SQL::Abstract>, L<Local::Class::DBI::AbstractSearch>

=cut
