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
    onUpdate
    onDelete
);

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,%args) = @_[0,3..$#_];
    
    $this->{foreignTable} = $foreignTable;
    $this->{foreignColumns} = $foreignColumns;
    
    $this->{onDelete} = $args{onDelete} if $args{onDelete};
    $this->{onUpdate} = $args{onUpdate} if $args{onUpdate};
}
 

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

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

use IMPL::Const qw(:prop);
use IMPL::declare {
    require => {
        Table => '-IMPL::SQL::Schema::Traits::Table',
        ArgException => '-IMPL::InvalidArgumentException',
        OpException => '-IMPL::InvalidOperationException'
    },
    base => [
        '-IMPL::SQL::Schema::Traits' => undef
    ],
    props => [
        table => PROP_RO,
    ]
};
use IMPL::lang;

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

sub CanApply {
    my ($this,$schema) = @_;
    
    return( $schema->GetTable( $this->table->{name} ) ? 0 : 1 );
}

sub Apply {
    my ($this,$schema) = @_;
    
    my $args = {%{$this->table}};
    
    my $constraints = delete $args->{constraints} || [];
    
    my $table = $schema->AddTable($args);
    
    $table->AddConstraint($_->constraintClass, $_) foreach @{$constraints};
}

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

package IMPL::SQL::Schema::Traits::DropTable;
use IMPL::Const qw(:prop);
use IMPL::declare {
    require => {
        ArgException => '-IMPL::InvalidArgumentException'
    },
    base => [
        '-IMPL::SQL::Schema::Traits' => undef
    ],
    props => [
        tableName => PROP_RO,
    ]
};

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

sub CanApply {
    my ($this,$schema) = @_;
    
    return $schema->GetTable( $this->tableName ) ? 1 : 0;
}

sub Apply {
    my ($this,$schema) = @_;
    
    $schema->RemoveTable($this->tableName);
}

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

package IMPL::SQL::Schema::Traits::RenameTable;
use IMPL::Const qw(:prop);
use IMPL::declare {
    require => {
        ArgException => '-IMPL::InvalidArgumentException'
    },
    base => [
        '-IMPL::SQL::Schema::Traits' => undef
    ],
    props => [
        tableName => PROP_RO,
        tableNewName => PROP_RO,
    ]
};

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

sub CanApply {
    my ($this, $schema) = @_;
    
    return ($schema->GetTable($this->tableName) and not $schema->GetTable($this->tableNewName) ? 1 : 0 );
}

sub Apply {
    my ($this,$schema) = @_;
    
    $schema->RenameTable($this->tableName, $this->tableNewName);
    
}

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

package IMPL::SQL::Schema::Traits::AlterTableAddColumn;

use IMPL::Const qw(:prop);
use IMPL::declare {
    require => {
        Column => '-IMPL::SQL::Schema::Traits::Column',
        ArgException => '-IMPL::InvalidArgumentException',
        OpException => '-IMPL::InvalidOperationException'
    },
    base => [
        '-IMPL::SQL::Schema::Traits' => undef
    ],
    props => [
        tableName => PROP_RO,
        column => PROP_RO,
        position => PROP_RO
    ]
};
use IMPL::lang;


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

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

sub Apply {
    my ($this,$schema) = @_;
    
    my $table = $schema->GetTable($this->tableName)
        or die OpException->new("The specified table doesn't exists", $this->tableName);
    
    if ($this->position) {
        $table->AddColumn($this->column);
    } else {
        $table->InsertColumn($this->column,$this->position);
    }
}

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

package IMPL::SQL::Schema::Traits::AlterTableDropColumn;

use IMPL::Const qw(:prop);
use IMPL::declare {
    require => {
        FK => '-IMPL::SQL::Schema::Constraint::ForeignKey',
        ArgException => '-IMPL::InvalidArgumentException',
        OpException => '-IMPL::InvalidOperationException'
    },
    base => [
        '-IMPL::SQL::Schema::Traits' => undef
    ],
    props => [
        tableName => PROP_RO,
        columnName => PROP_RO,
    ]
};
use IMPL::lang;


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

sub CanApply {
    my ($this,$schema) = @_;
    
    my $table = $schema->GetTable($this->tableName)
        or return 0;
    
    $table->GetColumn($this->columnName) or
        return 0;
    
    # столбец 
    return $table->GetColumnConstraints($this->columnName)
        ? 0
        : 1
    ;
}

sub Apply {
    my ($this,$schema) = @_;
    
    my $table = $schema->GetTable($this->tableName)
        or die OpException->new("The specified table doesn't exists", $this->tableName);
    
    $table->RemoveColumn($this->columnName);        
}

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

package IMPL::SQL::Schema::Traits::AlterTableChangeColumn;

use IMPL::Const qw(:prop);
use IMPL::declare {
    require => {
        Constraint => '-IMPL::SQL::Schema::Traits::Constraint',
        ArgException => '-IMPL::InvalidArgumentException',
        OpException => '-IMPL::InvalidOperationException'
    },
    base => [
        '-IMPL::SQL::Schema::Traits' => undef
    ],
    props => [
        tableName => PROP_RO,
        columnName => PROP_RO,
        columnType => PROP_RW,
        defaultValue => PROP_RW,
        isNullable => PROP_RW,
        position => PROP_RW,
        options => PROP_RW # hash diff format, (keys have a prefix '+' - add or update value, '-' remove value)
    ]
};
use IMPL::lang;

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

sub CanApply {
    my ($this,$schema) = @_;
    
    my $table = $schema->GetTable($this->tableName)
        or return 0;
    
    return $table->GetColumn($this->columnName) ? 1 : 0;
}

sub Apply {
    my ($this,$schema) = @_;
    
    my $table = $schema->GetTable($this->tableName)
        or die OpException->new("The specified table doesn't exists", $this->tableName);
    
    my $column = $table->GetColumn($this->columnName)
        or die OpException->new("The specified column doesn't exists", $this->tableName, $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;
    
    $table->SetColumnPosition($this->position)
        if ($this->position);

}

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

package IMPL::SQL::Schema::Traits::AlterTableAddConstraint;

use IMPL::Const qw(:prop);
use IMPL::declare {
    require => {
        Constraint => '-IMPL::SQL::Schema::Traits::Constraint',
        ArgException => '-IMPL::InvalidArgumentException',
        FK => '-IMPL::SQL::Schema::Traits::ForeignKey'
    },
    base => [
        '-IMPL::SQL::Schema::Traits' => undef
    ],
    props => [
        tableName => PROP_RO,
        constraint => PROP_RO
    ]
};
use IMPL::lang;

sub CTOR {
    my ($this,$table,$constraint) = @_;
    
    $this->tableName($table) or die ArgException->new( tableName => "A table name is required");
    
    die ArgException->new(constaraint => "A valid " . Constraint . " is required")
        unless is($constraint, Constraint);
        
    $this->constraint($constraint);
}

sub CanApply {
    my ($this, $schema) = @_;
    
    my $table = $schema->GetTable($this->tableName)
        or return 0;
        
    my $constraint = $this->constraint;
    
    my @columns = map $table->GetColumn($_), @{$constraint->{columns} || []};

    # проверяем, что в таблице есть все столбцы для создания ограничения
    return 0 if grep not($_), @columns;
    
    if (is($constraint,FK)) {
        my $foreignTable = $schema->GetTable($constraint->{foreignTable})
            or return 0;

        my @foreignColumns = map $foreignTable->GetColumn($_), @{$constraint->{foreignColumns}||[]};
        
        # внешняя таблица имеет нужные столбцы
        return 0
            if grep not($_), @foreignColumns;

        # типы столбцов во внешней таблице совпадают с типами столбцов ограничения
        return 0
            if grep not($columns[$_]->type->SameValue($foreignColumns[$_]->type)), (0 .. $#columns);
    }
    
    return 1;
}

sub Apply {
    my ($this,$schema) = @_;
    
    my $table = $schema->GetTable($this->tableName)
        or die IMPL::InvalidOperationException->new("The specified table doesn't exists", $this->tableName);
        
    my $constraint = $this->constraint;
    
    if (is($constraint,FK)) {
        my $args = { %$constraint };
        $args->{referencedTable} = $schema->GetTable(delete $args->{foreignTable});
        $args->{referencedColumns} = delete $args->{foreignColumns};
        $table->AddConstraint($constraint->constraintClass, $args);
    } else {
        $table->AddConstraint($constraint->constraintClass, $constraint);
    }
    
}

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

package IMPL::SQL::Schema::Traits::AlterTableDropConstraint;
use IMPL::Const qw(:prop);
use IMPL::declare {
    require => {
        PK => '-IMPL::SQL::Schema::Constraint::PrimaryKey'        
    },
    base => [
        '-IMPL::SQL::Schema::Traits' => undef
    ],
    props => [
        tableName => PROP_RO,
        constraintName => PROP_RO
    ]
};
use IMPL::lang qw(is);

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 CanApply {
    my ($this,$schema) = @_;
    
    my $table = $schema->GetTable($this->tableName)
        or return 0;
    
    my $constraint = $table->GetConstraint($this->constraintName)
        or return 0;
    
    # есть ли внешние ключи на данную таблицу    
    return (
        is($constraint,PK)
        && values( %{$constraint->connectedFK || {}} )
        ? 0
        : 1
    );
}

sub Apply {
    my ($this,$schema) = @_;
    
    my $table = $schema->GetTable($this->tableName)
        or die IMPL::InvalidOperationException->new("The specified table doesn't exists", $this->tableName);
    
    $table->RemoveConstraint($this->constraintName);
}


1;

__END__

=pod

=head1 NAME

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

=head1 DESCRIPTION

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

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

=head1 OPERATIONS

=head2 General

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

=head3 C<CanApply($schema)>

Определяет возможность применения операции к указанной схеме.

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

=over

=item C<true>

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

=item C<false>

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

=back

=head3 C<Apply($schema)>

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

=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