--- a/Lib/IMPL/SQL/Schema/Traits.pm	Fri Jan 25 00:25:02 2013 +0400
+++ b/Lib/IMPL/SQL/Schema/Traits.pm	Mon Jan 28 02:43:14 2013 +0400
@@ -114,6 +114,8 @@
 use fields qw(
     foreignTable
     foreignColumns
+    onUpdate
+    onDelete
 );
 
 use constant { constraintClass => typeof IMPL::SQL::Schema::Constraint::ForeignKey };
@@ -123,10 +125,13 @@
 );
 
 sub CTOR {
-    my ($this,$foreignTable,$foreignColumns) = @_[0,3,4];
+    my ($this,$foreignTable,$foreignColumns,%args) = @_[0,3..$#_];
     
     $this->{foreignTable} = $foreignTable;
-    $this->{foreignColunms} = $foreignColumns;
+    $this->{foreignColumns} = $foreignColumns;
+    
+    $this->{onDelete} = $args{onDelete} if $args{onDelete};
+    $this->{onUpdate} = $args{onUpdate} if $args{onUpdate};
 }
  
 
@@ -134,238 +139,398 @@
 
 package IMPL::SQL::Schema::Traits::CreateTable;
 
-use parent qw(-norequire IMPL::SQL::Schema::Traits);
-use IMPL::Class::Property;
+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;
 
-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;
+    die ArgException->new("table", "An object of IMPL::SQL::Schema::Traits::Table type is required")
+        unless is($table, Table);
     
     $this->table($table);
 }
 
-sub apply {
+sub CanApply {
     my ($this,$schema) = @_;
     
-    return 0 if ( $schema->GetTable( $this->table->{name} ) );
+    return( $schema->GetTable( $this->table->{name} ) ? 0 : 1 );
+}
+
+sub Apply {
+    my ($this,$schema) = @_;
     
-    $schema->AddTable($this->table);
-    return 1;
+    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 parent qw(-norequire IMPL::SQL::Schema::Traits);
-use IMPL::Class::Property;
-
-BEGIN {
-    public property tableName => prop_get | owner_set;
-}
+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 new IMPL::InvalidArgumentException("tableName is required");
+    $this->tableName($tableName) or die ArgException->new("tableName is required");
 }
 
-sub apply {
+sub CanApply {
     my ($this,$schema) = @_;
     
-    return 0 if $schema->GetTable( $this->tableName );
+    return $schema->GetTable( $this->tableName ) ? 1 : 0;
+}
+
+sub Apply {
+    my ($this,$schema) = @_;
     
     $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;
-}
+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 new IMPL::InvalidArgumentException("A table name is required");
-    $this->tableNewName($newName) or die new  IMPL::InvalidArgumentException("A new table name is required");
+    $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 apply {
+sub CanApply {
+    my ($this, $schema) = @_;
+    
+    return ($schema->GetTable($this->tableName) and not $schema->GetTable($this->tableNewName) ? 1 : 0 );
+}
+
+sub Apply {
     my ($this,$schema) = @_;
     
-    return 0 if not $schema->GetTable($this->tableName) or $schema->GetTable($this->tableNewName);
+    $schema->RenameTable($this->tableName, $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::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;
 
-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");
+    $this->tableName($tableName) or die ArgException->new("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;
+    die ArgException->new("A column should be a IMPL::SQL::Schema::Traits::Column object")
+        unless is($column, Column);
         
     $this->column($column);
 }
 
-sub apply {
+sub CanApply {
     my ($this,$schema) = @_;
     
-    my $table = $schema->GetTable($this->tableName) or return 0;
+    my $table = $schema->GetTable($this->tableName)
+        or return 0;
     
-    return 0 if $table->GetColumn( $this->column->{name} );
+    return $table->GetColumn( $this->column->{name} ) ? 0 : 1;
+}
+
+sub Apply {
+    my ($this,$schema) = @_;
     
-    $table->AddColumn($this->column);
+    my $table = $schema->GetTable($this->tableName)
+        or die OpException->new("The specified table doesn't exists", $this->tableName);
     
-    return 1;
+    if ($this->position) {
+        $table->AddColumn($this->column);
+    } else {
+        $table->InsertColumn($this->column,$this->position);
+    }
 }
 
 #################################################
 
 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;
-}
+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 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");
+    $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 apply {
+sub CanApply {
     my ($this,$schema) = @_;
     
-    local $@;
+    my $table = $schema->GetTable($this->tableName)
+        or return 0;
+    
+    $table->GetColumn($this->columnName) or
+        return 0;
     
-    return eval {
-        $schema->GetTable($this->tableName)->RemoveColumn($this->columnName);
-        return 1;
-    } || 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 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)
-}
+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 new IMPL::InvalidArgumentException(tableName => "A table name is required");
-    $this->columnName($column) or die new IMPL::InvalidArgumentException(columnName => "A column name is required");
+    $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 apply {
+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) = @_;
     
-    local $@;
+    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);
     
-    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;
+    $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 parent qw(-norequire IMPL::SQL::Schema::Traits);
-use IMPL::Class::Property;
+
+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;
 
-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");
+    $this->tableName($table) or die ArgException->new( 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;
+    die ArgException->new(constaraint => "A valid " . Constraint . " is required")
+        unless is($constraint, Constraint);
         
     $this->constraint($constraint);
 }
 
-sub apply {
+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)) {
+        warn "FK";
+        my $foreignTable = $schema->GetTable($constraint->{foreignTable})
+            or return 0;
+
+        warn "Table OK";
+        my @foreignColumns = map $foreignTable->GetColumn($_), @{$constraint->{foreignColumns}||[]};
+        
+        # внешняя таблица имеет нужные столбцы
+        return 0
+            if grep not($_), @foreignColumns;
+            
+        warn "FK Columns OK";
+            
+        return 0
+            if grep not($columns[$_]->type->SameValue($foreignColumns[$_]->type)), (0 .. $#columns);
+            
+        warn "FK Columns types OK";
+    }
+    
+    return 1;
+}
+
+sub Apply {
     my ($this,$schema) = @_;
     
-    local $@;
+    my $table = $schema->GetTable($this->tableName)
+        or die IMPL::InvalidOperationException->new("The specified table doesn't exists", $this->tableName);
+        
+    my $constraint = $this->constraint;
     
-    return eval {
-        $schema->GetTable($this->tableName)->AddConstraint($this->constraint->constraintClass, $this->constraint);
-        return 1;
-    } || 0;
+    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 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;
-}
+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) = @_;
@@ -377,15 +542,30 @@
     $this->constraintName($constraint);
 }
 
-sub apply {
+sub CanApply {
     my ($this,$schema) = @_;
     
-    my $table = $schema->GetTable($this->tableName) or return 0;
+    my $table = $schema->GetTable($this->tableName);
+    
+    my $constraint = $table->GetConstraint($this->constraintName)
+        or return 0;
     
-    return 0 unless $table->GetConstraint($this->constraintName);
+    # есть ли внешние ключи на данную таблицу    
+    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);
-    return 1;
 }
 
 
@@ -413,9 +593,9 @@
 
 Методы обще для всех примитивных операций.
 
-=head3 C<apply($schema)>
+=head3 C<CanApply($schema)>
 
-Пытается приминить операцию к указанной схеме.
+Определяет возможность применения операции к указанной схеме.
 
 Возвращаемое значение:
 
@@ -423,7 +603,7 @@
 
 =item C<true>
 
-Операция успешно применена к схеме.
+Операция приминима к схеме.
 
 =item C<false>
 
@@ -431,6 +611,10 @@
 
 =back
 
+=head3 C<Apply($schema)>
+
+Применяет операцию к указанной схеме.
+
 =head2 Primitive operations
 
 =head3 C<IMPL::SQL::Schema::Traits::CreateTable>