package IMPL::SQL::Schema::Traits;
use strict;
use IMPL::_core::version;
use IMPL::Exception();

use parent qw(IMPL::Object);
use IMPL::Code::Loader();

# required for use with typeof operator
use IMPL::SQL::Schema::Constraint::PrimaryKey();
use IMPL::SQL::Schema::Constraint::Index();
use IMPL::SQL::Schema::Constraint::Unique();
use IMPL::SQL::Schema::Constraint::ForeignKey();

###################################################

package IMPL::SQL::Schema::Traits::Table;
use base qw(IMPL::Object::Fields);

use fields qw(
	name
	columns
	constraints
	options
);

sub CTOR {
	my ($this,$table,$columns,$constraints,$options) = @_;
	
	$this->{name} = $table or die new IMPL::InvalidArgumentException(table => "A table name is required");
	$this->{columns} = $columns if defined $columns;
	$this->{constraints} = $constraints if defined $constraints;
	$this->{options} = $options if defined $options;
}

###################################################

package IMPL::SQL::Schema::Traits::Column;
use base qw(IMPL::Object::Fields);

use fields qw(
	name
	type
	isNullable
	defaultValue
	tag
);

sub CTOR {
	my ($this, $name, $type, %args) = @_;
	
	$this->{name} = $name or die new IMPL::InvalidArgumentException("name");
	$this->{type} = $type or die new IMPL::InvalidArgumentException("type");
	$this->{isNullable} = $args{isNullable} if exists $args{isNullable};
	$this->{defaultValue} = $args{defaultValue} if exists $args{defaultValue};
	$this->{tag} = $args{tag} if exists $args{tag};
}

##################################################

package IMPL::SQL::Schema::Traits::Constraint;
use base qw(IMPL::Object::Fields);
 
use fields qw(
	name
	columns
);

sub CTOR {
	my ($this, $name, $columns) = @_;
	
	$this->{name} = $name;
	$this->{columns} = $columns; # list of columnNames
}

sub constraintClass  {
	die new IMPL::NotImplementedException();
}

##################################################

package IMPL::SQL::Schema::Traits::PrimaryKey;

use base qw(IMPL::SQL::Schema::Traits::Constraint);

__PACKAGE__->PassThroughArgs;

use constant { constraintClass => typeof IMPL::SQL::Schema::Constraint::PrimaryKey };

##################################################

package IMPL::SQL::Schema::Traits::Index;

use base qw(IMPL::SQL::Schema::Traits::Constraint);

__PACKAGE__->PassThroughArgs;

use constant { constraintClass => typeof IMPL::SQL::Schema::Constraint::Index };

##################################################

package IMPL::SQL::Schema::Traits::Unique;

use base qw(IMPL::SQL::Schema::Traits::Constraint);

__PACKAGE__->PassThroughArgs;

use constant { constraintClass => typeof IMPL::SQL::Schema::Constraint::Unique };

##################################################

package IMPL::SQL::Schema::Traits::ForeignKey;

use base qw(IMPL::SQL::Schema::Traits::Constraint);
use fields qw(
	foreignTable
	foreignColumns
);

use constant { constraintClass => typeof IMPL::SQL::Schema::Constraint::ForeignKey };

our %CTOR = (
	'IMPL::SQL::Schema::Traits::Constraint' => sub { @_[0..1] }
);

sub CTOR {
	my ($this,$foreignTable,$foreignColumns) = @_[0,3,4];
	
	$this->{foreignTable} = $foreignTable;
	$this->{foreignColunms} = $foreignColumns;
}
 

##################################################

package IMPL::SQL::Schema::Traits::CreateTable;

use parent qw(-norequire IMPL::SQL::Schema::Traits);
use IMPL::Class::Property;
use IMPL::lang;

BEGIN {
	public property table => prop_get | owner_set;
}

sub CTOR {
	my ($this,$table) = @_;
	
	die new IMPL::InvalidArgumentException("table", "An object of IMPL::SQL::Schema::Traits::Table type is required")
		unless is $table, typeof IMPL::SQL::Schema::Traits::Table;
	
	$this->table($table);
}

sub apply {
	my ($this,$schema) = @_;
	
	return 0 if ( $schema->GetTable( $this->table->{name} ) );
	
	$schema->AddTable($this->table);
	return 1;
}

##################################################

package IMPL::SQL::Schema::Traits::DropTable;
use parent qw(-norequire IMPL::SQL::Schema::Traits);
use IMPL::Class::Property;

BEGIN {
	public property tableName => prop_get | owner_set;
}

sub CTOR {
	my ($this,$tableName) = @_;
	
	$this->tableName($tableName) or die new IMPL::InvalidArgumentException("tableName is required");
}

sub apply {
	my ($this,$schema) = @_;
	
	return 0 if $schema->GetTable( $this->tableName );
	
	$schema->RemoveTable($this->tableName);
	
	return 1;
}

##################################################

package IMPL::SQL::Schema::Traits::RenameTable;
use parent qw(-norequire IMPL::SQL::Schema::Traits);
use IMPL::Class::Property;

BEGIN {
	public property tableName => prop_get | owner_set;
	public property tableNewName => prop_get | owner_set;
}

sub CTOR {
	my ($this, $oldName, $newName) = @_;
	
	$this->tableName($oldName) or die new IMPL::InvalidArgumentException("A table name is required");
	$this->tableNewName($newName) or die new  IMPL::InvalidArgumentException("A new table name is required");
}

sub apply {
	my ($this,$schema) = @_;
	
	return 0 if not $schema->GetTable($this->tableName) or $schema->GetTable($this->tableNewName);
	
	$this->RenameTable($this->tableName, $this->tableNewName);
	
	return 1;
}

#################################################

package IMPL::SQL::Schema::Traits::AlterTableAddColumn;
use parent qw(-norequire IMPL::SQL::Schema::Traits);
use IMPL::Class::Property;
use IMPL::lang;

BEGIN {
	public property tableName => prop_get | owner_set;
	public property column => prop_get | owner_set;
}

sub CTOR {
	my ($this,$tableName,$column) = @_;
	
	$this->tableName($tableName) or die new IMPL::InvalidArgumentException("A table name is required");
	
	die new IMPL::InvalidArgumentException("A column should be a IMPL::SQL::Schema::Traits::Column object")
		unless is $column, typeof IMPL::SQL::Schema::Traits::Column;
		
	$this->column($column);
}

sub apply {
	my ($this,$schema) = @_;
	
	my $table = $schema->GetTable($this->tableName) or return 0;
	
	return 0 if $table->GetColumn( $this->column->{name} );
	
	$table->AddColumn($this->column);
	
	return 1;
}

#################################################

package IMPL::SQL::Schema::Traits::AlterTableDropColumn;
use parent qw(-norequire IMPL::SQL::Schema::Traits);
use IMPL::Class::Property;

BEGIN {
	public property tableName => prop_get | owner_set;
	public property columnName => prop_get | owner_set;
}

sub CTOR { 
	my ($this,$table,$column) = @_;
	
	$this->tableName($table) or die new IMPL::InvalidArgumentException(tableName => "A table name should be specified");
	$this->columnName($column) or die new IMPL::InvalidArgumentException(columnName => "A column name should be specified");
}

sub apply {
	my ($this,$schema) = @_;
	
	local $@;
	
	return eval {
		$schema->GetTable($this->tableName)->RemoveColumn($this->columnName);
		return 1;
	} || 0;
}

#################################################

package IMPL::SQL::Schema::Traits::AlterTableChangeColumn;
use parent qw(-norequire IMPL::SQL::Schema::Traits);
use IMPL::Class::Property;

BEGIN {
	public property tableName => prop_get | owner_set;
	public property columnName => prop_get | owner_set;
	public property columnType => prop_all;
	public property defaultValue => prop_all;
	public property isNullable => prop_all;
	public property options => prop_all; # hash diff format, (keys have a prefix '+' - add or update value, '-' remove value)
}

sub CTOR {
	my ($this, $table,$column,%args) = @_;
	
	$this->tableName($table) or die new IMPL::InvalidArgumentException(tableName => "A table name is required");
	$this->columnName($column) or die new IMPL::InvalidArgumentException(columnName => "A column name is required");
	
	$this->$_($args{$_})
		for (grep exists $args{$_}, qw(columnType defaultValue isNullable options));
}

sub apply {
	my ($this,$schema) = @_;
	
	local $@;
	
	return eval {
		my $column = $schema->GetTable($this->tableName)->GetColumn($this->columnName);
		$column->SetType($this->columnType) if defined $this->columnType;
		$column->SetNullable($this->isNullable) if defined $this->isNullable;
		$column->SetDefaultValue($this->defaultValue) if defined $this->defaultValue;
		$column->SetOptions($this->options) if defined $this->options;
		
		return 1;
	} || 0;
}

#################################################

package IMPL::SQL::Schema::Traits::AlterTableAddConstraint;
use parent qw(-norequire IMPL::SQL::Schema::Traits);
use IMPL::Class::Property;
use IMPL::lang;

BEGIN {
	public property tableName => prop_get | owner_set;
	public property constraint => prop_get | owner_set;
}

sub CTOR {
	my ($this,$table,$constraint) = @_;
	
	$this->tableName($table) or die new IMPL::InvalidArgumentException( tableName => "A table name is required");
	
	die new IMPL::InvalidArgumentException(constaraint => "A valid IMPL::SQL::Schema::Traits::Constarint is required")
		unless is $constraint, typeof IMPL::SQL::Schema::Traits::Constraint;
		
	$this->constraint($constraint);
}

sub apply {
	my ($this,$schema) = @_;
	
	local $@;
	
	return eval {
		$schema->GetTable($this->tableName)->AddConstraint($this->constraint->constraintClass, $this->constraint);
		return 1;
	} || 0;
	
}

#################################################

package IMPL::SQL::Schema::Traits::AlterTableDropConstraint;
use parent qw(-norequire IMPL::SQL::Schema::Traits);
use IMPL::Class::Property;

BEGIN {
	public property tableName => prop_get | owner_set;
	public property constraintName => prop_get | owner_set;
}

sub CTOR {
	my ($this,$table,$constraint) = @_;
	
	die new IMPL::InvalidArgumentException( tableName => "A table name is required" ) unless $table;
	die new IMPL::InvalidArgumentException( constraintName => "A constraint name is required" ) unless $constraint;
}

sub apply {
	my ($this,$schema) = @_;
	
	my $table = $schema->GetTable($this->tableName) or return 0;
	
	return 0 unless $table->GetConstraint($this->constraintName);
	
	$table->RemoveConstraint($this->constraintName);
	return 1;
}


1;

__END__

=pod

=head1 NAME

C<IMPL::SQL::Traits> - Операции над объектками SQL схемы.

=head1 DESCRIPTION

Изменения схемы могу быть представлены в виде последовательности примитивных операций.
Правила выполнения последовательности примитывных действий могут варьироваться
в зависимости от процессора, который их выполняет. Например C<IMPL::SQL::Schema::Traits::Processor>.

Данные, которые содержаться в примитивных операциях не могут существовать независимо от схемы.

=head1 OPEARATIONS

=head2 General

Методы обще для всех примитивных операций.

=over

=item C<apply($schema)>

Пытается приминить операцию к указанной схеме.

Возвращаемое значение:

=over

=item C<true>

Операция успешно применена к схеме.

=item C<false>

Операция не может быть применена к схеме.

=back

=back

=head2 Primitive operations

=over

=item C<IMPL::SQL::Schema::Traits::CreateTable>

Создает таблицу

=over

=item C<CTOR($table)>

=item C<[get]table>

C<IMPL::SQL::Schema::Traits::Table> - описание создаваемой таблицы

=back

=item C<IMPL::SQL::Schema::Traits::DropTable>

Удалает таблицу по имени

=over

=item C<CTOR($tableName)>

=item C<[get]tableName>

Имя удаляемой таблицы

=back

=item C<IMPL::SQL::Schema::Traits::RenameTable>

=over

=item C<CTOR($tableName,$tableNewName)>

=item C<[get]tableName>

Имя таблицы, которую требуется переименовать

=item C<[get]tableNewName>

Новое имя таблицы

=back

=item C<IMPL::SQL::Schema::Traits::AlterTableAddColumn>

Добавляет столбец в таблицу

=over

=item C<CTOR($tableName,$column)>

=item C<[get]tableName>

Имя таблицы в которую нужно добавить столбец

=item C<[get]column>

C<IMPL::SQL::Schema::Traits::Column> - описание столбца который нужно добавить 

=back

=item C<IMPL::SQL::Schema::Traits::AlterTableDropColumn>

Удаляет столбец из таблицы

=over

=item C<CTOR($tableName,$columnName)>

=item C<[get]tableName>

Имя таблицы в которой нужно удалить столбец

=item C<[get]columnName>

Имя столбца для удаления

=back

=item C<IMPL::SQL::Schema::Traits::AlterTableChangeColumn>

Меняет описание столбца

=over

=item C<CTOR($tableName,$columnName,%args)>

C<%args> - хеш, ключами которого являются оставшиеся свойства создаваемого объекта.

=item C<[get]tableName>

Имя таблицы в которой находится столбец.

=item C<[get]columnName>

Имя столбца для изменения

=item C<[get]columnType>

Новый тип столбца. Не задан, если тип не меняется

=item C<[get]defaultValue>

Значение по умолчанию. Не задано, если не меняется

=item C<[get]isNullable>

Может ли столбец содержать C<NULL>. Не задано, если не меняется.

=item C<[get]options>

Хеш опций, не задан, если опции не меняются

=back

=item C<IMPL::SQL::Schema::Traits::AlterTableAddConstraint>

Базовый класс для операций по добавлению ограничений

=over

=item C<CTOR($tableName,$constraint)>

=item C<[get]tableName>

Имя таблицы в которую добавляется ограничение.

=item C<[get]constraint>

C<IMPL::SQL::Schema::Traits::Constraint> - описние ограничения, которое нужно добавить.

=back

=item C<IMPL::SQL::Schema::Traits::AlterTableDropConstraint>

Удаляет ограничение на таблицу

=over

=item C<CTOR($tableName,$constraintName)>

=item C<[get]tableName>

Имя таблицы в которой требуется удалить ограничение.

=item C<[get]constraintName>

Имя ограничения для удаления.

=back

=back

=cut