view Lib/IMPL/SQL/Schema/Diff.pm @ 381:ced5937ff21a

Custom getters/setters support method names in theirs definitions Initial support for localizable labels in DOM schemas
author cin
date Wed, 22 Jan 2014 16:56:10 +0400
parents 77df11605d3a
children
line wrap: on
line source

package IMPL::SQL::Schema::Diff;
use strict;
use warnings;
use IMPL::lang qw(:compare :hash is typeof);

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->{typeof($constraint)} or die Exception->new("Can't map the constraint",typeof($constraint));
    
    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;