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