Mercurial > pub > Impl
annotate Lib/IMPL/SQL/Schema/Table.pm @ 360:39842eedd923
language detection from request
author | sergey |
---|---|
date | Tue, 26 Nov 2013 03:22:44 +0400 |
parents | 77df11605d3a |
children |
rev | line source |
---|---|
278 | 1 package IMPL::SQL::Schema::Table; |
49 | 2 use strict; |
3 | |
278 | 4 use IMPL::lang qw(is); |
5 use IMPL::Const qw(:prop); | |
6 use IMPL::declare { | |
7 base => [ | |
8 'IMPL::Object' => undef, | |
9 'IMPL::Object::Disposable' => undef | |
10 ], | |
11 props => [ | |
12 name => PROP_RO | PROP_DIRECT, | |
13 schema => PROP_RO | PROP_DIRECT, | |
14 columns => PROP_RO | PROP_DIRECT, | |
15 constraints => PROP_RO | PROP_DIRECT, | |
16 columnsByName => PROP_RO | PROP_DIRECT, | |
17 primaryKey => PROP_RO | PROP_DIRECT, | |
18 tag => PROP_RW | PROP_DIRECT, | |
19 ] | |
20 }; | |
165 | 21 |
167 | 22 require IMPL::SQL::Schema::Column; |
23 require IMPL::SQL::Schema::Constraint; | |
24 require IMPL::SQL::Schema::Constraint::PrimaryKey; | |
25 require IMPL::SQL::Schema::Constraint::ForeignKey; | |
165 | 26 |
49 | 27 sub CTOR { |
28 my ($this,%args) = @_; | |
29 | |
165 | 30 $this->{$name} = $args{'name'} or die new IMPL::InvalidArgumentException('a table name is required'); |
31 $this->{$schema} = $args{'schema'} or die new IMPL::InvalidArgumentException('a parent schema is required'); | |
32 | |
33 if ($args{columns}) { | |
194 | 34 die new IMPL::InvalidOperationException('A columns property should be a reference to an array') unless ref $args{columns} eq 'ARRAY'; |
35 | |
36 $this->InsertColumn($_) foreach @{$args{columns}}; | |
165 | 37 } |
49 | 38 } |
39 | |
40 sub InsertColumn { | |
41 my ($this,$column,$index) = @_; | |
42 | |
165 | 43 $index = ($this->{$columns} ? scalar(@{$this->{$columns}}) : 0) if not defined $index; |
49 | 44 |
165 | 45 die new IMPL::InvalidArgumentException("The index is out of range") if ($index < 0 || $index > ($this->{$columns} ? scalar(@{$this->{$columns}}) : 0)); |
49 | 46 |
47 if (UNIVERSAL::isa($column,'IMPL::SQL::Schema::Column')) { | |
48 | |
49 } elsif (UNIVERSAL::isa($column,'HASH')) { | |
50 $column = new IMPL::SQL::Schema::Column(%{$column}); | |
51 } else { | |
52 die new IMPL::InvalidArgumentException("The invalid column parameter"); | |
53 } | |
54 | |
165 | 55 if (exists $this->{$columnsByName}->{$column->name}) { |
49 | 56 die new IMPL::InvalidOperationException("The column already exists",$column->name); |
57 } else { | |
165 | 58 $this->{$columnsByName}->{$column->name} = $column; |
59 splice @{$this->{$columns}},$index,0,$column; | |
49 | 60 } |
61 | |
62 return $column; | |
63 } | |
64 | |
65 sub RemoveColumn { | |
66 my ($this,$NameOrColumn,$Force) = @_; | |
67 | |
68 my $ColName; | |
69 if (UNIVERSAL::isa($NameOrColumn,'IMPL::SQL::Schema::Column')) { | |
165 | 70 $ColName = $NameOrColumn->name; |
49 | 71 } elsif (not ref $NameOrColumn) { |
72 $ColName = $NameOrColumn; | |
73 } | |
74 | |
165 | 75 if (exists $this->{$columnsByName}->{$ColName}) { |
49 | 76 my $index = 0; |
165 | 77 foreach my $column(@{$this->{$columns}}) { |
78 last if $column->name eq $ColName; | |
49 | 79 $index++; |
80 } | |
81 | |
165 | 82 my $column = $this->{$columns}[$index]; |
49 | 83 if (my @constraints = $this->GetColumnConstraints($column)){ |
84 $Force or die new IMPL::InvalidOperationException('Can\'t remove column which is used in the constraints',@constraints); | |
85 $this->RemoveConstraint($_) foreach @constraints; | |
86 } | |
87 | |
165 | 88 my $removed = splice @{$this->{$columns}},$index,1; |
89 delete $this->{$columnsByName}->{$ColName}; | |
49 | 90 return $removed; |
91 } else { | |
165 | 92 die new IMPL::InvalidOperationException("The column not found",$NameOrColumn->name); |
49 | 93 } |
94 } | |
95 | |
167 | 96 sub GetColumn { |
49 | 97 my ($this,$name) = @_; |
98 | |
165 | 99 return $this->{$columnsByName}->{$name}; |
49 | 100 } |
101 | |
167 | 102 sub GetColumnAt { |
49 | 103 my ($this,$index) = @_; |
104 | |
165 | 105 die new IMPL::InvalidArgumentException("The index is out of range") |
194 | 106 if $index < 0 || $index >= ($this->{$columns} ? scalar(@{$this->{$columns}}) : 0); |
49 | 107 |
165 | 108 return $this->{$columns}[$index]; |
109 } | |
110 | |
269 | 111 sub SetColumnPosition { |
112 my ($this,$nameOrColumn,$pos) = @_; | |
113 | |
114 my $colName; | |
115 if (is($nameOrColumn,'IMPL::SQL::Schema::Column')) { | |
116 $colName = $nameOrColumn->name; | |
117 } elsif (not ref $nameOrColumn) { | |
118 $colName = $nameOrColumn; | |
119 } else { | |
120 die IMPL::InvalidArgumentException->new(column => 'The specified column isn\'t found in the table'); | |
121 } | |
122 | |
123 die IMPL::InvalidArgumentException->new( 'pos' => 'The specified position is invalid') | |
124 if not defined $pos || $pos < 0 || $pos >= $this->columnsCount; | |
125 | |
126 my $index = 0; | |
127 foreach my $column(@{$this->{$columns}}) { | |
128 last if $column->name eq $colName; | |
129 $index++; | |
130 } | |
131 | |
132 if ($pos != $index) { | |
133 #position needs to be changed; | |
134 | |
135 my ($column) = splice @{$this->{$columns}}, $index, 1; | |
136 splice @{$this->{$columns}}, $pos, 0, $column; | |
137 } | |
138 | |
139 return; | |
140 } | |
141 | |
142 sub columnsCount { | |
143 my ($this) = @_; | |
194 | 144 |
145 return scalar(@{$this->{$columns}}); | |
49 | 146 } |
147 | |
269 | 148 sub ColumnsCount { |
149 goto &columnsCount; | |
150 } | |
151 | |
49 | 152 sub AddConstraint { |
194 | 153 my $this = shift; |
168 | 154 if (@_ == 1) { |
194 | 155 my ($Constraint) = @_; |
156 | |
315 | 157 die new IMPL::InvalidArgumentException('The invalid parameter') if not is($Constraint,'IMPL::SQL::Schema::Constraint'); |
194 | 158 |
159 $Constraint->table == $this or die new IMPL::InvalidOperationException('The constaint must belong to the target table'); | |
160 | |
161 if (exists $this->{$constraints}->{$Constraint->name}) { | |
162 die new IMPL::InvalidOperationException('The table already has the specified constraint',$Constraint->name); | |
163 } else { | |
164 if (UNIVERSAL::isa($Constraint,'IMPL::SQL::Schema::Constraint::PrimaryKey')) { | |
165 not $this->{$primaryKey} or die new IMPL::InvalidOperationException('The table already has a primary key'); | |
166 $this->{$primaryKey} = $Constraint; | |
167 } | |
168 | |
169 $this->{$constraints}->{$Constraint->name} = $Constraint; | |
170 } | |
168 | 171 } elsif( @_ == 2) { |
194 | 172 my ($type,$params) = @_; |
173 | |
174 $type = IMPL::SQL::Schema::Constraint->ResolveAlias($type) or | |
175 die new IMPL::Exception("Can't resolve a constraint alias",$_[0]); | |
176 | |
271
56364d0c4b4f
+IMPL::SQL::Schema::MySQL: added basic support for MySQL
cin
parents:
269
diff
changeset
|
177 $params = {%{$params}}; |
56364d0c4b4f
+IMPL::SQL::Schema::MySQL: added basic support for MySQL
cin
parents:
269
diff
changeset
|
178 |
194 | 179 $params->{table} = $this; |
180 | |
181 $this->AddConstraint($type->new(%$params)); | |
165 | 182 } else { |
194 | 183 die new IMPL::Exception("Wrong arguments number",scalar(@_)); |
49 | 184 } |
185 } | |
186 | |
187 sub RemoveConstraint { | |
188 my ($this,$Constraint,$Force) = @_; | |
189 | |
165 | 190 my $cn = UNIVERSAL::isa($Constraint,'IMPL::SQL::Schema::Constraint') ? $Constraint->name : $Constraint; |
191 $Constraint = $this->{$constraints}->{$cn} or die new IMPL::InvalidOperationException('The specified constraint doesn\'t exists',$cn); | |
49 | 192 |
193 if (UNIVERSAL::isa($Constraint,'IMPL::SQL::Schema::Constraint::PrimaryKey')) { | |
165 | 194 not scalar keys %{$this->{$primaryKey}->ConnectedFK} or die new IMPL::InvalidOperationException('Can\'t remove Primary Key unless some foreign keys referenses it'); |
49 | 195 |
165 | 196 delete $this->{$primaryKey}; |
49 | 197 } |
198 $Constraint->Dispose; | |
165 | 199 delete $this->{$constraints}->{$cn}; |
49 | 200 return $cn; |
201 } | |
202 | |
165 | 203 sub GetConstraint { |
194 | 204 my ($this,$name) = @_; |
205 | |
206 return $this->{$constraints}{$name}; | |
165 | 207 } |
208 | |
167 | 209 sub GetConstraints { |
194 | 210 my ($this) = @_; |
211 | |
212 return wantarray ? values %{$this->{$constraints}} : [values %{$this->{$constraints}}]; | |
167 | 213 } |
214 | |
49 | 215 sub GetColumnConstraints { |
216 my ($this,@Columns) = @_; | |
217 | |
165 | 218 my @cn = map { UNIVERSAL::isa($_ ,'IMPL::SQL::Schema::Column') ? $_ ->name : $_ } @Columns; |
219 exists $this->{$columnsByName}->{$_} or die new IMPL::InvalidOperationException('The specified column isn\'t found',$_) foreach @cn; | |
49 | 220 |
165 | 221 return grep {$_->HasColumn(@cn)} values %{$this->{$constraints}}; |
49 | 222 } |
223 | |
224 sub SetPrimaryKey { | |
225 my ($this,@ColumnList) = @_; | |
226 | |
165 | 227 $this->AddConstraint(new IMPL::SQL::Schema::Constraint::PrimaryKey(name => $this->{$name}.'_PK', table => $this, columns => \@ColumnList)); |
49 | 228 } |
229 | |
230 sub LinkTo { | |
231 my ($this,$table,@ColumnList) = @_; | |
165 | 232 $table->primaryKey or die new IMPL::InvalidOperationException('The referenced table must have a primary key'); |
233 my $constraintName = $this->{$name}.'_'.$table->name.'_FK_'.join('_',map {ref $_ ? $_->name : $_} @ColumnList); | |
168 | 234 $this->AddConstraint(new IMPL::SQL::Schema::Constraint::ForeignKey(name => $constraintName, table => $this, columns => \@ColumnList, referencedTable => $table, referencedColumns => $table->primaryKey->columns->as_list)); |
49 | 235 } |
236 | |
237 sub Dispose { | |
238 my ($this) = @_; | |
239 | |
165 | 240 $_->Dispose() foreach values %{$this->{$constraints}}; |
49 | 241 |
242 undef %{$this}; | |
243 $this->SUPER::Dispose(); | |
244 } | |
245 | |
167 | 246 sub SameValue { |
194 | 247 my ($this,$other) = @_; |
248 | |
315 | 249 return 0 unless is($other, typeof($this)); |
194 | 250 |
251 return 0 unless $this->name eq $other->name; | |
252 return 0 unless $this->ColumnsCount eq $other->ColumnsCount; | |
253 | |
254 for (my $i = 0; $i < $this->ColumsCount; $i ++) { | |
255 return 0 unless $this->($i)->SameValue($other->GetColumnAt($i)); | |
256 } | |
257 | |
258 my %thisConstraints = map { $_->name, $_ } $this->GetConstraints(); | |
259 my %otherConstraints = map { $_->name, $_ } $other->GetConstraints(); | |
260 | |
261 foreach my $name ( keys %thisConstraints ) { | |
262 return 0 unless $otherConstraints{$name}; | |
263 return 0 unless $thisConstraints{$name}->SameValue(delete $otherConstraints{$name}); | |
264 } | |
265 | |
266 return 0 if %otherConstraints; | |
267 | |
268 return 1; | |
167 | 269 } |
270 | |
49 | 271 1; |
165 | 272 |
273 |