|
49
|
1 use strict;
|
|
|
2 package IMPL::SQL::Schema::Table;
|
|
|
3
|
|
167
|
4 use IMPL::lang qw(:declare :constants is);
|
|
49
|
5
|
|
165
|
6 use parent qw(
|
|
163
|
7 IMPL::Object
|
|
|
8 IMPL::Object::Disposable
|
|
|
9 );
|
|
165
|
10
|
|
167
|
11 require IMPL::SQL::Schema::Column;
|
|
|
12 require IMPL::SQL::Schema::Constraint;
|
|
|
13 require IMPL::SQL::Schema::Constraint::PrimaryKey;
|
|
|
14 require IMPL::SQL::Schema::Constraint::ForeignKey;
|
|
165
|
15
|
|
49
|
16 use IMPL::Class::Property::Direct;
|
|
|
17
|
|
|
18 BEGIN {
|
|
167
|
19 public _direct property name => PROP_GET;
|
|
|
20 public _direct property schema => PROP_GET;
|
|
|
21 public _direct property columns => PROP_GET;
|
|
|
22 public _direct property constraints => PROP_GET;
|
|
|
23 public _direct property columnsByName => 0;
|
|
|
24 public _direct property primaryKey => PROP_GET;
|
|
|
25 public _direct property tag => PROP_ALL;
|
|
49
|
26 }
|
|
|
27
|
|
|
28 sub CTOR {
|
|
|
29 my ($this,%args) = @_;
|
|
|
30
|
|
165
|
31 $this->{$name} = $args{'name'} or die new IMPL::InvalidArgumentException('a table name is required');
|
|
|
32 $this->{$schema} = $args{'schema'} or die new IMPL::InvalidArgumentException('a parent schema is required');
|
|
|
33
|
|
|
34 if ($args{columns}) {
|
|
|
35 die new IMPL::InvalidOperationException('A columns property should be a reference to an array') unless ref $args{columns} eq 'ARRAY';
|
|
|
36
|
|
|
37 $this->InsertColumn($_) foreach @{$args{columns}};
|
|
|
38 }
|
|
|
39
|
|
|
40 if ($args{constraints}) {
|
|
|
41 die new IMPL::InvalidOperationException('A constraints property should be a reference to an array') unless ref $args{constraints} eq 'ARRAY';
|
|
|
42
|
|
|
43 $this->AddConstraint($_) foreach @{$args{constraints}};
|
|
|
44 }
|
|
49
|
45 }
|
|
|
46
|
|
|
47 sub InsertColumn {
|
|
|
48 my ($this,$column,$index) = @_;
|
|
|
49
|
|
165
|
50 $index = ($this->{$columns} ? scalar(@{$this->{$columns}}) : 0) if not defined $index;
|
|
49
|
51
|
|
165
|
52 die new IMPL::InvalidArgumentException("The index is out of range") if ($index < 0 || $index > ($this->{$columns} ? scalar(@{$this->{$columns}}) : 0));
|
|
49
|
53
|
|
|
54 if (UNIVERSAL::isa($column,'IMPL::SQL::Schema::Column')) {
|
|
|
55
|
|
|
56 } elsif (UNIVERSAL::isa($column,'HASH')) {
|
|
|
57 $column = new IMPL::SQL::Schema::Column(%{$column});
|
|
|
58 } else {
|
|
|
59 die new IMPL::InvalidArgumentException("The invalid column parameter");
|
|
|
60 }
|
|
|
61
|
|
165
|
62 if (exists $this->{$columnsByName}->{$column->name}) {
|
|
49
|
63 die new IMPL::InvalidOperationException("The column already exists",$column->name);
|
|
|
64 } else {
|
|
165
|
65 $this->{$columnsByName}->{$column->name} = $column;
|
|
|
66 splice @{$this->{$columns}},$index,0,$column;
|
|
49
|
67 }
|
|
|
68
|
|
|
69 return $column;
|
|
|
70 }
|
|
|
71
|
|
|
72 sub RemoveColumn {
|
|
|
73 my ($this,$NameOrColumn,$Force) = @_;
|
|
|
74
|
|
|
75 my $ColName;
|
|
|
76 if (UNIVERSAL::isa($NameOrColumn,'IMPL::SQL::Schema::Column')) {
|
|
165
|
77 $ColName = $NameOrColumn->name;
|
|
49
|
78 } elsif (not ref $NameOrColumn) {
|
|
|
79 $ColName = $NameOrColumn;
|
|
|
80 }
|
|
|
81
|
|
165
|
82 if (exists $this->{$columnsByName}->{$ColName}) {
|
|
49
|
83 my $index = 0;
|
|
165
|
84 foreach my $column(@{$this->{$columns}}) {
|
|
|
85 last if $column->name eq $ColName;
|
|
49
|
86 $index++;
|
|
|
87 }
|
|
|
88
|
|
165
|
89 my $column = $this->{$columns}[$index];
|
|
49
|
90 if (my @constraints = $this->GetColumnConstraints($column)){
|
|
|
91 $Force or die new IMPL::InvalidOperationException('Can\'t remove column which is used in the constraints',@constraints);
|
|
|
92 $this->RemoveConstraint($_) foreach @constraints;
|
|
|
93 }
|
|
|
94
|
|
165
|
95 my $removed = splice @{$this->{$columns}},$index,1;
|
|
|
96 delete $this->{$columnsByName}->{$ColName};
|
|
49
|
97 return $removed;
|
|
|
98 } else {
|
|
165
|
99 die new IMPL::InvalidOperationException("The column not found",$NameOrColumn->name);
|
|
49
|
100 }
|
|
|
101 }
|
|
|
102
|
|
167
|
103 sub GetColumn {
|
|
49
|
104 my ($this,$name) = @_;
|
|
|
105
|
|
165
|
106 return $this->{$columnsByName}->{$name};
|
|
49
|
107 }
|
|
|
108
|
|
167
|
109 sub GetColumnAt {
|
|
49
|
110 my ($this,$index) = @_;
|
|
|
111
|
|
165
|
112 die new IMPL::InvalidArgumentException("The index is out of range")
|
|
|
113 if $index < 0 || $index >= ($this->{$columns} ? scalar(@{$this->{$columns}}) : 0);
|
|
49
|
114
|
|
165
|
115 return $this->{$columns}[$index];
|
|
|
116 }
|
|
|
117
|
|
|
118 sub ColumnsCount {
|
|
|
119 my ($this) = @_;
|
|
|
120
|
|
|
121 return scalar(@{$this->{$columns}});
|
|
49
|
122 }
|
|
|
123
|
|
|
124 sub AddConstraint {
|
|
|
125 my ($this,$Constraint) = @_;
|
|
|
126
|
|
165
|
127 if (ref $Constraint eq 'HASH') {
|
|
|
128 $Constraint = new IMPL::SQL::Schema::Constraint( %$Constraint, table => $this );
|
|
|
129 } else {
|
|
|
130 die new IMPL::InvalidArgumentException('The invalid parameter') if not is($Constraint,typeof IMPL::SQL::Schema::Constraint);
|
|
|
131 }
|
|
49
|
132
|
|
165
|
133 $Constraint->table == $this or die new IMPL::InvalidOperationException('The constaint must belong to the target table');
|
|
49
|
134
|
|
165
|
135 if (exists $this->{$constraints}->{$Constraint->name}) {
|
|
|
136 die new IMPL::InvalidOperationException('The table already has the specified constraint',$Constraint->name);
|
|
49
|
137 } else {
|
|
|
138 if (UNIVERSAL::isa($Constraint,'IMPL::SQL::Schema::Constraint::PrimaryKey')) {
|
|
165
|
139 not $this->{$primaryKey} or die new IMPL::InvalidOperationException('The table already has a primary key');
|
|
|
140 $this->{$primaryKey} = $Constraint;
|
|
49
|
141 }
|
|
|
142
|
|
165
|
143 $this->{$constraints}->{$Constraint->name} = $Constraint;
|
|
49
|
144 }
|
|
|
145 }
|
|
|
146
|
|
|
147 sub RemoveConstraint {
|
|
|
148 my ($this,$Constraint,$Force) = @_;
|
|
|
149
|
|
165
|
150 my $cn = UNIVERSAL::isa($Constraint,'IMPL::SQL::Schema::Constraint') ? $Constraint->name : $Constraint;
|
|
|
151 $Constraint = $this->{$constraints}->{$cn} or die new IMPL::InvalidOperationException('The specified constraint doesn\'t exists',$cn);
|
|
49
|
152
|
|
|
153 if (UNIVERSAL::isa($Constraint,'IMPL::SQL::Schema::Constraint::PrimaryKey')) {
|
|
165
|
154 not scalar keys %{$this->{$primaryKey}->ConnectedFK} or die new IMPL::InvalidOperationException('Can\'t remove Primary Key unless some foreign keys referenses it');
|
|
49
|
155
|
|
165
|
156 delete $this->{$primaryKey};
|
|
49
|
157 }
|
|
|
158 $Constraint->Dispose;
|
|
165
|
159 delete $this->{$constraints}->{$cn};
|
|
49
|
160 return $cn;
|
|
|
161 }
|
|
|
162
|
|
165
|
163 sub GetConstraint {
|
|
|
164 my ($this,$name) = @_;
|
|
|
165
|
|
|
166 return $this->{$constraints}{$name};
|
|
|
167 }
|
|
|
168
|
|
167
|
169 sub GetConstraints {
|
|
|
170 my ($this) = @_;
|
|
|
171
|
|
|
172 return wantarray ? values %{$this->{$constraints}} : [values %{$this->{$constraints}}];
|
|
|
173 }
|
|
|
174
|
|
49
|
175 sub GetColumnConstraints {
|
|
|
176 my ($this,@Columns) = @_;
|
|
|
177
|
|
165
|
178 my @cn = map { UNIVERSAL::isa($_ ,'IMPL::SQL::Schema::Column') ? $_ ->name : $_ } @Columns;
|
|
|
179 exists $this->{$columnsByName}->{$_} or die new IMPL::InvalidOperationException('The specified column isn\'t found',$_) foreach @cn;
|
|
49
|
180
|
|
165
|
181 return grep {$_->HasColumn(@cn)} values %{$this->{$constraints}};
|
|
49
|
182 }
|
|
|
183
|
|
|
184 sub SetPrimaryKey {
|
|
|
185 my ($this,@ColumnList) = @_;
|
|
|
186
|
|
165
|
187 $this->AddConstraint(new IMPL::SQL::Schema::Constraint::PrimaryKey(name => $this->{$name}.'_PK', table => $this, columns => \@ColumnList));
|
|
49
|
188 }
|
|
|
189
|
|
|
190 sub LinkTo {
|
|
|
191 my ($this,$table,@ColumnList) = @_;
|
|
165
|
192 $table->primaryKey or die new IMPL::InvalidOperationException('The referenced table must have a primary key');
|
|
|
193 my $constraintName = $this->{$name}.'_'.$table->name.'_FK_'.join('_',map {ref $_ ? $_->name : $_} @ColumnList);
|
|
167
|
194 $this->AddConstraint(new IMPL::SQL::Schema::Constraint::ForeignKey(name => $constraintName, table => $this, columns => \@ColumnList, referencedTable => $table, referencedColumns => scalar $table->primaryKey->columns));
|
|
49
|
195 }
|
|
|
196
|
|
|
197 sub Dispose {
|
|
|
198 my ($this) = @_;
|
|
|
199
|
|
165
|
200 $_->Dispose() foreach values %{$this->{$constraints}};
|
|
49
|
201
|
|
|
202 undef %{$this};
|
|
|
203 $this->SUPER::Dispose();
|
|
|
204 }
|
|
|
205
|
|
167
|
206 sub SameValue {
|
|
|
207 my ($this,$other) = @_;
|
|
|
208
|
|
|
209 return 0 unless is $other, typeof $this;
|
|
|
210
|
|
|
211 return 0 unless $this->name eq $other->name;
|
|
|
212 return 0 unless $this->ColumnsCount eq $other->ColumnsCount;
|
|
|
213
|
|
|
214 for (my $i = 0; $i < $this->ColumsCount; $i ++) {
|
|
|
215 return 0 unless $this->($i)->SameValue($other->GetColumnAt($i));
|
|
|
216 }
|
|
|
217
|
|
|
218 my %thisConstraints = map { $_->name, $_ } $this->GetConstraints();
|
|
|
219 my %otherConstraints = map { $_->name, $_ } $other->GetConstraints();
|
|
|
220
|
|
|
221 foreach my $name ( keys %thisConstraints ) {
|
|
|
222 return 0 unless $otherConstraints{$name};
|
|
|
223 return 0 unless $thisConstraints{$name}->SameValue(delete $otherConstraints{$name});
|
|
|
224 }
|
|
|
225
|
|
|
226 return 0 if %otherConstraints;
|
|
|
227
|
|
|
228 return 1;
|
|
|
229 }
|
|
|
230
|
|
49
|
231 1;
|
|
165
|
232
|
|
|
233
|
