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

use parent qw(IMPL::Object);

# 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;
    public property position => 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 position => 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;
    
    $this->tableName($table);
    $this->constraintName($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 OPERATIONS

=head2 General

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

=head3 C<apply($schema)>

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

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

=over

=item C<true>

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

=item C<false>

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

=back

=head2 Primitive operations

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

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

=head4 C<CTOR($table)>

=head4 C<[get]table>

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

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

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

=head4 C<CTOR($tableName)>

=head4 C<[get]tableName>

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

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

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

=head4 C<[get]tableName>

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

=head4 C<[get]tableNewName>

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

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

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

=head4 C<CTOR($tableName,$column,$position)>

=head4 C<[get]tableName>

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

=head4 C<[get]column>

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

=head4 C<[get]position>

Позиция на которую нужно вставить столбец

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

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

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

=head4 C<[get]tableName>

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

=head4 C<[get]columnName>

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

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

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

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

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

=head4 C<[get]tableName>

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

=head4 C<[get]columnName>

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

=head4 C<[get]columnType>

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

=head4 C<[get]defaultValue>

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

=head4 C<[get]isNullable>

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

=head4 C<[get]options>

Хеш опций, не задан, если опции не меняются. Данный хеш содержит разничу между
старыми и новыми значениями свойства C<tag> столбца.


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

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

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

=head4 C<[get]tableName>

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

=head4 C<[get]constraint>

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

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

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

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

=head4 C<[get]tableName>

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

=head4 C<[get]constraintName>

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

=cut