annotate Lib/IMPL/SQL/Schema/Traits/Diff.pm @ 250:129e48bb5afb

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