# HG changeset patch
# User cin
# Date 1359326594 -14400
# Node ID 56364d0c4b4f41c7f4838c12d9250033f4e953b8
# Parent  3f59fd828d5fe2a716d5ff72cc90714994b9241c
+IMPL::SQL::Schema::MySQL: added basic support for MySQL

diff -r 3f59fd828d5f -r 56364d0c4b4f Lib/IMPL/SQL/Schema/Constraint.pm
--- a/Lib/IMPL/SQL/Schema/Constraint.pm	Fri Jan 25 00:25:02 2013 +0400
+++ b/Lib/IMPL/SQL/Schema/Constraint.pm	Mon Jan 28 02:43:14 2013 +0400
@@ -2,7 +2,7 @@
 use strict;
 use warnings;
 
-use IMPL::lang qw(:declare is);
+use IMPL::lang qw(:declare is isclass);
 
 use parent qw(IMPL::Object IMPL::Object::Disposable);
 
@@ -29,7 +29,7 @@
 sub ResolveColumn {
     my ($Table,$Column) = @_;
     
-    my $cn = UNIVERSAL::isa($Column,'IMPL::SQL::Schema::Column') ? $Column->name : $Column;
+    my $cn = is($Column,'IMPL::SQL::Schema::Column') ? $Column->name : $Column;
     
     my $resolved = $Table->GetColumn($cn);
     die new IMPL::InvalidOperationException("The column is not found in the table", $cn, $Table->name) if not $resolved;
@@ -74,7 +74,7 @@
 sub ResolveAlias {
     my ($self,$alias) = @_;
     
-    return is($alias, typeof IMPL::SQL::Schema::Constraint) ? $alias : $aliases{$alias};
+    return isclass($alias, typeof IMPL::SQL::Schema::Constraint) ? $alias : $aliases{$alias};
 }
 
 sub RegisterAlias {
diff -r 3f59fd828d5f -r 56364d0c4b4f Lib/IMPL/SQL/Schema/Constraint/ForeignKey.pm
--- a/Lib/IMPL/SQL/Schema/Constraint/ForeignKey.pm	Fri Jan 25 00:25:02 2013 +0400
+++ b/Lib/IMPL/SQL/Schema/Constraint/ForeignKey.pm	Mon Jan 28 02:43:14 2013 +0400
@@ -10,8 +10,8 @@
 
 BEGIN {
     public _direct property referencedPrimaryKey => PROP_GET;
-    public _direct property OnDelete => PROP_GET;
-    public _direct property OnUpdate => PROP_GET;
+    public _direct property onDelete => PROP_GET;
+    public _direct property onUpdate => PROP_GET;
 }
 
 __PACKAGE__->PassThroughArgs;
@@ -20,7 +20,7 @@
 sub CTOR {
     my ($this,%args) = @_;    
     
-    die new Eexception("Referenced table must be an instance of a table object") if not UNIVERSAL::isa($args{'referencedTable'},'IMPL::SQL::Schema::Table');
+    die new Exception("Referenced table must be an instance of a table object") if not is($args{'referencedTable'},'IMPL::SQL::Schema::Table');
     
     die new Exception("Referenced columns must be a not empty list of columns") if not UNIVERSAL::isa($args{'referencedColumns'},'ARRAY') or not scalar(@{$args{'referencedColumns'}});
     
@@ -38,6 +38,9 @@
     $this->{$referencedPrimaryKey} = $ForeingPK;
     
     $ForeingPK->ConnectFK($this);
+    
+    $this->onUpdate($args{onUpdate}) if $args{onUpdate};
+    $this->onDelete($args{onDelete}) if $args{onDelete};
 }
 
 sub Dispose {
@@ -52,8 +55,8 @@
 sub SameValue {
     my ($this,$other) = @_;
     
-    uc $this->OnDelete eq uc $other->OnDelete or return 0;
-    uc $this->OnUpdate eq uc $other->OnUpdate or return 0;
+    uc $this->onDelete eq uc $other->onDelete or return 0;
+    uc $this->onUpdate eq uc $other->onUpdate or return 0;
     
     return $this->SUPER::SameValue($other);
 }
diff -r 3f59fd828d5f -r 56364d0c4b4f Lib/IMPL/SQL/Schema/Diff.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/SQL/Schema/Diff.pm	Mon Jan 28 02:43:14 2013 +0400
@@ -0,0 +1,192 @@
+package IMPL::SQL::Schema::Diff;
+use strict;
+use warnings;
+use IMPL::lang qw(:compare :hash is);
+
+use IMPL::SQL::Schema::Traits();
+
+use IMPL::require {
+    Schema => 'IMPL::SQL::Schema',
+    ForeignKey => '-IMPL::SQL::Schema::Constraint::ForeignKey',
+    PrimaryKey => '-IMPL::SQL::Schema::Constraint::PrimaryKey',
+    UniqueConstraint =>'-IMPL::SQL::Schema::Constraint::Unique',
+    Index => '-IMPL::SQL::Schema::Constraint::Index',
+    TraitsForeignKey => '-IMPL::SQL::Schema::Traits::ForeignKey',
+    TraitsPrimaryKey => '-IMPL::SQL::Schema::Traits::PrimaryKey',
+    TraitsUnique => '-IMPL::SQL::Schema::Traits::Unique',
+    TraitsIndex => '-IMPL::SQL::Schema::Traits::Index',
+    TraitsDropTable => '-IMPL::SQL::Schema::Traits::DropTable',
+    TraitsCreateTable => '-IMPL::SQL::Schema::Traits::CreateTable',
+    TraitsTable => '-IMPL::SQL::Schema::Traits::Table',
+    TraitsColumn => '-IMPL::SQL::Schema::Traits::Column',
+    TraitsAlterTableDropConstraint => '-IMPL::SQL::Schema::Traits::AlterTableDropConstraint',
+    TraitsAlterTableAddConstraint => '-IMPL::SQL::Schema::Traits::AlterTableAddConstraint',
+    TraitsAlterTableDropColumn => '-IMPL::SQL::Schema::Traits::AlterTableDropColumn',
+    TraitsAlterTableAddColumn => '-IMPL::SQL::Schema::Traits::AlterTableAddColumn',
+    TraitsAlterTableChangeColumn => '-IMPL::SQL::Schema::Traits::AlterTableChangeColumn',
+    Exception => 'IMPL::Exception',
+    ArgException => '-IMPL::InvalidArgumentException'
+};
+
+sub Diff {
+    my ($self,$src,$dst) = @_;
+    
+    die ArgException->new( src => "A valid source schema is required") unless is($src,Schema);
+    die ArgException->new( dst => "A valid desctination schema is requried" ) unless is($src,Schema);
+    
+    my %dstTables = map { $_->name, $_ } $dst->GetTables;
+    
+    my @operations;
+    
+    foreach my $srcTable ( $src->GetTables) {
+        my $dstTable = delete $dstTables{$srcTable->name};
+        
+        if (not $dstTable) {
+            # if a source table doesn't have a corresponding destination table, it should be deleted
+            push @operations, TraitsDropTable->new($srcTable->name);
+        } else {
+            # a source table needs to be updated
+            push @operations, $self->_DiffTables($srcTable,$dstTable);
+        }
+        
+    }
+    
+    foreach my $tbl ( values %dstTables ) {
+        push @operations, TraitsCreateTable->new(
+            TraitsTable->new(
+                $tbl->name,
+                [ map _Column2Traits($_), @{$tbl->columns} ],
+                [ map _Constraint2Traits($_), $tbl->GetConstraints()],
+                $tbl->{tag}
+            )
+        )
+    }
+    
+    return \@operations;
+}
+
+sub _DiffTables {
+    my ($self,$src,$dst) = @_;
+    
+    my @dropConstraints;
+    my @createConstraints;
+    
+    my %srcConstraints = map { $_->name, $_ } $src->GetConstraints();
+    my %dstConstraints = map { $_->name, $_ } $dst->GetConstraints();
+    
+    foreach my $cnSrcName (keys %srcConstraints) {
+        if ( my $cnDst = delete $dstConstraints{$cnSrcName} ) {
+            unless ( $srcConstraints{$cnSrcName}->SameValue($cnDst) ) {
+                push @dropConstraints,
+                    TraitsAlterTableDropConstraint->new( $src->name, $cnSrcName );
+                push @createConstraints,
+                    TraitsAlterTableAddConstraint->new( $dst->name, _Constraint2Traits($cnDst) );
+            }
+        } else {
+            push @dropConstraints,TraitsAlterTableDropConstraint->new( $src->name, $cnSrcName );
+        }
+    }
+    
+    foreach my $cnDst (values %dstConstraints) {
+        push @createConstraints,
+        TraitsAlterTableAddConstraint->new( $dst->name, _Constraint2Traits($cnDst) );
+    }
+    
+    my @deleteColumns;
+    my @addColumns;
+    my @updateColumns;
+    
+    my %dstColumnIndexes = map {
+        my $col = $dst->GetColumnAt($_);
+        ($col->name, { column => $col, index => $_ })
+    } 0 .. $dst->ColumnsCount-1;
+    
+    my @columns;
+    
+    # remove old columns, mark for update changed columns
+    for( my $i=0; $i < $src->ColumnsCount; $i++) {
+        my $colSrc = $src->GetColumnAt($i);
+        
+        if ( my $infoDst = delete $dstColumnIndexes{$colSrc->name} ) {
+            $infoDst->{prevColumn} = $colSrc;
+            push @columns,$infoDst;
+        } else {
+            push @deleteColumns,TraitsAlterTableDropColumn->new($src->name,$colSrc->name);
+        }
+    }
+    
+    #insert new columns at specified positions
+    foreach ( sort { $a->{index} <=> $b->{index} } values %dstColumnIndexes ) {
+        splice(@columns,$_->{index},0,$_);
+        push @addColumns, TraitsAlterTableAddColumn->new($src->name, _Column2Traits( $_->{column}, position => $_->{index} ));
+    }
+    
+    # remember old indexes
+    for(my $i =0; $i< @columns; $i ++) {
+        $columns[$i]->{prevIndex} = $i;
+    }
+    
+    # reorder columns
+    @columns = sort { $a->{index} <=> $b->{index} } @columns;
+    
+    foreach my $info (@columns) {
+        if ($info->{prevColumn} && ( !$info->{column}->SameValue($info->{prevColumn}) or $info->{index}!= $info->{prevIndex} ) ) {
+            my $op = TraitsAlterTableChangeColumn->new($src->name,$info->{column}->name);
+
+            $op->position( $info->{index} ) unless $info->{prevIndex} == $info->{index};
+            $op->isNullable( $info->{column}->isNullable ) unless equals($info->{column}->isNullable,$info->{prevColumn}->isNullable);
+            $op->defaultValue( $info->{column}->defaultValue ) unless equals($info->{column}->defaultValue, $info->{prevColumn}->defaultValue);
+            
+            my $diff = hashDiff($info->{prevColumn}->tag,$info->{column}->tag);
+            $op->options($diff) if %$diff;
+            
+            push @updateColumns, $op;
+        }
+    }
+    
+    my @result = (@dropConstraints, @deleteColumns, @addColumns, @updateColumns, @createConstraints); 
+    
+    return @result;
+}
+
+sub _Column2Traits {
+    my ($column,%options) = @_;
+    
+    return TraitsColumn->new(
+        $column->name,
+        $column->type,
+        isNullable => $column->isNullable,
+        defaultValue => $column->defaultValue,
+        tag => $column->tag,
+        %options
+    );
+}
+
+sub _Constraint2Traits {
+    my ($constraint) = @_;
+    
+    my $map = {
+        ForeignKey , TraitsForeignKey,
+        PrimaryKey , TraitsPrimaryKey,
+        UniqueConstraint , TraitsUnique,
+        Index , TraitsIndex
+    };
+    
+    my $class = $map->{$constraint->typeof} or die Exception->new("Can't map the constraint",$constraint->typeof);
+    
+    if ($class eq TraitsForeignKey) {
+        return $class->new(
+            $constraint->name,
+            [ map $_->name, $constraint->columns ],
+            $constraint->referencedPrimaryKey->table->name,
+            [ map $_->name, $constraint->referencedPrimaryKey->columns ]
+        );
+    } else {
+        return $class->new(
+            $constraint->name,
+            [ map $_->name, $constraint->columns ]
+        );
+    }
+}
+
+1;
diff -r 3f59fd828d5f -r 56364d0c4b4f Lib/IMPL/SQL/Schema/MySQL/CharType.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/SQL/Schema/MySQL/CharType.pm	Mon Jan 28 02:43:14 2013 +0400
@@ -0,0 +1,27 @@
+package IMPL::SQL::Schema::MySQL::CharType;
+use strict;
+
+use IMPL::Const qw(:prop);
+use IMPL::declare {
+    require => {
+        Exception => 'IMPL::Exception',
+        ArgException => '-IMPL::InvalidArgumentException'        
+    },
+    base => [
+        'IMPL::SQL::Schema::Type' => '@_'
+    ],
+    props => [
+        encoding => PROP_RO
+    ]
+};
+
+my @CHAR_TYPES = qw(VARCHAR CHAR);
+
+sub CTOR {
+    my ($this) = @_;
+    
+    die ArgException->new(name => "The specified name is invalid", $this->name)
+        unless grep uc($this->name) eq $_, @CHAR_TYPES;
+}
+
+1;
\ No newline at end of file
diff -r 3f59fd828d5f -r 56364d0c4b4f Lib/IMPL/SQL/Schema/MySQL/EnumType.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/SQL/Schema/MySQL/EnumType.pm	Mon Jan 28 02:43:14 2013 +0400
@@ -0,0 +1,23 @@
+package IMPL::SQL::Schema::MySQL::EnumType;
+use strict;
+
+use IMPL::Const qw(:prop);
+use IMPL::declare {
+    base => [
+        'IMPL::SQL::Schema::Type' => '@_'
+    ],
+    props => [
+        enumValues => PROP_RO | PROP_LIST 
+    ]
+};
+
+our @ENUM_TYPES = qw(ENUM SET);
+
+sub CTOR {
+    my $this = shift;
+    
+    die ArgException->new(name => "The specified name is invalid", $this->name)
+        unless grep uc($this->name) eq $_, @ENUM_TYPES;
+}
+
+1;
\ No newline at end of file
diff -r 3f59fd828d5f -r 56364d0c4b4f Lib/IMPL/SQL/Schema/MySQL/Formatter.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/SQL/Schema/MySQL/Formatter.pm	Mon Jan 28 02:43:14 2013 +0400
@@ -0,0 +1,559 @@
+package IMPL::SQL::Schema::MySQL::Formatter;
+use strict;
+
+use IMPL::lang qw(is);
+use IMPL::require {
+    Exception         => 'IMPL::Exception',
+    OpException       => '-IMPL::InvalidOperationException',
+    ArgException      => '-IMPL::InvalidArgumentException',
+    PrimaryKey        => '-IMPL::SQL::Schema::Constraint::PrimaryKey',
+    UniqueIndex       => '-IMPL::SQL::Schema::Constraint::Unique',
+    Index             => '-IMPL::SQL::Schema::Constraint::Index',
+    ForeignKey        => '-IMPL::SQL::Schema::Constraint::ForeignKey',
+    CharType          => '-IMPL::SQL::Schema::MySQL::CharType',
+    EnumType          => '-IMPL::SQL::Schema::MySQL::EnumType',
+    TraitsDropTable   => '-IMPL::SQL::Schema::Traits::DropTable',
+    TraitsCreateTable => '-IMPL::SQL::Schema::Traits::CreateTable',
+    TraitsAlterTableDropConstraint => '-IMPL::SQL::Schema::Traits::AlterTableDropConstraint',
+    TraitsAlterTableAddConstraint  => '-IMPL::SQL::Schema::Traits::AlterTableAddConstraint',
+    TraitsAlterTableDropColumn     => '-IMPL::SQL::Schema::Traits::AlterTableDropColumn',
+    TraitsAlterTableAddColumn      => '-IMPL::SQL::Schema::Traits::AlterTableAddColumn',
+    TraitsAlterTableChangeColumn   => '-IMPL::SQL::Schema::Traits::AlterTableChangeColumn'
+};
+
+our %TRAITS_FORMATS = (
+    TraitsDropTable,                'FormatDropTable',
+    TraitsCreateTable,              'FormatCreateTable',
+    TraitsAlterTableDropConstraint, 'FormatAlterTableDropConstraint',
+    TraitsAlterTableAddConstraint,  'FormatAlterTableAddConstraint',
+    TraitsAlterTableDropColumn,     'FormatAlterTableDropColumn',
+    TraitsAlterTableAddColumn,      'FormatAlterTableAddColumn',
+    TraitsAlterTableChangeColumn,   'FormatAlterTableChangeColumn'
+);
+
+sub quote {
+    my $self = shift;
+
+    if (wantarray) {
+        return map { my $str = $_; $str =~ s/'/''/g; "'$str'"; } @_;
+    }
+    else {
+        return join '', map { my $str = $_; $str =~ s/'/''/g; "'$str'"; } @_;
+    }
+}
+
+sub quote_names {
+    my $self = shift;
+
+    if (wantarray) {
+        return map { my $str = $_; $str =~ s/`/``/g; "`$str`"; } @_;
+    }
+    else {
+        return join '', map { my $str = $_; $str =~ s/`/``/g; "`$str`"; } @_;
+    }
+}
+
+sub formatTypeNameInteger {
+    my ( $self, $type ) = @_;
+
+    return
+        $type->name
+      . ( $type->maxLength ? '(' . $type->maxLength . ')' : '' )
+      . ( $type->unsigned  ? ' UNSIGNED'                  : '' )
+      . ( $type->zerofill  ? ' ZEROFILL'                  : '' );
+}
+
+sub formatTypeNameReal {
+    my ( $self, $type ) = @_;
+
+    return $type->name
+      . ( $type->maxLength
+        ? '(' . $type->maxLength . ', ' . $type->scale . ')'
+        : '' )
+      . ( $type->unsigned ? ' UNSIGNED' : '' )
+      . ( $type->zerofill ? ' ZEROFILL' : '' );
+}
+
+sub formatTypeNameNumeric {
+    my ( $self, $type ) = @_;
+    $type->maxLength
+      or die ArgException->new(
+        type => 'The length and precission must be specified',
+        $type->name
+      );
+    return $type->name
+      . ( $type->maxLength
+        ? '(' . $type->maxLength . ', ' . $type->scale . ')'
+        : '' )
+      . ( $type->unsigned ? ' UNSIGNED' : '' )
+      . ( $type->zerofill ? ' ZEROFILL' : '' );
+}
+
+sub formatTypeName {
+    my ( $self, $type ) = @_;
+    return $type->name;
+}
+
+sub formatTypeNameChar {
+    my ( $self, $type ) = @_;
+
+    return ($type->name . '('
+          . $type->MaxLength . ')'
+          . ( is( $type, CharType ) ? $type->encoding : '' ) );
+}
+
+sub formatTypeNameVarChar {
+    my ( $self, $type ) = @_;
+
+    return ($type->name . '('
+          . $type->maxLength . ')'
+          . ( is( $type, CharType ) ? $type->encoding : '' ) );
+}
+
+sub formatTypeNameEnum {
+    my ( $self, $type ) = @_;
+
+    die ArgException->new( type => 'Invalid enum type' )
+      unless is( $type, EnumType );
+    return ($type->name . '('
+          . join( ',', map { $self->quote($_) } $type->enumValues )
+          . ')' );
+}
+
+sub formatStringValue {
+    my ( $self, $value ) = @_;
+
+    if ( ref $value eq 'SCALAR' ) {
+        return $$value;
+    }
+    else {
+        return $self->quote($value);
+    }
+}
+
+sub formatNumberValue {
+    my ( $self, $value ) = @_;
+
+    if ( ref $value eq 'SCALAR' ) {
+        return $$value;
+    }
+    else {
+        $value =~ /^((\+|-)\s*)?\d+(\.\d+)?(e(\+|-)?\d+)?$/
+          or die ArgException->new(
+            value => 'The specified value isn\'t a valid number',
+            $value
+          );
+        return $value;
+    }
+}
+
+our %TYPES_FORMATS = (
+    TINYINT => {
+        formatType  => \&formatTypeNameInteger,
+        formatValue => \&formatNumberValue
+    },
+    SMALLINT => {
+        formatType  => \&formatTypeNameInteger,
+        formatValue => \&formatNumberValue
+    },
+    MEDIUMINT => {
+        formatType  => \&formatTypeNameInteger,
+        formatValue => \&formatNumberValue
+    },
+    INT => {
+        formatType  => \&formatTypeNameInteger,
+        formatValue => \&formatNumberValue
+    },
+    INTEGER => {
+        formatType  => \&formatTypeNameInteger,
+        formatValue => \&formatNumberValue
+    },
+    BIGINT => {
+        formatType  => \&formatTypeNameInteger,
+        formatValue => \&formatNumberValue
+    },
+    REAL => {
+        formatType  => \&formatTypeNameReal,
+        formatValue => \&formatNumberValue
+    },
+    DOUBLE => {
+        formatType  => \&formatTypeNameReal,
+        formatValue => \&formatNumberValue
+    },
+    FLOAT => {
+        formatType  => \&formatTypeNameReal,
+        formatValue => \&formatNumberValue
+    },
+    DECIMAL => {
+        formatType  => \&formatTypeNameNumeric,
+        formatValue => \&formatNumberValue
+    },
+    NUMERIC => {
+        formatType  => \&formatTypeNameNumeric,
+        formatValue => \&formatNumberValue
+    },
+    DATE => {
+        formatType  => \&formatTypeName,
+        formatValue => \&formatStringValue
+    },
+    TIME => {
+        formatType  => \&formatTypeName,
+        formatValue => \&formatStringValue
+    },
+    TIMESTAMP => {
+        formatType  => \&formatTypeName,
+        formatValue => \&formatStringValue
+    },
+    DATETIME => {
+        formatType  => \&formatTypeName,
+        formatValue => \&formatStringValue
+    },
+    CHAR => {
+        formatType  => \&formatTypeNameChar,
+        formatValue => \&formatStringValue
+    },
+    VARCHAR => {
+        formatType  => \&formatTypeNameVarChar,
+        formatValue => \&formatStringValue
+    },
+    TINYBLOB => {
+        formatType  => \&formatTypeName,
+        formatValue => \&formatStringValue
+    },
+    BLOB => {
+        formatType  => \&formatTypeName,
+        formatValue => \&formatStringValue
+    },
+    MEDIUMBLOB => {
+        formatType  => \&formatTypeName,
+        formatValue => \&formatStringValue
+    },
+    LONGBLOB => {
+        formatType  => \&formatTypeName,
+        formatValue => \&formatStringValue
+    },
+    TINYTEXT => {
+        formatType  => \&formatTypeName,
+        formatValue => \&formatStringValue
+    },
+    TEXT => {
+        formatType  => \&formatTypeName,
+        formatValue => \&formatStringValue
+    },
+    MEDIUMTEXT => {
+        formatType  => \&formatTypeName,
+        formatValue => \&formatStringValue
+    },
+    LONGTEXT => {
+        formatType  => \&formatTypeName,
+        formatValue => \&formatStringValue
+    },
+    ENUM => {
+        formatType  => \&formatTypeNameEnum,
+        formatValue => \&formatStringValue
+    },
+    SET => {
+        formatType  => \&formatTypeNameEnum,
+        formatValue => \&formatStringValue
+    }
+);
+
+sub FormatTypeName {
+    my ( $self, $type ) = @_;
+
+    my $fn = $TYPES_FORMATS{ $type->name }{formatType}
+      or die ArgException->new( type => "The specified type is unknown",
+        $type->name );
+
+    return $self->$fn($type);
+}
+
+sub FormatValue {
+    my ( $self, $value, $type ) = @_;
+
+    my $fn = $TYPES_FORMATS{ $type->name }{formatValue}
+      or die ArgException->new( type => "The specified type is unknown",
+        $type->name );
+
+    return $self->$fn( $value, $type );
+}
+
+sub FormatColumn {
+    my ( $self, $column ) = @_;
+
+    my @parts = (
+        $self->quote_names( $column->{name} ),
+        $self->FormatTypeName( $column->{type} ),
+        $column->{isNullable} ? 'NULL' : 'NOT NULL'
+    );
+
+    push @parts, $self->FormatValue( $column->{defaultValue}, $column->{type} )
+      if $column->{defaultValue};
+
+    push @parts, 'AUTO_INCREMENT'
+      if $column->{tag} and $column->{tag}->{auto_increment};
+
+    return join ' ', @parts;
+}
+
+sub FormatCreateTable {
+    my ( $self, $op ) = @_;
+
+    my $table = $op->table;
+
+    my @lines;
+    my @body;
+
+    push @lines, "CREATE TABLE " . $self->quote_names($table->{name}) . "(";
+
+    push @body, map { "  " . $self->FormatColumn($_) } @{ $table->{columns} }
+        if $table->{columns};
+      
+    push @body, map { "  " . $self->FormatConstraint($_) } @{ $table->{constraints} }
+        if $table->{constraints};
+        
+    push @lines, join(",\n", @body);
+
+    push @lines, ");";
+
+    return join "\n", @lines;
+}
+
+sub FormatDropTable {
+    my ( $self, $op ) = @_;
+
+    return join ' ', 'DROP TABLE', $self->quote_names( $op->tableName ), ';';
+}
+
+sub FormatRenameTable {
+    my ( $self, $op ) = @_;
+
+    return join ' ',
+      'ALTER TABLE',
+      $self->quote_names( $op->tableName ),
+      'RENAME TO',
+      $self->quote_names( $op->tableNewName ),
+      ';';
+}
+
+sub FormatAlterTableAddColumn {
+    my ( $self, $op, $schema ) = @_;
+
+    my @parts = (
+        'ALTER TABLE',$self->quote_names($op->tableName), 'ADD COLUMN',
+        $self->FormatColumn( $op->column )
+    );
+
+    if ( defined $op->position ) {
+
+        # mysql supports column reordering
+        # the new location is specified relative to the previous column
+        # to determine the name of the previous column we need to ask the schema
+
+        my $table = $schema->GetTable( $op->tableName );
+
+        if ( $op->position == 0 ) {
+            push @parts, 'FIRST';
+        }
+        else {
+            push @parts, 'AFTER';
+
+            my $prevColumn = $table->GetColumnAt( $op->position - 1 );
+            push @parts, $self->quote_names( $prevColumn->{name} );
+        }
+    }
+
+    push @parts, ';';
+
+    return join ' ', @parts;
+}
+
+sub FormatAlterTableDropColumn {
+    my ( $self, $op ) = @_;
+
+    return join ' ',
+      'ALTER TABLE',
+      $self->quote_names( $op->tableName ),
+      'DROP COLUMN',
+      $self->quote_names( $op->columnName ),
+      ';';
+}
+
+sub FormatAlterTableChangeColumn {
+    my ( $self, $op, $schema ) = @_;
+
+    my $table  = $schema->GetTable( $op->tableName );
+    my $column = $table->GetColumn( $op->columnName );
+
+    my @parts = (
+        'ALTER TABLE',
+        $self->quote_names( $op->tableName ),
+        'MODIFY COLUMN',
+        $self->quote_names( $op->columnName ),
+        $self->FormatColumn( $self->_Column2Traits($column) )
+    );
+
+    if ( defined $op->position ) {
+
+        # mysql supports column reordering
+        # the new location is specified relative to the previous column
+        # to determine the name of the previous column we need to ask the schema
+
+        if ( $op->position == 0 ) {
+            push @parts, 'FIRST';
+        }
+        else {
+            push @parts, 'AFTER';
+
+            my $prevColumn = $table->GetColumnAt( $op->position - 1 );
+            push @parts, $self->quote_names( $prevColumn->{name} );
+        }
+    }
+
+    push @parts, ';';
+    return join ' ', @parts;
+}
+
+sub FormatConstraint {
+    my ($self,$constraint) = @_;
+    
+    my @fkRules =
+      ( 'RESTRICT', 'CASCADE', 'SET NULL', 'SET DEFAULT', 'NO ACTION' );
+      
+    my @parts;
+
+    if ( $constraint->constraintClass eq ForeignKey ) {
+        push @parts,
+          'CONSTRAINT',
+          $self->quote_names( $constraint->{name} ),
+          'FOREIGN KEY',
+          $self->quote_names( $constraint->{name} ),
+          '(',
+          join( ', ', $self->quote_names( @{ $constraint->{columns} || [] } ) ),
+          ')',
+          'REFERENCES', $self->quote_names( $constraint->{foreignTable} ), '(',
+          join( ', ',
+            $self->quote_names( @{ $constraint->{foreignColumns} || [] } ) ),
+          ')';
+
+        if ( my $rule = uc( $constraint->{onDelete} ) ) {
+            grep $_ eq $rule, @fkRules
+              or die Exception->new( "Invalid onDelete rule specified",
+                $constraint->{name}, $rule );
+
+            push @parts, 'ON DELETE', $rule;
+        }
+
+        if ( my $rule = uc( $constraint->{onUpdate} ) ) {
+            grep $_ eq $rule, @fkRules
+              or die Exception->new( "Invalid onUpdate rule specified",
+                $constraint->{name}, $rule );
+
+            push @parts, 'ON UPDATE', $rule;
+        }
+
+    }
+    else {
+        if ( $constraint->constraintClass eq PrimaryKey ) {
+            push @parts, 'PRIMARY KEY';
+
+        }
+        elsif ( $constraint->constraintClass eq UniqueIndex ) {
+            push @parts, 'UNIQUE', $self->quote_names( $constraint->{name} );
+        }
+        elsif ( $constraint->constraintClass eq Index ) {
+            push @parts, 'INDEX', $self->quote_names( $constraint->{name} );
+        }
+        else {
+            die Exception->new( 'Invalid constraint type',
+                $constraint->constraintClass );
+        }
+
+        push @parts,
+          '(',
+          join( ', ', $self->quote_names( @{ $constraint->{columns} || [] } ) ),
+          ')';
+    }
+    
+    
+    return join ' ', @parts;
+}
+
+sub FormatAlterTableAddConstraint {
+    my ( $self, $op ) = @_;
+
+    return join(' ', 
+        'ALTER TABLE',
+        $self->quote_names( $op->tableName ),
+        'ADD',
+        $self->FormatConstraint($op->constraint),
+        ';'
+    );
+}
+
+sub FormatAlterTableDropConstraint {
+    my ( $self, $op, $constraintType ) = @_;
+
+    my @parts = ( 'ALTER TABLE', $self->quote_names( $op->tableName ), 'DROP' );
+
+    if ( $constraintType eq PrimaryKey ) {
+        push @parts, 'PRIMARY KEY';
+    }
+    elsif ( $constraintType eq ForeignKey ) {
+        push @parts, 'FOREIGN KEY', $self->quote_names( $op->constraintName );
+    }
+    elsif ( $constraintType eq UniqueIndex or $constraintType eq Index ) {
+        push @parts, 'INDEX', $self->quote_names( $op->constraintName );
+    }
+    else {
+        die Exception->new(
+            'Invalid constraint type', $op->tableName,
+            $op->constraintName,       $constraintType
+        );
+    }
+    
+    push @parts, ';';
+    
+    return join ' ', @parts;
+}
+
+sub Format {
+    my $self = shift;
+    my ($op) = @_;
+    
+    my $formatter = $TRAITS_FORMATS{ref $op}
+        or die OpException->new("Don't know how to format the specified operation", $op);
+        
+    $self->$formatter(@_);
+}
+
+sub _Column2Traits {
+    my ( $self, $column, %options ) = @_;
+
+    return new IMPL::SQL::Schema::Traits::Column(
+        $column->name,
+        $column->type,
+        isNullable   => $column->isNullable,
+        defaultValue => $column->defaultValue,
+        tag          => $column->tag,
+        %options
+    );
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+C<IMPL::SQL::Traits::MysqlFormatter> - преобразует операции над схемой в C<SQL>
+выражения.
+
+=head1 DESCRIPTION
+
+Используется для форматирования операций изменения схемы БД. Осуществляет
+правильное экранирование имен, форматирование значений, имен типов данных.
+
+=cut
diff -r 3f59fd828d5f -r 56364d0c4b4f Lib/IMPL/SQL/Schema/MySQL/Processor.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/SQL/Schema/MySQL/Processor.pm	Mon Jan 28 02:43:14 2013 +0400
@@ -0,0 +1,93 @@
+package IMPL::SQL::Schema::MySQL::Processor;
+use strict;
+
+use mro;
+use IMPL::Const qw(:prop);
+use IMPL::declare {
+    require => {
+        MySQLFormatter           => 'IMPL::SQL::Schema::MySQL::Formatter',
+        AlterTableDropConstraint => '-IMPL::SQL::Schema::Traits::AlterTableDropConstraint',
+        AlterTableAddConstraint  => '-IMPL::SQL::Schema::Traits::AlterTableAddConstraint',
+        CreateTable  => '-IMPL::SQL::Schema::Traits::CreateTable',
+        Table => '-IMPL::SQL::Schema::Traits::Table',
+        ForeignKey => '-IMPL::SQL::Schema::Traits::ForeignKey',
+        
+    },
+    base  => [
+        'IMPL::SQL::Schema::Processor' => sub { $_[0] }
+    ],
+    props => [
+        formatter   => PROP_RO,
+        sqlBatch    => PROP_RO
+    ]
+};
+use IMPL::lang qw(is);
+
+sub CTOR {
+    my ( $this, $schema, %opts ) = @_;
+
+    $this->formatter( $opts{formatter} || MySQLFormatter );
+    $this->sqlBatch([]);
+}
+
+sub AddSqlBatch {
+    my $this = shift;
+    
+    push @{$this->sqlBatch}, @_;
+}
+
+sub ApplyOperation {
+    my ($this, $op, $iteration ) = @_;
+    
+    my @formatterParams;
+
+    if ( is( $op, AlterTableDropConstraint ) ) {
+        my $constraint = $this
+            ->dbSchema
+            ->GetTable($op->tableName)
+            ->GetConstraint($op->constraintName);
+            
+        push @formatterParams, ref $constraint;
+    } else {
+        push @formatterParams, $this->dbSchema;        
+    }
+    
+    if ( is( $op, CreateTable ) ) {
+        my @constraints;
+        my @fk;
+        my $table = $op->table;
+        
+        # отделяем создание внешних ключей от таблиц
+        
+        foreach my $c (@{$table->{constraints} || []}) {
+            if ( is($c,ForeignKey)) {
+                push @fk,$c;
+            } else {
+                push @constraints, $c;
+            }
+        }
+        
+        if (@fk) {
+            $op = CreateTable->new(
+                Table->new(
+                    $table->{name},
+                    $table->{columns},
+                    \@constraints,
+                    $table->{options}
+                )
+            );
+            
+            $this->AddPendingOperations(
+                map AlterTableAddConstraint->new($table->{name},$_), @fk
+            );
+        }
+    }
+    
+    $this->next::method($op,$iteration);
+    
+    $this->AddSqlBatch(
+        $this->formatter->Format($op,@formatterParams)
+    );
+}
+
+1;
diff -r 3f59fd828d5f -r 56364d0c4b4f Lib/IMPL/SQL/Schema/Processor.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/SQL/Schema/Processor.pm	Mon Jan 28 02:43:14 2013 +0400
@@ -0,0 +1,99 @@
+package IMPL::SQL::Schema::Processor;
+use strict;
+
+use IMPL::Const qw(:prop);
+use IMPL::declare {
+    require => {
+        Exception => 'IMPL::Exception',
+        ArgException => '-IMPL::InvalidArgumentException'
+    },
+    base => [
+        'IMPL::Object' => undef
+    ],
+    props => [
+        dbSchema => PROP_RO,
+        updateBatch => PROP_RO,
+        pendingOperations => PROP_RO
+    ] 
+};
+
+sub CTOR {
+    my ($this,$schema) = @_;
+    
+    $this->dbSchema($schema)
+        or die ArgException->new(schema => 'A DB schema is required');
+    
+    $this->updateBatch([]);
+    $this->pendingOperations([]);
+}
+
+sub AddUpdateBatch {
+    my $this = shift;
+    
+    push @{$this->updateBatch}, @_;
+}
+
+sub AddPendingOperations {
+    my $this = shift;
+    
+    push @{$this->pendingOperations}, @_;
+}
+
+sub ProcessBatch {
+    my ($this,$batch) = @_;
+    
+    $this->pendingOperations($batch);
+    my $i = 1;
+    while(@{$this->pendingOperations}) {
+        $batch = $this->pendingOperations;
+        $this->pendingOperations([]);
+        
+        my $noChanges = 1;
+        
+        foreach my $op (@$batch) {
+            if ($this->CanApplyOperation($op,$i)) {
+                $noChanges = 0;
+                
+                $this->ApplyOperation($op,$i);
+            } else {
+                $this->AddPendingOperations($op);
+            }
+        }
+        
+        if ($noChanges && @{$this->pendingOperations}) {
+            die Exception->new("No changes were made (iteration $i), but some operations are pending",@{$this->pendingOperations});
+        }
+        
+        $i++;
+    }
+}
+
+sub CanApplyOperation {
+    my ($this,$op) = @_;
+    
+    return $op->CanApply($this->dbSchema);
+}
+
+sub ApplyOperation {
+    my ($this,$op) = @_;
+    
+    $op->Apply($this->dbSchema);
+    $this->AddUpdateBatch($op);
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+Позволяет применит набор примитивных операций C<IMPL::SQL::Schema::Traits> к
+схеме. 
+
+=cut
\ No newline at end of file
diff -r 3f59fd828d5f -r 56364d0c4b4f Lib/IMPL/SQL/Schema/Table.pm
--- a/Lib/IMPL/SQL/Schema/Table.pm	Fri Jan 25 00:25:02 2013 +0400
+++ b/Lib/IMPL/SQL/Schema/Table.pm	Mon Jan 28 02:43:14 2013 +0400
@@ -36,12 +36,6 @@
            
         $this->InsertColumn($_) foreach @{$args{columns}};
     }
-    
-    if ($args{constraints}) {
-        die new IMPL::InvalidOperationException('A constraints property should be a reference to an array') unless ref $args{constraints} eq 'ARRAY';
-           
-        $this->AddConstraint($_) foreach @{$args{constraints}};
-    }
 }
 
 sub InsertColumn {
@@ -181,6 +175,8 @@
         $type = IMPL::SQL::Schema::Constraint->ResolveAlias($type) or
             die new IMPL::Exception("Can't resolve a constraint alias",$_[0]);
             
+        $params = {%{$params}};
+            
         $params->{table} = $this;
         
         $this->AddConstraint($type->new(%$params));
diff -r 3f59fd828d5f -r 56364d0c4b4f Lib/IMPL/SQL/Schema/Traits.pm
--- 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>
diff -r 3f59fd828d5f -r 56364d0c4b4f Lib/IMPL/SQL/Schema/Traits/MysqlFormatter.pm
--- a/Lib/IMPL/SQL/Schema/Traits/MysqlFormatter.pm	Fri Jan 25 00:25:02 2013 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,96 +0,0 @@
-package IMPL::SQL::Schema::Traits::MysqlFormatter;
-use strict;
-
-sub quote{
-	my $self = shift;
-	
-    if (wantarray) {
-        return map { my $str=$_; $str=~ s/'/''/g; "'$str'"; } @_;
-    } else {
-        return join '',map { my $str=$_; $str=~ s/'/''/g; "'$str'"; } @_;
-    }
-}
-
-sub quote_names {
-	my $self = shift;
-	
-    if (wantarray) {
-        return map { my $str=$_; $str=~ s/`/``/g; "`$str`"; } @_;
-    } else {
-        return join '',map { my $str=$_; $str=~ s/`/``/g; "`$str`"; } @_;
-    }
-}
-
-sub FormatTypeName {
-	my ($self,$type) = @_;
-	
-}
-
-sub FormatValue {
-	my ($self,$value,$type) = @_;
-}
-
-sub FormatColumn {
-	my ($self, $column) = @_;
-	
-	my @parts = (
-	   $self->quote_names($column->{name}),
-	   $self->FormatTypeName($column->{type}),
-	   $column->isNullable ? 'NULL' : 'NOT NULL'
-    );
-    
-    push @parts, $self->FormatValue( $column->{defaultValue}, $column->{type} )
-        if $column->{defaultValue};
-        
-    push @parts, 'AUTO_INCREMENT'
-        if $column->{tag} and $column->{tag}->{auto_increment};
-	
-	return join ' ', @parts;
-}
-
-sub FormatCreateTable {
-	my ($self,$op) = @_;
-	
-	my $table = $op->table;
-	
-	my @lines;
-	
-	push @lines, "CREATE TABLE (";
-	
-	push @lines, map { "  " . $self->FormatColumn($_) } @{$table->{columns}}
-	   if $table->{columns};
-	
-	push @lines, ");";
-	
-	return join "\n",@lines;
-}
-
-sub FormatDropTable {
-	my ($self,$op) = @_;
-	
-	return join ' ',
-	   'DROP TABLE',
-	   $self->quote_names($op->{tableName}),
-	   ';';
-}
-
-sub FormatRenameTable {
-	my ($self,$op) = @_;
-	
-	return join ' ',
-	   'ALTER TABLE',
-	   $self->quote_names($op->{tableName}),
-	   'RENAME TO',
-	   $self->quote_names($op->{tableNewName}),
-	   ';';	
-}
-
-sub FormatAlterTableAddColumn {
-	my ($this,$op,$schema) = @_;
-	
-	my @parts;
-	
-	$schema->GetTable($op->{tableName})
-}
-
-1;
\ No newline at end of file
diff -r 3f59fd828d5f -r 56364d0c4b4f Lib/IMPL/SQL/Schema/Traits/Processor.pm
--- a/Lib/IMPL/SQL/Schema/Traits/Processor.pm	Fri Jan 25 00:25:02 2013 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,7 +0,0 @@
-package IMPL::SQL::Traits::Processor;
-use parent qw(IMPL::SQL::Schema);
-
-use IMPL::Class::Property;
-
-
-1;
diff -r 3f59fd828d5f -r 56364d0c4b4f Lib/IMPL/lang.pm
--- a/Lib/IMPL/lang.pm	Fri Jan 25 00:25:02 2013 +0400
+++ b/Lib/IMPL/lang.pm	Mon Jan 28 02:43:14 2013 +0400
@@ -8,12 +8,13 @@
 
 require IMPL::Class::PropertyInfo;
 
-our @EXPORT      = qw(&is);
+our @EXPORT      = qw(&is &isclass);
 our %EXPORT_TAGS = (
     base => [
         qw(
           &is
           &clone
+          &isclass
           )
     ],
 
@@ -62,7 +63,11 @@
 use IMPL::Const qw(:all);
 
 sub is($$) {
-    eval { $_[0]->isa( $_[1] ) };
+    eval {ref $_[0] and $_[0]->isa( $_[1] ) };
+}
+
+sub isclass {
+    eval {not ref $_[0] and $_[0]->isa( $_[1] ) };
 }
 
 sub virtual($) {
diff -r 3f59fd828d5f -r 56364d0c4b4f _test/Test/Class/Template.pm
--- a/_test/Test/Class/Template.pm	Fri Jan 25 00:25:02 2013 +0400
+++ b/_test/Test/Class/Template.pm	Mon Jan 28 02:43:14 2013 +0400
@@ -29,7 +29,7 @@
 };
 
 test IsDerivedFromTemplate => sub {
-    failed "My::Collection should be a subclass of IMPL::Class:Template" unless is('My::Collection','IMPL::Class::Template'); 
+    failed "My::Collection should be a subclass of IMPL::Class:Template" unless isclass('My::Collection','IMPL::Class::Template'); 
 };
 
 test Specialize => sub {
diff -r 3f59fd828d5f -r 56364d0c4b4f _test/Test/SQL/Diff.pm
--- a/_test/Test/SQL/Diff.pm	Fri Jan 25 00:25:02 2013 +0400
+++ b/_test/Test/SQL/Diff.pm	Mon Jan 28 02:43:14 2013 +0400
@@ -1,35 +1,32 @@
 package Test::SQL::Diff;
 use strict;
 use warnings;
-use parent qw(IMPL::Test::Unit);
+
+use IMPL::declare {
+    require => {
+        MySQLProcessor => 'IMPL::SQL::Schema::MySQL::Processor',
+        SQLSchema => 'IMPL::SQL::Schema',
+        SQLDiff => 'IMPL::SQL::Schema::Diff'
+    },
+    base => [
+        'IMPL::Test::Unit' => '@_'
+    ]    
+};
 
 use IMPL::Test qw(test failed assert);
-use IMPL::SQL::Schema();
 use IMPL::SQL::Types qw(Integer Varchar Text);
-use IMPL::SQL::Schema::Traits::Diff();
 use Data::Dumper;
 
-__PACKAGE__->PassThroughArgs;
 
 test diff => sub {
-    my $schemaSrc = new IMPL::SQL::Schema(name => 'simple', version => 1 );
+    my $schemaSrc = SQLSchema->new(name => 'simple', version => 1 );
     
-    my $tbl = $schemaSrc->AddTable({
-        name => 'User',
-        columns => [
-            { name => 'name', type => Varchar(255) },
-            { name => 'description', type => Varchar(255) }
-        ]
-    });
-    
-    $tbl->AddConstraint( unique => { name => 'unique_name', columns => ['name'] });
-    
-    my $schemaDst = new IMPL::SQL::Schema(name => 'simple', version => 2 );
+    my $schemaDst = SQLSchema->new(name => 'simple', version => 2 );
     
     my $users = $schemaDst->AddTable({
         name => 'User',
         columns => [
-            { name => 'id', type => Integer },
+            { name => 'id', type => Integer, tag => {auto_increment => 1} },
             { name => 'login', type => Varchar(255) },
             { name => 'description', type => Text, isNullable => 1 }
         ]
@@ -38,7 +35,25 @@
     $users->SetPrimaryKey('id');
     $users->AddConstraint( unique => { name => 'unique_login', columns => ['login'] } );
     
-    #warn Dumper(IMPL::SQL::Schema::Traits::Diff->Diff($schemaSrc,$schemaDst));
+    my $profile = $schemaDst->AddTable({
+        name => 'Profile',
+        columns => [
+            { name => 'id', type => Integer, tag => {auto_increment => 1} },
+            { name => 'uid', type => Integer },
+            { name => 'data', type => Text }
+        ]
+    });
+    
+    $profile->SetPrimaryKey('id');
+    $profile->LinkTo($users, 'uid');
+    
+    my $diff = SQLDiff->Diff($schemaSrc,$schemaDst);
+    
+    my $processor = MySQLProcessor->new($schemaSrc);
+    $processor->ProcessBatch($diff);
+    
+    warn Dumper($diff);
+    warn Dumper($processor->sqlBatch);
     
     $schemaSrc->Dispose;
     $schemaDst->Dispose;