package Xmldoom::Definition::Property::Object;
use base qw(Xmldoom::Definition::Property);

use DBIx::Romani::Query::Variable;
use DBIx::Romani::Query::SQL::Column;
use Module::Runtime qw(use_module);
use Scalar::Util qw(weaken isweak);
use Exception::Class::TryCatch;
use strict;

use Data::Dumper;

sub new
{
	my $class = shift;
	my $args  = shift;

	my $parent;
	my $prop_name;
	my $object_name;
	my $set_name;
	my $get_name;
	my $options_prop;
	my $options_criteria;
	my $options_dependent;
	my $inclusive;
	my $inter_table;
	my $key_attributes;

	if ( ref($args) eq 'HASH' )
	{
		$parent            = $args->{parent};
		$prop_name         = $args->{name};
		$object_name       = $args->{object_name};
		$set_name          = $args->{set_name};
		$get_name          = $args->{get_name};
		$options_prop      = $args->{options_property};
		$options_criteria  = $args->{options_criteria};
		$options_dependent = $args->{options_dependent};
		$inclusive         = $args->{inclusive};
		$inter_table       = $args->{inter_table};
		$key_attributes    = $args->{key_attributes};
	}
	else
	{
		$parent      = $args;
		$prop_name   = shift;
		$object_name = shift;

		$args = {
			parent => $parent,
			name   => $prop_name,
		};
	}

	# create ourself
	my $self = $class->SUPER::new( $args );

	#
	# Find our link to the object
	#

	my $links = $parent->find_links( $object_name );
	my $link;

	if ( scalar @$links == 0 )
	{
		die $self->{name} . ": There is no link between " . $parent->get_name() . " and " . $object_name . ".  Did you forget to setup a foreign-key?";
	}
	elsif ( scalar @$links > 1 )
	{
		if ( not defined $key_attributes and not defined $inter_table )
		{
			die $self->{name} . ": It is ambiguous which connection to the foreign object is intended in this property.  You must specify a <key/> section to your <object/> property.";
		}
		else
		{
			foreach my $possible ( @$links )
			{
				if ( defined $key_attributes and $possible->is_start_column_names( $key_attributes ) or
				     defined $inter_table    and $possible->get_start()->get_reference_table_name() )
				{
					$link = $possible;
					last;
				}
			}

			if ( not $link )
			{
				die "It is ambiguous which connection to the foreign object is intended in this property.  The <key/> section or inter_table='...' of this <object/> property is insufficient to disambiguate.";
			}
		}
	}
	else
	{
		if ( defined $key_attributes )
		{
			print STDERR "WARNING: Specifying a key attributes for this object property when it is not ambiguous!\n";
		}

		$link = $links->[0];
	}
	
	if ( defined $inter_table and $link->get_relationship() ne 'many-to-many' )
	{
		die "You set inter_table='...' on this property but it isn't a many-to-many relationship";
	}

	# we need to know how this object relates the other
	my $rel_string;
	if ( defined $link )
	{
		$rel_string = $link->get_relationship();
	}
	else
	{
		# TODO: a hack for inter-table what not
		$rel_string = "many-to-many";
	}

	# get the component parts
	my @rel_parts;
	@rel_parts = split /-/, $rel_string;
	@rel_parts = ( $rel_parts[0], $rel_parts[2] );

	# conditionally prepare autoload names based on property type
	my $prop_type;
	if ( $rel_parts[1] eq 'one' )
	{
		$set_name  = "set_$prop_name" if not defined $set_name;
		$get_name  = "get_$prop_name" if not defined $get_name;
		$prop_type = "inherent";
	}
	elsif ( $rel_parts[1] eq 'many' )
	{
		$set_name  = "add_$prop_name"    if not defined $set_name;
		$get_name  = "get_${prop_name}s" if not defined $get_name;
		$prop_type = "external";
	}

	# store all of our infos
	$self->{object_name}       = $object_name;
	$self->{options_prop}      = $options_prop;
	$self->{options_criteria}  = $options_criteria;
	$self->{options_dependent} = $options_dependent;
	$self->{inclusive}         = $inclusive || 0;
	$self->{inter_table}       = $inter_table;
	$self->{link}              = $link;
	$self->{prop_type}         = $prop_type;
	$self->{set_name}          = $set_name;
	$self->{get_name}          = $get_name;
	$self->{relationship}      = \@rel_parts;

	bless  $self, $class;
	return $self;
}

sub get_type        { return shift->{prop_type}; }
sub get_object_name { return shift->{object_name}; }
sub get_link        { return shift->{link}; }

sub get_autoload_get_list
{
	return [ shift->{get_name} ];
}

sub get_autoload_set_list
{
	return [ shift->{set_name} ];
}

sub get_object_definition
{
	my $self = shift;

	return $self->get_parent()->get_database()->get_object( $self->{object_name} );
}

sub get_object_class
{
	my $self = shift;

	my $class = $self->get_object_definition()->get_class();

	if ( not defined $class )
	{
		die "The object '$self->{object_name}' isn't attached to a Perl class.  Maybe you forgot to 'use' its module?";
	}

	use_module($class);

	return $class;
}

sub get_data_type
{
	my $self = shift;
	my $args = shift;

	my $object;
	my $include_options;

	if ( ref($args) eq 'HASH' )
	{
		$object          = $args->{object};
		$include_options = $args->{include_options};
	}

	my $value = {
		type        => 'object',
		object_name => $self->{object_name},
	};

	# get the selectable options, baby.
	if ( $self->{inclusive} and defined $self->{options_prop} and $include_options )
	{
		$value->{options} = $self->get_options($object);
	}

	return $value;
}

sub get_options
{
	my $self = shift;
	my $object = shift;

	my @options;
	
	if ( defined $self->{options_prop} )
	{
		my $criteria;
		my $parent;

		# use this object as the parent, if the options are dependent on it.
		if ( $self->{options_dependent} )
		{
			$parent = $object;
		}

		# use the options criteria if specified
		if ( defined $self->{options_criteria} )
		{
			$criteria = $self->{options_criteria}->clone( $parent );
		}
		else
		{
			$criteria = Xmldoom::Criteria->new( $parent );
		}

		my $class = $self->get_object_class();

		my $rs = $class->SearchRS( $criteria );
		while ( $rs->next() )
		{
			my $obj  = $rs->get_object();

			push @options, {
				value       => $obj->_get_key(),
				description => $obj->_get_property_value( $self->{options_prop} )
			};
		}
	}

	return \@options;
}

sub get
{
	my ($self, $object, $args, $object_data) = (shift, shift, shift, shift);

	my $database = $self->get_parent()->get_database();
	my $class    = $self->get_object_class();

	if ( $self->get_type() eq 'inherent' )
	{
		if ( defined $object_data->{unsaved_object} and $object_data->{unsaved_object}->{new} )
		{
			return $object_data->{unsaved_object};
		}
		else
		{
			# clear the unsaved object, if it actually exists
			if ( defined $object_data->{unsaved_object} )
			{
				$object_data->{unsaved_object} = undef;
			}
			
			# simply load the data
			my $object_key = { };
			foreach my $conn ( @{$self->{link}->get_column_names()} )
			{
				$object_key->{$conn->{foreign_column}} = $object->_get_attr($conn->{local_column});
			}

			my $data;
			try eval
			{
				$data = $self->get_object_definition()->load( $object_key );
			};
			if ( my $err = catch )
			{
				return undef;
			}

			# return the appropriate object
			return $class->new(undef, {
				data        => $data,
				parent      => $object,
				parent_link => $self->{link}
			});
		}
	}
	elsif ( $self->get_type() eq 'external' )
	{
		my @ret;

		if ( defined $object_data )
		{
			# check the list for undef objects (because they are weak references)
			# and objects that have been saved.
			foreach my $unsaved ( @{$object_data->{unsaved_list}} )
			{
				if ( defined $unsaved and $unsaved->{new} )
				{
					push @ret, $unsaved;
				}
			}
			if ( scalar @{$object_data->{unsaved_list}} != scalar @ret )
			{
				# copy into unsaved if there were any changes
				$object_data->{unsaved_list} = [ @ret ];
			}
		}

		if ( not $object->{new} )
		{
			my $criteria = Xmldoom::Criteria->new( $object );

			# pass any arguments as property equations on the criteria.
			if ( $self->{relationship}->[1] eq 'many' )
			{
				if ( ref($args) eq 'HASH' )
				{
					while( my ($key, $val) = each %$args )
					{
						my $prop = sprintf "%s/%s", $self->{object_name}, $key;
						$criteria->add( $prop, $val );
					}
				}
			}

			# if this is many-to-many, then we manually join the tables because
			# we want to make sure the selected connection is used.
			if ( $self->{link}->get_relationship() eq 'many-to-many' )
			{
				foreach my $fn ( @{$self->{link}->get_foreign_keys()} )
				{
					foreach my $ref ( @{$fn->get_column_names()} )
					{
						$criteria->join_attr(
							sprintf( "%s/%s", $ref->{local_table}, $ref->{local_column} ),
							sprintf( "%s/%s", $ref->{foreign_table}, $ref->{foreign_column} )
						);
					}
				}
			}

			# execute
			@ret = $class->Search( $criteria );
		}

		return wantarray ? @ret : \@ret;
	}
}

sub get_value_description
{
	my ($self, $value) = @_;

	my $prop = $value->_get_property( $self->{options_prop} );

	return $prop->get();
}

sub set
{
	my ($self, $object, $args, $object_data) = @_;

	if ( $self->get_type() eq 'inherent' )
	{
		# we are simply setting a value
		my $value = $args;

		# link the attributes of the value to ours
		foreach my $conn ( @{$self->{link}->get_column_names()} )
		{
			$object->_link_attr( $conn->{local_column}, $value, $conn->{foreign_column} );
		}

		# this object will be saved in the same transaction as us so that no
		# changes are lost.
		$object->_add_dependent( $value );

		# if this value is unsaved, we need to hang onto it
		if ( $value->{new} )
		{
			$object_data->{unsaved_object} = $value;
			weaken $object_data->{unsaved_object};
		}
	}
	elsif ( $self->get_type() eq 'external' )
	{
		# Here we accept an array of hashs (or a single hash), to "add", creating
		# and returning new objects for each.

		if ( ref($args) ne 'ARRAY' )
		{
			$args = [ $args ];
		}

		my $database = $self->get_parent()->get_database();
		my $class    = $self->get_object_class();
		my @ret;

		# create new objects
		foreach my $props ( @$args )
		{
			push @ret, $class->new($props, { parent => $object });
		}

		# create the unsaved objects list
		if ( not defined $object_data->{unsaved_list} )
		{
			$object_data->{unsaved_list} = [ ];
		}

		# add weak references to these new objects in the unsaved objects list
		foreach my $child ( @ret )
		{
			push @{$object_data->{unsaved_list}}, $child;
			weaken $object_data->{unsaved_list}->[-1];
		}

		if ( scalar @$args == 1 )
		{
			return $ret[0];
		}

		return wantarray ? @ret : \@ret;
	}
}

sub get_query_lval
{
	my $self = shift;

	my @ret;
	foreach my $conn ( @{$self->{link}->get_start()->get_column_names()} )
	{
		push @ret, DBIx::Romani::Query::SQL::Column->new( $conn->{local_table}, $conn->{local_column} );
	}

	return \@ret;
}

sub get_query_rval
{
	my ($self, $value) = @_;

	my @ret;
	foreach my $conn ( @{$self->{link}->get_start()->get_column_names()} )
	{
		push @ret, DBIx::Romani::Query::SQL::Literal->new( $value->_get_attr($conn->{foreign_column}) );
	}

	return \@ret;
}

sub autoload
{
	my ($self, $object, $func_name) = (shift, shift, shift);

	if ( $func_name eq $self->{set_name} )
	{
		$self->set($object, @_);
	}
	elsif ( $func_name eq $self->{get_name} )
	{
		return $self->get($object, @_);
	}
	else
	{
		die "$func_name is not defined by this property";
	}
}

1;