| 
271
 | 
     1 package IMPL::SQL::Schema::Diff;
 | 
| 
 | 
     2 use strict;
 | 
| 
 | 
     3 use warnings;
 | 
| 
315
 | 
     4 use IMPL::lang qw(:compare :hash is typeof);
 | 
| 
271
 | 
     5 
 | 
| 
 | 
     6 use IMPL::SQL::Schema::Traits();
 | 
| 
 | 
     7 
 | 
| 
 | 
     8 use IMPL::require {
 | 
| 
 | 
     9     Schema => 'IMPL::SQL::Schema',
 | 
| 
 | 
    10     ForeignKey => '-IMPL::SQL::Schema::Constraint::ForeignKey',
 | 
| 
 | 
    11     PrimaryKey => '-IMPL::SQL::Schema::Constraint::PrimaryKey',
 | 
| 
 | 
    12     UniqueConstraint =>'-IMPL::SQL::Schema::Constraint::Unique',
 | 
| 
 | 
    13     Index => '-IMPL::SQL::Schema::Constraint::Index',
 | 
| 
 | 
    14     TraitsForeignKey => '-IMPL::SQL::Schema::Traits::ForeignKey',
 | 
| 
 | 
    15     TraitsPrimaryKey => '-IMPL::SQL::Schema::Traits::PrimaryKey',
 | 
| 
 | 
    16     TraitsUnique => '-IMPL::SQL::Schema::Traits::Unique',
 | 
| 
 | 
    17     TraitsIndex => '-IMPL::SQL::Schema::Traits::Index',
 | 
| 
 | 
    18     TraitsDropTable => '-IMPL::SQL::Schema::Traits::DropTable',
 | 
| 
 | 
    19     TraitsCreateTable => '-IMPL::SQL::Schema::Traits::CreateTable',
 | 
| 
 | 
    20     TraitsTable => '-IMPL::SQL::Schema::Traits::Table',
 | 
| 
 | 
    21     TraitsColumn => '-IMPL::SQL::Schema::Traits::Column',
 | 
| 
 | 
    22     TraitsAlterTableDropConstraint => '-IMPL::SQL::Schema::Traits::AlterTableDropConstraint',
 | 
| 
 | 
    23     TraitsAlterTableAddConstraint => '-IMPL::SQL::Schema::Traits::AlterTableAddConstraint',
 | 
| 
 | 
    24     TraitsAlterTableDropColumn => '-IMPL::SQL::Schema::Traits::AlterTableDropColumn',
 | 
| 
 | 
    25     TraitsAlterTableAddColumn => '-IMPL::SQL::Schema::Traits::AlterTableAddColumn',
 | 
| 
 | 
    26     TraitsAlterTableChangeColumn => '-IMPL::SQL::Schema::Traits::AlterTableChangeColumn',
 | 
| 
 | 
    27     Exception => 'IMPL::Exception',
 | 
| 
 | 
    28     ArgException => '-IMPL::InvalidArgumentException'
 | 
| 
 | 
    29 };
 | 
| 
 | 
    30 
 | 
| 
 | 
    31 sub Diff {
 | 
| 
 | 
    32     my ($self,$src,$dst) = @_;
 | 
| 
 | 
    33     
 | 
| 
 | 
    34     die ArgException->new( src => "A valid source schema is required") unless is($src,Schema);
 | 
| 
 | 
    35     die ArgException->new( dst => "A valid desctination schema is requried" ) unless is($src,Schema);
 | 
| 
 | 
    36     
 | 
| 
 | 
    37     my %dstTables = map { $_->name, $_ } $dst->GetTables;
 | 
| 
 | 
    38     
 | 
| 
 | 
    39     my @operations;
 | 
| 
 | 
    40     
 | 
| 
 | 
    41     foreach my $srcTable ( $src->GetTables) {
 | 
| 
 | 
    42         my $dstTable = delete $dstTables{$srcTable->name};
 | 
| 
 | 
    43         
 | 
| 
 | 
    44         if (not $dstTable) {
 | 
| 
 | 
    45             # if a source table doesn't have a corresponding destination table, it should be deleted
 | 
| 
 | 
    46             push @operations, TraitsDropTable->new($srcTable->name);
 | 
| 
 | 
    47         } else {
 | 
| 
 | 
    48             # a source table needs to be updated
 | 
| 
 | 
    49             push @operations, $self->_DiffTables($srcTable,$dstTable);
 | 
| 
 | 
    50         }
 | 
| 
 | 
    51         
 | 
| 
 | 
    52     }
 | 
| 
 | 
    53     
 | 
| 
 | 
    54     foreach my $tbl ( values %dstTables ) {
 | 
| 
 | 
    55         push @operations, TraitsCreateTable->new(
 | 
| 
 | 
    56             TraitsTable->new(
 | 
| 
 | 
    57                 $tbl->name,
 | 
| 
 | 
    58                 [ map _Column2Traits($_), @{$tbl->columns} ],
 | 
| 
 | 
    59                 [ map _Constraint2Traits($_), $tbl->GetConstraints()],
 | 
| 
 | 
    60                 $tbl->{tag}
 | 
| 
 | 
    61             )
 | 
| 
 | 
    62         )
 | 
| 
 | 
    63     }
 | 
| 
 | 
    64     
 | 
| 
 | 
    65     return \@operations;
 | 
| 
 | 
    66 }
 | 
| 
 | 
    67 
 | 
| 
 | 
    68 sub _DiffTables {
 | 
| 
 | 
    69     my ($self,$src,$dst) = @_;
 | 
| 
 | 
    70     
 | 
| 
 | 
    71     my @dropConstraints;
 | 
| 
 | 
    72     my @createConstraints;
 | 
| 
 | 
    73     
 | 
| 
 | 
    74     my %srcConstraints = map { $_->name, $_ } $src->GetConstraints();
 | 
| 
 | 
    75     my %dstConstraints = map { $_->name, $_ } $dst->GetConstraints();
 | 
| 
 | 
    76     
 | 
| 
 | 
    77     foreach my $cnSrcName (keys %srcConstraints) {
 | 
| 
 | 
    78         if ( my $cnDst = delete $dstConstraints{$cnSrcName} ) {
 | 
| 
 | 
    79             unless ( $srcConstraints{$cnSrcName}->SameValue($cnDst) ) {
 | 
| 
 | 
    80                 push @dropConstraints,
 | 
| 
 | 
    81                     TraitsAlterTableDropConstraint->new( $src->name, $cnSrcName );
 | 
| 
 | 
    82                 push @createConstraints,
 | 
| 
 | 
    83                     TraitsAlterTableAddConstraint->new( $dst->name, _Constraint2Traits($cnDst) );
 | 
| 
 | 
    84             }
 | 
| 
 | 
    85         } else {
 | 
| 
 | 
    86             push @dropConstraints,TraitsAlterTableDropConstraint->new( $src->name, $cnSrcName );
 | 
| 
 | 
    87         }
 | 
| 
 | 
    88     }
 | 
| 
 | 
    89     
 | 
| 
 | 
    90     foreach my $cnDst (values %dstConstraints) {
 | 
| 
 | 
    91         push @createConstraints,
 | 
| 
 | 
    92         TraitsAlterTableAddConstraint->new( $dst->name, _Constraint2Traits($cnDst) );
 | 
| 
 | 
    93     }
 | 
| 
 | 
    94     
 | 
| 
 | 
    95     my @deleteColumns;
 | 
| 
 | 
    96     my @addColumns;
 | 
| 
 | 
    97     my @updateColumns;
 | 
| 
 | 
    98     
 | 
| 
 | 
    99     my %dstColumnIndexes = map {
 | 
| 
 | 
   100         my $col = $dst->GetColumnAt($_);
 | 
| 
 | 
   101         ($col->name, { column => $col, index => $_ })
 | 
| 
 | 
   102     } 0 .. $dst->ColumnsCount-1;
 | 
| 
 | 
   103     
 | 
| 
 | 
   104     my @columns;
 | 
| 
 | 
   105     
 | 
| 
 | 
   106     # remove old columns, mark for update changed columns
 | 
| 
 | 
   107     for( my $i=0; $i < $src->ColumnsCount; $i++) {
 | 
| 
 | 
   108         my $colSrc = $src->GetColumnAt($i);
 | 
| 
 | 
   109         
 | 
| 
 | 
   110         if ( my $infoDst = delete $dstColumnIndexes{$colSrc->name} ) {
 | 
| 
 | 
   111             $infoDst->{prevColumn} = $colSrc;
 | 
| 
 | 
   112             push @columns,$infoDst;
 | 
| 
 | 
   113         } else {
 | 
| 
 | 
   114             push @deleteColumns,TraitsAlterTableDropColumn->new($src->name,$colSrc->name);
 | 
| 
 | 
   115         }
 | 
| 
 | 
   116     }
 | 
| 
 | 
   117     
 | 
| 
 | 
   118     #insert new columns at specified positions
 | 
| 
 | 
   119     foreach ( sort { $a->{index} <=> $b->{index} } values %dstColumnIndexes ) {
 | 
| 
 | 
   120         splice(@columns,$_->{index},0,$_);
 | 
| 
 | 
   121         push @addColumns, TraitsAlterTableAddColumn->new($src->name, _Column2Traits( $_->{column}, position => $_->{index} ));
 | 
| 
 | 
   122     }
 | 
| 
 | 
   123     
 | 
| 
 | 
   124     # remember old indexes
 | 
| 
 | 
   125     for(my $i =0; $i< @columns; $i ++) {
 | 
| 
 | 
   126         $columns[$i]->{prevIndex} = $i;
 | 
| 
 | 
   127     }
 | 
| 
 | 
   128     
 | 
| 
 | 
   129     # reorder columns
 | 
| 
 | 
   130     @columns = sort { $a->{index} <=> $b->{index} } @columns;
 | 
| 
 | 
   131     
 | 
| 
 | 
   132     foreach my $info (@columns) {
 | 
| 
 | 
   133         if ($info->{prevColumn} && ( !$info->{column}->SameValue($info->{prevColumn}) or $info->{index}!= $info->{prevIndex} ) ) {
 | 
| 
 | 
   134             my $op = TraitsAlterTableChangeColumn->new($src->name,$info->{column}->name);
 | 
| 
 | 
   135 
 | 
| 
 | 
   136             $op->position( $info->{index} ) unless $info->{prevIndex} == $info->{index};
 | 
| 
 | 
   137             $op->isNullable( $info->{column}->isNullable ) unless equals($info->{column}->isNullable,$info->{prevColumn}->isNullable);
 | 
| 
 | 
   138             $op->defaultValue( $info->{column}->defaultValue ) unless equals($info->{column}->defaultValue, $info->{prevColumn}->defaultValue);
 | 
| 
 | 
   139             
 | 
| 
 | 
   140             my $diff = hashDiff($info->{prevColumn}->tag,$info->{column}->tag);
 | 
| 
 | 
   141             $op->options($diff) if %$diff;
 | 
| 
 | 
   142             
 | 
| 
 | 
   143             push @updateColumns, $op;
 | 
| 
 | 
   144         }
 | 
| 
 | 
   145     }
 | 
| 
 | 
   146     
 | 
| 
 | 
   147     my @result = (@dropConstraints, @deleteColumns, @addColumns, @updateColumns, @createConstraints); 
 | 
| 
 | 
   148     
 | 
| 
 | 
   149     return @result;
 | 
| 
 | 
   150 }
 | 
| 
 | 
   151 
 | 
| 
 | 
   152 sub _Column2Traits {
 | 
| 
 | 
   153     my ($column,%options) = @_;
 | 
| 
 | 
   154     
 | 
| 
 | 
   155     return TraitsColumn->new(
 | 
| 
 | 
   156         $column->name,
 | 
| 
 | 
   157         $column->type,
 | 
| 
 | 
   158         isNullable => $column->isNullable,
 | 
| 
 | 
   159         defaultValue => $column->defaultValue,
 | 
| 
 | 
   160         tag => $column->tag,
 | 
| 
 | 
   161         %options
 | 
| 
 | 
   162     );
 | 
| 
 | 
   163 }
 | 
| 
 | 
   164 
 | 
| 
 | 
   165 sub _Constraint2Traits {
 | 
| 
 | 
   166     my ($constraint) = @_;
 | 
| 
 | 
   167     
 | 
| 
 | 
   168     my $map = {
 | 
| 
 | 
   169         ForeignKey , TraitsForeignKey,
 | 
| 
 | 
   170         PrimaryKey , TraitsPrimaryKey,
 | 
| 
 | 
   171         UniqueConstraint , TraitsUnique,
 | 
| 
 | 
   172         Index , TraitsIndex
 | 
| 
 | 
   173     };
 | 
| 
 | 
   174     
 | 
| 
315
 | 
   175     my $class = $map->{typeof($constraint)} or die Exception->new("Can't map the constraint",typeof($constraint));
 | 
| 
271
 | 
   176     
 | 
| 
 | 
   177     if ($class eq TraitsForeignKey) {
 | 
| 
 | 
   178         return $class->new(
 | 
| 
 | 
   179             $constraint->name,
 | 
| 
 | 
   180             [ map $_->name, $constraint->columns ],
 | 
| 
 | 
   181             $constraint->referencedPrimaryKey->table->name,
 | 
| 
 | 
   182             [ map $_->name, $constraint->referencedPrimaryKey->columns ]
 | 
| 
 | 
   183         );
 | 
| 
 | 
   184     } else {
 | 
| 
 | 
   185         return $class->new(
 | 
| 
 | 
   186             $constraint->name,
 | 
| 
 | 
   187             [ map $_->name, $constraint->columns ]
 | 
| 
 | 
   188         );
 | 
| 
 | 
   189     }
 | 
| 
 | 
   190 }
 | 
| 
 | 
   191 
 | 
| 
 | 
   192 1;
 |