# HG changeset patch # User sourcer # Date 1305505838 -14400 # Node ID 6148f89bb7bf9a37747e4800a5f76c9c648e4c1a # Parent 1f7a6d762394001be78dab21ccc1fe344cf4a52e IMPL::SQL::Schema::Traits::Diff alfa version IMPL::lang added hash traits diff -r 1f7a6d762394 -r 6148f89bb7bf Lib/IMPL/ORM/Schema/TransformToSQL.pm --- 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({ diff -r 1f7a6d762394 -r 6148f89bb7bf Lib/IMPL/Object/List.pm --- 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 { diff -r 1f7a6d762394 -r 6148f89bb7bf Lib/IMPL/SQL/Schema/Column.pm --- 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; diff -r 1f7a6d762394 -r 6148f89bb7bf Lib/IMPL/SQL/Schema/Constraint.pm --- 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; diff -r 1f7a6d762394 -r 6148f89bb7bf Lib/IMPL/SQL/Schema/Constraint/ForeignKey.pm --- 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}; diff -r 1f7a6d762394 -r 6148f89bb7bf Lib/IMPL/SQL/Schema/Constraint/Index.pm --- 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; diff -r 1f7a6d762394 -r 6148f89bb7bf Lib/IMPL/SQL/Schema/Constraint/PrimaryKey.pm --- 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; diff -r 1f7a6d762394 -r 6148f89bb7bf Lib/IMPL/SQL/Schema/Constraint/Unique.pm --- 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; diff -r 1f7a6d762394 -r 6148f89bb7bf Lib/IMPL/SQL/Schema/Table.pm --- 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 { diff -r 1f7a6d762394 -r 6148f89bb7bf Lib/IMPL/SQL/Schema/Traits.pm --- 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; diff -r 1f7a6d762394 -r 6148f89bb7bf Lib/IMPL/SQL/Schema/Traits/Diff.pm --- 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 ] ) } diff -r 1f7a6d762394 -r 6148f89bb7bf Lib/IMPL/lang.pm --- 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; diff -r 1f7a6d762394 -r 6148f89bb7bf _test/SQL.t --- 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; diff -r 1f7a6d762394 -r 6148f89bb7bf _test/Test/Lang.pm --- /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 diff -r 1f7a6d762394 -r 6148f89bb7bf _test/Test/SQL/Diff.pm --- /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 diff -r 1f7a6d762394 -r 6148f89bb7bf _test/Test/SQL/Schema.pm --- 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"; diff -r 1f7a6d762394 -r 6148f89bb7bf _test/Test/SQL/Traits.pm --- 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' ); }; diff -r 1f7a6d762394 -r 6148f89bb7bf _test/lang.t --- /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;