use strict;

package Tangram::CursorObject;
use Carp;

sub new
{
   my ($pkg, $storage, $class) = @_;

   my $schema = $storage->{schema};
   my $classes = $schema->{classes};
	$schema->check_class($class);

   my @tables;
	my $table_hash = { };
   my $self = bless { storage => $storage, tables => \@tables, class => $class,
		table_hash => $table_hash }, $pkg;

   $storage->{schema}->visit_up($class,
      sub
      {
         my $class = shift;
			
			unless ($classes->{$class}{stateless})
			{
				my $id = $storage->alloc_table;
				push @tables, [ $class, $id ];
				$table_hash->{$class} = $id;
			}
      } );

   return $self;
}

sub copy
{
   my ($pkg, $other) = @_;

	my $self = { %$other };
	$self->{tables} = [ @{ $self->{tables} } ];

	bless $self, $pkg;
}

sub storage
{
   shift->{storage}
}

sub table
{
	my ($self, $class) = @_;
	$self->{table_hash}{$class} or confess "no table for $class in stored '$self->{class}'";
}

sub tables
{
   shift->{tables}
}

sub class
{
	shift->{class}
   #my ($self) = @_;
   #my $tables = $self->{tables};
   #return $tables->[$#$tables][0];
}

sub parts
{
   return map { $_->[0] } @{ shift->{tables} };
}

sub root_table
{
   my ($self) = @_;
   return $self->{tables}[0][1];
}

sub class_id_col
{
   my ($self) = @_;
   return "t$self->{tables}[0][1].classId";
}

sub leaf_table
{
   my ($self) = @_;
   return $self->{tables}[-1][1];
}

sub from
{
   return join ', ', &from unless wantarray;

   my ($self) = @_;
   my $schema = $self->storage->{schema};
   my $classes = $schema->{classes};
   my $tables = $self->{tables};
   map { "$classes->{$_->[0]}{table} t$_->[1]" } @$tables;
}

sub where
{
   return join ' AND ', &where unless wantarray;

   my ($self) = @_;
   
	my $tables = $self->{tables};
   my $root = $tables->[0][1];

   map { "t@{$_}[1].id = t$root.id" } @$tables[1..$#$tables];
}

sub cols
{
   return join ', ', &cols unless wantarray;

   my ($self) = @_;

   my $tables = $self->tables;
   my $root = $tables->[0][1];
   my $schema = $self->storage->{schema};

   my $cols = "t$root.id, t$root.classId";

   foreach my $table (@$tables)
   {
      my ($class, $id) = @$table;
      my $classdef = $schema->classdef($class);

      foreach my $typetag (keys %{$classdef->{members}})
      {
         my $members = $classdef->{members}{$typetag};

         foreach my $col ($schema->{types}{$typetag}->cols($members))
         {
            $cols .= ", t$table->[1].$col";
         }
      }
   }

   return $cols;
}

sub mark
{
   return @{ shift->{tables} };
}

sub push_spec
{
   my ($self, $spec) = @_;
   my $tables = $self->tables;
   push @$tables, [ $spec, $self->storage->alloc_table ];
}

sub pop_spec
{
   my ($self, $mark) = @_;
   my $tables = $self->{tables};
   $self->storage->free_table( map { $_->[1] } splice @$tables, $mark, @$tables - $mark );
}

sub expr_hash
{
   my ($self) = @_;
   my $storage = $self->{storage};
   my $schema = $storage->{schema};
   my $classes = $schema->{classes};
	my @tables = @{$self->{tables}};
   my $root_tid = $tables[0][1];
   
   my %hash =
   (
      object => $self, 
      id => Tangram::Expr->new("t$root_tid.id", 'Tangram::Number', $self)
   );

   $schema->visit_up($self->{class},
      sub
      {
			my $classdef = $classes->{shift()};

			my $tid = (shift @tables)->[1] unless $classdef->{stateless};

			foreach my $typetag (keys %{$classdef->{members}})
			{
				my $type = $schema->{types}{$typetag};
				my $memdefs = $classdef->{members}{$typetag};
				@hash{$type->members($memdefs)} =
					$type->query_expr($self, $memdefs, $tid);
			}
      } );

   return \%hash;
}

package Tangram::RDBObject;

use base qw( Tangram::CursorObject );

sub where
{
   return join ' AND ', &where unless wantarray;

   my ($self) = @_;
   
	my $storage = $self->{storage};
   my $schema = $storage->{schema};
   my $classes = $schema->{classes};
	my $tables = $self->{tables};
   my $root = $tables->[0][1];
	my $class = $self->{class};

	my @where_class_id;

	if ($classes->{$class}{stateless})
	{
		my @class_ids;

		push @class_ids, $storage->class_id($class) unless $classes->{$class}{abstract};

		$schema->for_each_spec($class,
			sub { my $spec = shift; push @class_ids, $storage->class_id($spec) unless $classes->{$spec}{abstract} } );

		@where_class_id = "t$root.classId IN (" . join(', ', @class_ids) . ')';
	}

   return (@where_class_id, map { "t@{$_}[1].id = t$root.id" } @$tables[1..$#$tables]);
}

package Tangram::Filter;
use Carp;

sub new
{
   my $pkg = shift;
   my $self = bless { @_ }, $pkg;
   $self->{objects} ||= Set::Object->new;
   $self;
}

sub and
{
   my ($self, $other, $reversed) = @_;
   return op($self, 'AND', 10, $other);
}

sub or
{
   my ($self, $other, $reversed) = @_;
   return op($self, 'OR', 9, $other);
}

sub as_string
{
   my $self = shift;
   return ref($self) . "($self->{expr})";
}

use overload "&" => \&and, "|" => \&or, '""' => \&as_string, fallback => 1;

sub op
{
   my ($left, $op, $tight, $right) = @_;

   confess "undefined operand(s) for $op" unless $left && $right;

   my $lexpr = $tight > $left->{tight} ? "($left->{expr})" : $left->{expr};
   my $rexpr = $tight > $right->{tight} ? "($right->{expr})" : $right->{expr};

   return new Tangram::Filter(
      expr => "$lexpr $op $rexpr",
      tight => $tight,
      objects => Set::Object->new(
         $left->{objects}->members, $right->{objects}->members ) );
}

sub from
{
   return join ', ', &from unless wantarray;
   map { $_->from } shift->objects;
}

sub where
{
   return join ' AND ', &where unless wantarray;

   my ($self) = @_;
   my @expr = "($self->{expr})" if exists $self->{expr};
   (@expr, map { $_->where } $self->objects);
}

sub where_objects
{
   return join ' AND ', &where_objects unless wantarray;
   my ($self, $object) = @_;
   map { $_ == $object ? () : $_->where } $self->objects;
}

sub objects
{
   shift->{objects}->members;
}

package Tangram::Expr;

sub new
{
   my ($pkg, $expr, $type, @objects) = @_;
   return bless { expr => $expr, type => $type,
      objects => Set::Object->new(@objects),
		storage => $objects[0]->{storage} }, $pkg;
}

sub objects
{
   return shift->{objects}->members;
}

sub eq
{
   my ($self, $arg, $reversed) = @_;
   return $self->binop('=', $arg, $reversed);
}

sub ne
{
   my ($self, $arg, $reversed) = @_;
   return $self->binop('<>', $arg, $reversed);
}

sub lt
{
   my ($self, $arg, $reversed) = @_;
   return $self->binop('<', $arg, $reversed);
}

sub le
{
   my ($self, $arg, $reversed) = @_;
   return $self->binop('<=', $arg, $reversed);
}

sub gt
{
   my ($self, $arg, $reversed) = @_;
   return $self->binop('>', $arg, $reversed);
}

sub ge
{
   my ($self, $arg, $reversed) = @_;
   return $self->binop('>=', $arg, $reversed);
}

sub binop
{
   my ($self, $op, $arg, $reversed) = @_;

   my @objects = $self->objects;
   my $objects = Set::Object->new(@objects);

   if ($arg)
   {
	   if (my $type = ref($arg))
      {
         if ($arg->isa('Tangram::Expr'))
         {
            $objects->insert($arg->objects);
            $arg = $arg->{expr};
         }
   
         elsif ($arg->isa('Tangram::QueryObject'))
         {
            $objects->insert($arg->object);
            $arg = $arg->{id}->{expr};
         }
   
         elsif (exists $self->{storage}{schema}{classes}{$type})
         {
            $arg = $self->{storage}->id($arg) or Carp::confess "$arg is not persistent";
         }

		   else
		   {
			    $arg = $self->{type}->literal($arg);
		   }
      }
	   else
      {
          $arg = $self->{type}->literal($arg);
      }
   }
   else
   {
      $op = $op eq '=' ? 'IS' : $op eq '<>' ? 'IS NOT' : Carp::confess;
      $arg = 'NULL';
   }

   return new Tangram::Filter(expr => "$self->{expr} $op $arg", tight => 100,
      objects => $objects );
}

sub like
{
	my ($self, $val) = @_;
   return new Tangram::Filter(expr => "$self->{expr} like '$val'", tight => 100,
      objects => Set::Object->new($self->objects) );
}

sub count
{
	my ($self, $val) = @_;
   Tangram::Expr->new( "COUNT($self->{expr})", 'Tangram::Integer', $self->objects );
}

sub as_string
{
   my $self = shift;
   return ref($self) . "($self->{expr})";
}

use overload
   "==" => \&eq,
   "eq" => \&eq,
   "!=" => \&ne,
   "ne" => \&ne,
   "<" => \&lt,
   "lt" => \&lt,
   "<=" => \&le,
   "le" => \&le,
   ">" => \&gt,
   "gt" => \&gt,
   ">=" => \&ge,
   "ge" => \&ge,
   '""' => \&as_string,
	fallback => 1;

package Tangram::QueryObject;

use Carp;

sub new
{
   my ($pkg, $obj) = @_;
   bless $obj->expr_hash(), $pkg;
}

sub object
{
   shift->{object}
}

sub class
{
	shift->{object}{class}
}

sub eq
{
	my ($self, $other, $swapped) = @_;
	
	($self, $other) = ($other, $self) if $swapped;

	if ($other->isa('Tangram::QueryObject'))
	{
		$self->{id} == $other->{id}
	}
	else
	{
		my $other_id = $self->{object}{storage}->id($other)
			or confess "'$other' is not a persistent object";
		$self->{id} == $self->{object}{storage}->id($other)
	}
}

use overload "==" => \&eq, "!=" => \&ne, fallback => 1;

package Tangram::Select;

use Carp;

use base qw( Tangram::Expr );

sub new
{
   my ($type, %args) = @_;

   my $cols = join ', ', map
   {
      confess "column specification must be a Tangram::Expr" unless $_->isa('Tangram::Expr');
      $_->{expr};
   } @{$args{cols}};

   my $filter = exists $args{where} ? $args{where} : Tangram::Filter->new;
   
   my $from = $filter->from;
   my $where;

	my @objects;

	if (exists $args{from})
	{
		$from = join ', ', map { $_->object->from } @{ $args{from} };
	   $where = join ' AND ', $filter->{expr}, map { $_->object->where } @{ $args{from} };
	}
	else
	{
		@objects = exists $args{where} ? $filter->objects : (map { $_->objects } @{$args{cols}});
		$from = join ', ', map { $_->from } @objects;
		my @filter = "($filter->{expr})" if $filter->{expr};
	   $where = join ' AND ', @filter, map { $_->where } @objects;
	}

   my $sql = "SELECT $cols\nFROM $from";
   $sql .= "\nWHERE $where" if $where;

   if (exists $args{order})
   {
      $sql .= "\nORDER BY " . join ', ', map { $_->{expr} } @{$args{order}};
   }

   my $self = $type->SUPER::new("($sql)", 'Tangram::Integer', @objects);
	
	$self->{cols} = $args{cols};

	return $self;
}

sub from
{
	my ($self) = @_;
	my $from = $self->{from};
	return $from ? $from->members : $self->SUPER::from;
}

sub execute
{
   my ($self, $storage, $conn) = @_;
   return Tangram::DataCursor->open($storage, $self, $conn);
}

1;