changeset 168:6148f89bb7bf

IMPL::SQL::Schema::Traits::Diff alfa version IMPL::lang added hash traits
author sourcer
date Mon, 16 May 2011 04:30:38 +0400
parents 1f7a6d762394
children fd92830036c3
files Lib/IMPL/ORM/Schema/TransformToSQL.pm Lib/IMPL/Object/List.pm Lib/IMPL/SQL/Schema/Column.pm Lib/IMPL/SQL/Schema/Constraint.pm Lib/IMPL/SQL/Schema/Constraint/ForeignKey.pm Lib/IMPL/SQL/Schema/Constraint/Index.pm Lib/IMPL/SQL/Schema/Constraint/PrimaryKey.pm Lib/IMPL/SQL/Schema/Constraint/Unique.pm Lib/IMPL/SQL/Schema/Table.pm Lib/IMPL/SQL/Schema/Traits.pm Lib/IMPL/SQL/Schema/Traits/Diff.pm Lib/IMPL/lang.pm _test/SQL.t _test/Test/Lang.pm _test/Test/SQL/Diff.pm _test/Test/SQL/Schema.pm _test/Test/SQL/Traits.pm _test/lang.t
diffstat 18 files changed, 380 insertions(+), 78 deletions(-) [+]
line wrap: on
line diff
--- a/Lib/IMPL/ORM/Schema/TransformToSQL.pm	Thu May 12 08:57:19 2011 +0400
+++ b/Lib/IMPL/ORM/Schema/TransformToSQL.pm	Mon May 16 04:30:38 2011 +0400
@@ -81,7 +81,7 @@
     my $tableForeign = $sqlSchema->Tables->{$relation->target};
     my $prefix = $relation->name;
     
-    my @fkColumns = @{$tableForeign->PrimaryKey->Columns};
+    my @fkColumns = $tableForeign->PrimaryKey->columns;
     
     if (@fkColumns > 1) {
         @fkColumns = map
@@ -111,7 +111,7 @@
     my $tableForeign = $sqlSchema->Tables->{$relation->target};
     my $prefix = $relation->name;
     
-    my @fkColumns = @{$table->PrimaryKey->Columns};
+    my @fkColumns = $table->PrimaryKey->columns;
     
     if (@fkColumns > 1 ) {
         @fkColumns = map $tableForeign->InsertColumn({
--- a/Lib/IMPL/Object/List.pm	Thu May 12 08:57:19 2011 +0400
+++ b/Lib/IMPL/Object/List.pm	Mon May 16 04:30:38 2011 +0400
@@ -6,7 +6,7 @@
 use IMPL::Exception;
 
 sub as_list {
-    return wantarray ? @{$_[0]} : $_[0];
+    return $_[0];
 }
 
 sub CTOR {
--- a/Lib/IMPL/SQL/Schema/Column.pm	Thu May 12 08:57:19 2011 +0400
+++ b/Lib/IMPL/SQL/Schema/Column.pm	Mon May 16 04:30:38 2011 +0400
@@ -2,7 +2,7 @@
 package IMPL::SQL::Schema::Column;
 use parent qw(IMPL::Object IMPL::Object::Autofill);
 
-use IMPL::lang qw( :DEFAULT :compare :declare :constants );
+use IMPL::lang qw( :DEFAULT :compare :declare :constants :hash );
 use IMPL::Class::Property::Direct;
 use IMPL::Exception();
 
@@ -39,4 +39,32 @@
     );
 }
 
+sub SetType {
+	my ($this,$newType) = @_;
+	
+	$this->{$type} = $newType;
+}
+
+sub SetDefaultValue {
+	my ($this,$value) = @_;
+	
+	$this->{$defaultValue} = $value;
+}
+
+sub SetNullable {
+	my ($this, $value) = @_;
+	
+	$this->{$isNullable} = $value;
+}
+
+sub SetOptions {
+	my ($this,$diff) = @_;
+	
+	return unless ref $diff eq 'HASH';
+	
+	$this->tag({}) unless $this->tag;
+	
+	hashApply($this->tag,$diff);
+}
+
 1; 
--- a/Lib/IMPL/SQL/Schema/Constraint.pm	Thu May 12 08:57:19 2011 +0400
+++ b/Lib/IMPL/SQL/Schema/Constraint.pm	Mon May 16 04:30:38 2011 +0400
@@ -15,6 +15,8 @@
 
 public property columns => PROP_GET | PROP_LIST | PROP_OWNERSET;
 
+my %aliases;
+
 sub CTOR {
     my ($this,%args) = @_;
     is( $args{table}, typeof IMPL::SQL::Schema::Table ) or
@@ -29,7 +31,7 @@
     
     my $cn = UNIVERSAL::isa($Column,'IMPL::SQL::Schema::Column') ? $Column->name : $Column;
     
-    my $resolved = $Table->Column($cn);
+    my $resolved = $Table->GetColumn($cn);
     die new IMPL::InvalidOperationException("The column is not found in the table", $cn, $Table->name) if not $resolved;
     return $resolved;
 }
@@ -39,7 +41,7 @@
     
     my %Columns = map { $_, 1} @Columns;
     
-    return scalar(grep { $Columns{$_->name} } @{$this->columns}) == scalar(@Columns);
+    return scalar(grep { $Columns{$_->name} } $this->columns ) == scalar(@Columns);
 }
 
 sub uniqName {
@@ -68,4 +70,17 @@
 	
 	return 1;
 }
+
+sub ResolveAlias {
+	my ($self,$alias) = @_;
+	
+	return is($alias, typeof IMPL::SQL::Schema::Constraint) ? $alias : $aliases{$alias};
+}
+
+sub RegisterAlias {
+	my ($self,$alias) = @_;
+	
+	$aliases{$alias} = $self->typeof;
+}
+
 1;
--- a/Lib/IMPL/SQL/Schema/Constraint/ForeignKey.pm	Thu May 12 08:57:19 2011 +0400
+++ b/Lib/IMPL/SQL/Schema/Constraint/ForeignKey.pm	Mon May 16 04:30:38 2011 +0400
@@ -15,6 +15,7 @@
 }
 
 __PACKAGE__->PassThroughArgs;
+__PACKAGE__->RegisterAlias('fk');
 
 sub CTOR {
     my ($this,%args) = @_;    
@@ -26,7 +27,7 @@
     my @ReferencedColumns = map {IMPL::SQL::Schema::Constraint::ResolveColumn($args{'referencedTable'},$_)} @{$args{'referencedColumns'}};
     my $ForeingPK = $args{'referencedTable'}->primaryKey or die new Exception('The referenced table doesn\'t have a primary key');
     
-    scalar (@ReferencedColumns) == scalar(@{$this->columns}) or die new Exception('A foreing key columns doesn\'t match refenced columns');
+    scalar (@ReferencedColumns) == $this->columns->Count or die new Exception('A foreing key columns doesn\'t match refenced columns');
     my @ColumnsCopy = @ReferencedColumns;
     
     die new Exception('A foreing key columns doesn\'t match refenced columns') if grep { not $_->type->SameValue((shift @ColumnsCopy)->type)} @{$this->columns};
--- a/Lib/IMPL/SQL/Schema/Constraint/Index.pm	Thu May 12 08:57:19 2011 +0400
+++ b/Lib/IMPL/SQL/Schema/Constraint/Index.pm	Mon May 16 04:30:38 2011 +0400
@@ -3,12 +3,13 @@
 use parent qw(IMPL::SQL::Schema::Constraint);
 
 __PACKAGE__->PassThroughArgs;
+__PACKAGE__->RegisterAlias('index');
 
 sub CTOR {
     my $this = shift;
     
     my %colnames;
-    not grep { $colnames{$_}++ } @{$this->columns} or die new Exception('Each column in the index can occur only once');
+    not grep { $colnames{$_}++ } $this->columns or die new Exception('Each column in the index can occur only once');
 }
 
 1; 
--- a/Lib/IMPL/SQL/Schema/Constraint/PrimaryKey.pm	Thu May 12 08:57:19 2011 +0400
+++ b/Lib/IMPL/SQL/Schema/Constraint/PrimaryKey.pm	Mon May 16 04:30:38 2011 +0400
@@ -5,6 +5,7 @@
 use IMPL::Class::Property::Direct;
 
 __PACKAGE__->PassThroughArgs;
+__PACKAGE__->RegisterAlias('pk');
 
 BEGIN {
     public _direct property connectedFK => prop_get;
--- a/Lib/IMPL/SQL/Schema/Constraint/Unique.pm	Thu May 12 08:57:19 2011 +0400
+++ b/Lib/IMPL/SQL/Schema/Constraint/Unique.pm	Mon May 16 04:30:38 2011 +0400
@@ -3,5 +3,6 @@
 use parent qw(IMPL::SQL::Schema::Constraint::Index);
 
 __PACKAGE__->PassThroughArgs;
+__PACKAGE__->RegisterAlias('unique');
 
 1;
--- a/Lib/IMPL/SQL/Schema/Table.pm	Thu May 12 08:57:19 2011 +0400
+++ b/Lib/IMPL/SQL/Schema/Table.pm	Mon May 16 04:30:38 2011 +0400
@@ -122,25 +122,35 @@
 }
 
 sub AddConstraint {
-    my ($this,$Constraint) = @_;
-    
-    if (ref $Constraint eq 'HASH') {
-    	$Constraint = new IMPL::SQL::Schema::Constraint( %$Constraint, table => $this );
+	my $this = shift;
+    if (@_ == 1) {
+    	my ($Constraint) = @_;
+    	
+	    die new IMPL::InvalidArgumentException('The invalid parameter') if not is($Constraint,typeof IMPL::SQL::Schema::Constraint);
+	    
+	    $Constraint->table == $this or die new IMPL::InvalidOperationException('The constaint must belong to the target table');
+	    
+	    if (exists $this->{$constraints}->{$Constraint->name}) {
+	        die new IMPL::InvalidOperationException('The table already has the specified constraint',$Constraint->name);
+	    } else {
+	        if (UNIVERSAL::isa($Constraint,'IMPL::SQL::Schema::Constraint::PrimaryKey')) {
+	            not $this->{$primaryKey} or die new IMPL::InvalidOperationException('The table already has a primary key');
+	            $this->{$primaryKey} = $Constraint;
+	        }
+	        
+	        $this->{$constraints}->{$Constraint->name} = $Constraint;
+	    }
+    } elsif( @_ == 2) {
+    	my ($type,$params) = @_;
+    	
+    	$type = IMPL::SQL::Schema::Constraint->ResolveAlias($type) or
+    		die new IMPL::Exception("Can't resolve a constraint alias",$_[0]);
+    		
+    	$params->{table} = $this;
+    	
+    	$this->AddConstraint($type->new(%$params));
     } else {
-    	die new IMPL::InvalidArgumentException('The invalid parameter') if not is($Constraint,typeof IMPL::SQL::Schema::Constraint);
-    }
-    
-    $Constraint->table == $this or die new IMPL::InvalidOperationException('The constaint must belong to the target table');
-    
-    if (exists $this->{$constraints}->{$Constraint->name}) {
-        die new IMPL::InvalidOperationException('The table already has the specified constraint',$Constraint->name);
-    } else {
-        if (UNIVERSAL::isa($Constraint,'IMPL::SQL::Schema::Constraint::PrimaryKey')) {
-            not $this->{$primaryKey} or die new IMPL::InvalidOperationException('The table already has a primary key');
-            $this->{$primaryKey} = $Constraint;
-        }
-        
-        $this->{$constraints}->{$Constraint->name} = $Constraint;
+    	die new IMPL::Exception("Wrong arguments number",scalar(@_));
     }
 }
 
@@ -191,7 +201,7 @@
     my ($this,$table,@ColumnList) = @_;
     $table->primaryKey or die new IMPL::InvalidOperationException('The referenced table must have a primary key');
     my $constraintName = $this->{$name}.'_'.$table->name.'_FK_'.join('_',map {ref $_ ? $_->name : $_} @ColumnList);
-    $this->AddConstraint(new IMPL::SQL::Schema::Constraint::ForeignKey(name => $constraintName, table => $this, columns => \@ColumnList, referencedTable => $table, referencedColumns => scalar $table->primaryKey->columns));
+    $this->AddConstraint(new IMPL::SQL::Schema::Constraint::ForeignKey(name => $constraintName, table => $this, columns => \@ColumnList, referencedTable => $table, referencedColumns => $table->primaryKey->columns->as_list));
 }
 
 sub Dispose {
--- a/Lib/IMPL/SQL/Schema/Traits.pm	Thu May 12 08:57:19 2011 +0400
+++ b/Lib/IMPL/SQL/Schema/Traits.pm	Mon May 16 04:30:38 2011 +0400
@@ -6,9 +6,11 @@
 use parent qw(IMPL::Object);
 use IMPL::Code::Loader();
 
-BEGIN {
-	IMPL::Code::Loader->Provide(__PACKAGE__);
-}
+# 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();
 
 ###################################################
 
@@ -68,7 +70,11 @@
 	my ($this, $name, $columns) = @_;
 	
 	$this->{name} = $name;
-	$$this->{columns} = $columns; # list of columnNames
+	$this->{columns} = $columns; # list of columnNames
+}
+
+sub constraintClass  {
+	die new IMPL::NotImplementedException();
 }
 
 ##################################################
@@ -79,6 +85,8 @@
 
 __PACKAGE__->PassThroughArgs;
 
+use constant { constraintClass => typeof IMPL::SQL::Schema::Constraint::PrimaryKey };
+
 ##################################################
 
 package IMPL::SQL::Schema::Traits::Index;
@@ -87,6 +95,8 @@
 
 __PACKAGE__->PassThroughArgs;
 
+use constant { constraintClass => typeof IMPL::SQL::Schema::Constraint::Index };
+
 ##################################################
 
 package IMPL::SQL::Schema::Traits::Unique;
@@ -95,6 +105,8 @@
 
 __PACKAGE__->PassThroughArgs;
 
+use constant { constraintClass => typeof IMPL::SQL::Schema::Constraint::Unique };
+
 ##################################################
 
 package IMPL::SQL::Schema::Traits::ForeignKey;
@@ -105,6 +117,8 @@
 	foreignColumns
 );
 
+use constant { constraintClass => typeof IMPL::SQL::Schema::Constraint::ForeignKey };
+
 our %CTOR = (
 	'IMPL::SQL::Schema::Traits::Constraint' => sub { @_[0..1] }
 );
@@ -274,10 +288,10 @@
 BEGIN {
 	public property tableName => prop_get | owner_set;
 	public property columnName => prop_get | owner_set;
-	public property columnType => prop_get | owner_set;
-	public property defaultValue => prop_get | owner_set;
-	public property isNullable => prop_get | owner_set;
-	public property options => prop_get | owner_set;
+	public property columnType => prop_all;
+	public property defaultValue => prop_all;
+	public property isNullable => prop_all;
+	public property options => prop_all; # hash diff format, (keys have a prefix '+' - add or update value, '-' remove value)
 }
 
 sub CTOR {
@@ -297,10 +311,10 @@
 	
 	return eval {
 		my $column = $schema->GetTable($this->tableName)->GetColumn($this->columnName);
-		$column->SetType($this->columnType) if $this->columnType;
-		$column->SetNullable($this->isNullable) if $this->isNullable;
-		$column->SetDefaultValue($this->defaultValue) if $this->defaultValue;
-		$column->SetOptions($this->options) if $this->options;
+		$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;
@@ -335,7 +349,7 @@
 	local $@;
 	
 	return eval {
-		$schema->GetTable($this->tableName)->AddConstraint($this->constraint);
+		$schema->GetTable($this->tableName)->AddConstraint($this->constraint->constraintClass, $this->constraint);
 		return 1;
 	} || 0;
 	
--- a/Lib/IMPL/SQL/Schema/Traits/Diff.pm	Thu May 12 08:57:19 2011 +0400
+++ b/Lib/IMPL/SQL/Schema/Traits/Diff.pm	Mon May 16 04:30:38 2011 +0400
@@ -1,7 +1,7 @@
 package IMPL::SQL::Schema::Traits::Diff;
 use strict;
 use warnings;
-use IMPL::lang;
+use IMPL::lang qw(:compare :hash is);
 
 use IMPL::SQL::Schema();
 use IMPL::SQL::Schema::Traits();
@@ -25,24 +25,26 @@
 		
 		if (not $dstTable) {
 			# if a source table doesn't have a corresponding destination table, it should be deleted
-			push @operations, new IMPL::SQL::Schema::Traits::DropTable()
+			push @operations, new IMPL::SQL::Schema::Traits::DropTable($srcTable->name);
 		} else {
 			# a source table needs to be updated
 			push @operations, $self->_DiffTables($srcTable,$dstTable);
 		}
 		
-		foreach my $tbl ( values %dstTables ) {
-			push @operations, new IMPL::SQL::Schema::Traits::CreateTable(
-				new IMPL::SQL::Schema::Traits::Table(
-					$tbl->name,
-					[ map _Column2Traits($_), $tbl->columns ],
-					[ map _Constraint2Traits($_), $tbl->constraints],
-					$tbl->{tag}
-				)
+	}
+	
+	foreach my $tbl ( values %dstTables ) {
+		push @operations, new IMPL::SQL::Schema::Traits::CreateTable(
+			new IMPL::SQL::Schema::Traits::Table(
+				$tbl->name,
+				[ map _Column2Traits($_), @{$tbl->columns} ],
+				[ map _Constraint2Traits($_), $tbl->GetConstraints()],
+				$tbl->{tag}
 			)
-		}
+		)
+	}
 	
-	}  
+	return \@operations;
 }
 
 sub _DiffTables {
@@ -58,12 +60,12 @@
 		if ( my $cnDst = delete $dstConstraints{$cnSrcName} ) {
 			unless ( $srcConstraints{$cnSrcName}->SameValue($cnDst) ) {
 				push @dropConstraints,
-					IMPL::SQL::Schema::Traits::AlterTableDropConstraint->new( $src->name, $cnSrcName );
+					new IMPL::SQL::Schema::Traits::AlterTableDropConstraint( $src->name, $cnSrcName );
 				push @createConstraints,
-					IMPL::SQL::Schema::Traits::AlterTableAddConstraint->new( $dst->name, _Constraint2Traits($cnDst) );
+					new IMPL::SQL::Schema::Traits::AlterTableAddConstraint( $dst->name, _Constraint2Traits($cnDst) );
 			}
 		} else {
-			push @dropConstraints, IMPL::SQL::Schema::Traits::AlterTableDropConstrait->new( $src->name, $cnSrcName );
+			push @dropConstraints,new IMPL::SQL::Schema::Traits::AlterTableDropConstrait( $src->name, $cnSrcName );
 		}
 	}
 	
@@ -81,52 +83,82 @@
 		($col->name, { column => $col, index => $_ })
 	} 0 .. $dst->ColumnsCount-1;
 	
-	# get changed and
-	
 	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->{update} = 1 unless $infoDst->{column}->SameValue($colSrc);
+			$infoDst->{prevColumn} = $colSrc;
 			push @columns,$infoDst;
 		} else {
-			push @deleteColumns, IMPL::SQL::Schema::Traits::AlterTableDropColumn($src->name,$colSrc->name);
+			push @deleteColumns,new IMPL::SQL::Schema::Traits::AlterTableDropColumn($src->name,$colSrc->name);
 		}
 	}
 	
-	splice(@columns,$_->{index},0,$_) foreach ( sort { $a->{index} <=> $b->{index} } values %dstColumnIndexes );
+	#insert new columns at specified positions
+	foreach ( sort { $a->{index} <=> $b->{index} } values %dstColumnIndexes ) {
+		splice(@columns,$_->{index},0,$_);
+		push @addColumns, new IMPL::SQL::Schema::Traits::AlterTableAddColumn($src->name, _Column2Traits( $_->{column}, position => $_->{index} ));
+	}
 	
+	# remember old indexes
 	for(my $i =0; $i< @columns; $i ++) {
-		
+		$columns[$i]->{prevIndex} = $i;
 	}
 	
-	# determine constraints to be dropped,
-	# drop columns
-	# create columns
-	# update/reorder columns
-	# create constraints
+	# 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 = new IMPL::SQL::Schema::Traits::AlterTableChangeColumn($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},$info->{column});
+			$op->options(\%diff) if %diff;
+			
+			push @updateColumns, $op;
+		}
+	}
+	
+	my @result = (@dropConstraints, @deleteColumns, @addColumns, @updateColumns, @createConstraints); 
+	
+	return @result;
 }
 
 sub _Column2Traits {
-	my ($column) = @_;
+	my ($column,%options) = @_;
 	
-	return new IMPL::SQL::Schema::Traits::Columns(
+	return new IMPL::SQL::Schema::Traits::Column(
 		$column->name,
 		$column->type,
-		$column->isNullable,
-		$column->defaultValue,
-		$column->tag
+		isNullable => $column->isNullable,
+		defaultValue => $column->defaultValue,
+		tag => $column->tag,
+		%options
 	);
 }
 
 sub _Constraint2Traits {
 	my ($constraint) = @_;
 	
-	return new IMPL::SQL::Schema::Traits::Constraint(
+	my $map = {
+		typeof IMPL::SQL::Schema::Constraint::ForeignKey , typeof IMPL::SQL::Schema::Traits::ForeignKey,
+		typeof IMPL::SQL::Schema::Constraint::PrimaryKey , typeof IMPL::SQL::Schema::Traits::PrimaryKey,
+		typeof IMPL::SQL::Schema::Constraint::Unique , typeof IMPL::SQL::Schema::Traits::Unique,
+		typeof IMPL::SQL::Schema::Constraint::Index , typeof IMPL::SQL::Schema::Traits::Index
+	};
+	
+	my $class = $map->{$constraint->typeof} or die new IMPL::Exception("Can't map the constraint",$constraint->typeof);
+	
+	return $class->new(
 		$constraint->name,
-		[ map $_->name, $_->columns ]
+		[ map $_->name, $constraint->columns ]
 	)
 }
 
--- a/Lib/IMPL/lang.pm	Thu May 12 08:57:19 2011 +0400
+++ b/Lib/IMPL/lang.pm	Mon May 16 04:30:38 2011 +0400
@@ -42,6 +42,15 @@
 		qw(
 		  &equals
 		  &equals_s
+		  &hashCompare
+		  )
+	],
+	hash => [
+		qw(
+		  &hashApply
+		  &hashMerge
+		  &hashDiff
+		  &hashCompare
 		  )
 	]
 );
@@ -129,4 +138,58 @@
 	}
 }
 
+sub hashDiff {
+	my ($src,$dst) = @_;
+	
+	$dst = { %$dst };
+	
+	my %result;
+	
+	foreach my $key ( keys %$src ) {
+		if (exists $dst->{$key}) {
+			$result{"+$key"} = $dst->{$key} unless equals_s($dst->{$key}, $src->{$key});
+			delete $dst->{$key};
+		} else {
+			$result{"-$key"} = 1;
+		}
+	}
+	
+	$result{"+$_"} = $dst->{$_} foreach keys %$dst;
+	
+	return \%result;
+}
+
+sub hashMerge {
+	return hashApply( { %{$_[0]} }, $_[1] );
+}
+
+sub hashApply {
+	my ($target,$diff) = @_;
+	
+	while ( my ($key,$value) = each %$diff) {
+		$key =~ /^(\+|-)?(.*)$/;
+		my $op = $1 || '+';
+		$key = $2;
+		
+		if ($op eq '-') {
+			delete $target->{$key};
+		} else {
+			$target->{$key} = $value;
+		}
+	}
+	
+	return $target;
+}
+
+sub hashCompare {
+	my ($l,$r,$cmp) = @_;
+	
+	$cmp ||= \&equals_s;
+	
+	return 0 unless scalar keys %$l == scalar keys %$r;
+	&$cmp($l->{$_},$r->{$_}) || return 0 foreach keys %$l;
+	
+	return 1;
+}
+
 1;
--- a/_test/SQL.t	Thu May 12 08:57:19 2011 +0400
+++ b/_test/SQL.t	Mon May 16 04:30:38 2011 +0400
@@ -8,6 +8,7 @@
 run_plan( qw(
     Test::SQL::Schema
     Test::SQL::Traits
+    Test::SQL::Diff
 ) );
 
 1;
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/_test/Test/Lang.pm	Mon May 16 04:30:38 2011 +0400
@@ -0,0 +1,77 @@
+package Test::Lang;
+use strict;
+use warnings;
+
+use parent qw(IMPL::Test::Unit);
+
+use IMPL::Test qw(test failed assert);
+use IMPL::lang qw(:hash :compare);
+
+__PACKAGE__->PassThroughArgs;
+
+test equals => sub {
+	assert( equals(1,1) );
+	assert( !equals(1,2) );
+	
+	{
+		my $warns = 0;
+		local $SIG{__WARN__} = sub { $warns++ };
+		
+		assert( !equals("1","2") );
+		assert( equals("sfds","zxcvgfd") );
+		assert( $warns == 2);
+	}
+	
+	assert( equals(undef,undef) );
+	assert( !equals(1,undef) );
+	assert( !equals(undef,"zcx") );
+};
+
+test equals_s => sub {
+	assert( equals_s(1,1) );
+	assert( !equals_s(1,2) );
+	
+	assert( !equals_s("1","2") );
+	assert( !equals_s("sfds","zxcvgfd") );
+	
+	assert( equals_s(undef,undef) );
+	assert( !equals_s(1,undef) );
+	assert( !equals_s(undef,"zcx") );
+	
+	assert( equals_s("qwerty","qwerty") );
+};
+
+test hash => sub {
+	
+	my %a = (
+		a => 'a',
+		b => 'b',
+		c => 'c'
+	);
+	
+	my %b = (
+		a => 'a',
+		c => 'z',
+		x => 'x',
+	);
+	
+	my %diff = (
+		'-b' => 1,
+		'+c' => 'z',
+		'+x' => 'x'
+	);
+	
+	
+	assert( ! hashCompare(\%a,\%b)  );
+	assert( hashCompare(\%a,\%a) );
+	
+	my $res = hashDiff(\%a,\%b);
+	
+	assert( ! hashCompare({},$res) );
+	assert( hashCompare($res,\%diff) );
+	
+	assert( hashCompare( \%b, hashMerge(\%a,\%diff) ) );
+	
+};
+
+1;
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/_test/Test/SQL/Diff.pm	Mon May 16 04:30:38 2011 +0400
@@ -0,0 +1,46 @@
+package Test::SQL::Diff;
+use strict;
+use warnings;
+use parent qw(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 );
+	
+	$schemaSrc->AddTable({
+		name => 'User',
+		columns => [
+			{ name => 'name', type => Varchar(255) }
+		]
+	});
+	
+	my $schemaDst = new IMPL::SQL::Schema(name => 'simple', version => 2 );
+	
+	my $users = $schemaDst->AddTable({
+		name => 'User',
+		columns => [
+			{ name => 'id', type => Integer },
+			{ name => 'login', type => Varchar(255) },
+			{ name => 'description', type => Text, isNullable => 1 }
+		]
+	});
+	
+	$users->SetPrimaryKey('id');
+	$users->AddConstraint( unique => { name => 'unique_user_login', columns => ['login'] } );
+	
+	warn Dumper(IMPL::SQL::Schema::Traits::Diff->Diff($schemaSrc,$schemaDst));
+	
+	$schemaSrc->Dispose;
+	$schemaDst->Dispose;
+	
+};
+
+
+1;
\ No newline at end of file
--- a/_test/Test/SQL/Schema.pm	Thu May 12 08:57:19 2011 +0400
+++ b/_test/Test/SQL/Schema.pm	Mon May 16 04:30:38 2011 +0400
@@ -79,7 +79,7 @@
 	my $tableUser = $this->schemaDB->GetTable('User');
 	my $tableRole = $this->schemaDB->GetTable('Role');
 	
-	$tableUser->SetPrimaryKey('Id');
+	$tableUser->AddConstraint( pk => { columns => ['Id'], name => 'PK' });
 	$tableRole->SetPrimaryKey('Id');
 	
 	$tableUser->primaryKey->HasColumn('Id') or failed "A primary key of 'User' table should contain 'Id' column";
--- a/_test/Test/SQL/Traits.pm	Thu May 12 08:57:19 2011 +0400
+++ b/_test/Test/SQL/Traits.pm	Mon May 16 04:30:38 2011 +0400
@@ -45,7 +45,7 @@
 		)
 	);
 	
-	my $column = $table->Column('id') or failed "Column not found";
+	my $column = $table->GetColumn('id') or failed "Column not found";
 	
 	assert( $column->name eq 'id');
 	assert( $column->type->SameValue(Integer()) );
@@ -58,7 +58,7 @@
 		)
 	);
 	
-	$column = $table->Column('name');
+	$column = $table->GetColumn('name');
 	
 	assert($column);
 	assert($column->name eq 'name');
@@ -81,11 +81,11 @@
 	
 	assert( $table->ColumnsCount == 3 );
 	
-	assert( my $column = $table->Column('id') );
+	assert( my $column = $table->GetColumn('id') );
 	assert($column->type->SameValue(Varchar(64)));
 	assert(not $column->isNullable);
 	
-	assert( $column = $table->Column('role') );
+	assert( $column = $table->GetColumn('role') );
 	assert( $column->defaultValue eq 'user' );
 };
 
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/_test/lang.t	Mon May 16 04:30:38 2011 +0400
@@ -0,0 +1,12 @@
+#!/usr/bin/perl -w
+use strict;
+use lib '../Lib';
+use lib '.';
+
+use IMPL::Test qw(run_plan);
+
+run_plan( qw(
+    Test::Lang
+) );
+
+1;