--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/IMPL/SQL/Schema/Traits.pm	Fri Sep 04 19:40:23 2015 +0300
@@ -0,0 +1,742 @@
+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