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