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