annotate Lib/IMPL/SQL/Schema/Traits/Diff.pm @ 388:648dfaf642e0

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