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(
194
+ − 7 IMPL::Object
+ − 8 IMPL::Object::Disposable
163
+ − 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}) {
194
+ − 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}};
165
+ − 38 }
+ − 39
+ − 40 if ($args{constraints}) {
194
+ − 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}};
165
+ − 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")
194
+ − 113 if $index < 0 || $index >= ($this->{$columns} ? scalar(@{$this->{$columns}}) : 0);
49
+ − 114
165
+ − 115 return $this->{$columns}[$index];
+ − 116 }
+ − 117
+ − 118 sub ColumnsCount {
194
+ − 119 my ($this) = @_;
+ − 120
+ − 121 return scalar(@{$this->{$columns}});
49
+ − 122 }
+ − 123
+ − 124 sub AddConstraint {
194
+ − 125 my $this = shift;
168
+ − 126 if (@_ == 1) {
194
+ − 127 my ($Constraint) = @_;
+ − 128
+ − 129 die new IMPL::InvalidArgumentException('The invalid parameter') if not is($Constraint,typeof IMPL::SQL::Schema::Constraint);
+ − 130
+ − 131 $Constraint->table == $this or die new IMPL::InvalidOperationException('The constaint must belong to the target table');
+ − 132
+ − 133 if (exists $this->{$constraints}->{$Constraint->name}) {
+ − 134 die new IMPL::InvalidOperationException('The table already has the specified constraint',$Constraint->name);
+ − 135 } else {
+ − 136 if (UNIVERSAL::isa($Constraint,'IMPL::SQL::Schema::Constraint::PrimaryKey')) {
+ − 137 not $this->{$primaryKey} or die new IMPL::InvalidOperationException('The table already has a primary key');
+ − 138 $this->{$primaryKey} = $Constraint;
+ − 139 }
+ − 140
+ − 141 $this->{$constraints}->{$Constraint->name} = $Constraint;
+ − 142 }
168
+ − 143 } elsif( @_ == 2) {
194
+ − 144 my ($type,$params) = @_;
+ − 145
+ − 146 $type = IMPL::SQL::Schema::Constraint->ResolveAlias($type) or
+ − 147 die new IMPL::Exception("Can't resolve a constraint alias",$_[0]);
+ − 148
+ − 149 $params->{table} = $this;
+ − 150
+ − 151 $this->AddConstraint($type->new(%$params));
165
+ − 152 } else {
194
+ − 153 die new IMPL::Exception("Wrong arguments number",scalar(@_));
49
+ − 154 }
+ − 155 }
+ − 156
+ − 157 sub RemoveConstraint {
+ − 158 my ($this,$Constraint,$Force) = @_;
+ − 159
165
+ − 160 my $cn = UNIVERSAL::isa($Constraint,'IMPL::SQL::Schema::Constraint') ? $Constraint->name : $Constraint;
+ − 161 $Constraint = $this->{$constraints}->{$cn} or die new IMPL::InvalidOperationException('The specified constraint doesn\'t exists',$cn);
49
+ − 162
+ − 163 if (UNIVERSAL::isa($Constraint,'IMPL::SQL::Schema::Constraint::PrimaryKey')) {
165
+ − 164 not scalar keys %{$this->{$primaryKey}->ConnectedFK} or die new IMPL::InvalidOperationException('Can\'t remove Primary Key unless some foreign keys referenses it');
49
+ − 165
165
+ − 166 delete $this->{$primaryKey};
49
+ − 167 }
+ − 168 $Constraint->Dispose;
165
+ − 169 delete $this->{$constraints}->{$cn};
49
+ − 170 return $cn;
+ − 171 }
+ − 172
165
+ − 173 sub GetConstraint {
194
+ − 174 my ($this,$name) = @_;
+ − 175
+ − 176 return $this->{$constraints}{$name};
165
+ − 177 }
+ − 178
167
+ − 179 sub GetConstraints {
194
+ − 180 my ($this) = @_;
+ − 181
+ − 182 return wantarray ? values %{$this->{$constraints}} : [values %{$this->{$constraints}}];
167
+ − 183 }
+ − 184
49
+ − 185 sub GetColumnConstraints {
+ − 186 my ($this,@Columns) = @_;
+ − 187
165
+ − 188 my @cn = map { UNIVERSAL::isa($_ ,'IMPL::SQL::Schema::Column') ? $_ ->name : $_ } @Columns;
+ − 189 exists $this->{$columnsByName}->{$_} or die new IMPL::InvalidOperationException('The specified column isn\'t found',$_) foreach @cn;
49
+ − 190
165
+ − 191 return grep {$_->HasColumn(@cn)} values %{$this->{$constraints}};
49
+ − 192 }
+ − 193
+ − 194 sub SetPrimaryKey {
+ − 195 my ($this,@ColumnList) = @_;
+ − 196
165
+ − 197 $this->AddConstraint(new IMPL::SQL::Schema::Constraint::PrimaryKey(name => $this->{$name}.'_PK', table => $this, columns => \@ColumnList));
49
+ − 198 }
+ − 199
+ − 200 sub LinkTo {
+ − 201 my ($this,$table,@ColumnList) = @_;
165
+ − 202 $table->primaryKey or die new IMPL::InvalidOperationException('The referenced table must have a primary key');
+ − 203 my $constraintName = $this->{$name}.'_'.$table->name.'_FK_'.join('_',map {ref $_ ? $_->name : $_} @ColumnList);
168
+ − 204 $this->AddConstraint(new IMPL::SQL::Schema::Constraint::ForeignKey(name => $constraintName, table => $this, columns => \@ColumnList, referencedTable => $table, referencedColumns => $table->primaryKey->columns->as_list));
49
+ − 205 }
+ − 206
+ − 207 sub Dispose {
+ − 208 my ($this) = @_;
+ − 209
165
+ − 210 $_->Dispose() foreach values %{$this->{$constraints}};
49
+ − 211
+ − 212 undef %{$this};
+ − 213 $this->SUPER::Dispose();
+ − 214 }
+ − 215
167
+ − 216 sub SameValue {
194
+ − 217 my ($this,$other) = @_;
+ − 218
+ − 219 return 0 unless is $other, typeof $this;
+ − 220
+ − 221 return 0 unless $this->name eq $other->name;
+ − 222 return 0 unless $this->ColumnsCount eq $other->ColumnsCount;
+ − 223
+ − 224 for (my $i = 0; $i < $this->ColumsCount; $i ++) {
+ − 225 return 0 unless $this->($i)->SameValue($other->GetColumnAt($i));
+ − 226 }
+ − 227
+ − 228 my %thisConstraints = map { $_->name, $_ } $this->GetConstraints();
+ − 229 my %otherConstraints = map { $_->name, $_ } $other->GetConstraints();
+ − 230
+ − 231 foreach my $name ( keys %thisConstraints ) {
+ − 232 return 0 unless $otherConstraints{$name};
+ − 233 return 0 unless $thisConstraints{$name}->SameValue(delete $otherConstraints{$name});
+ − 234 }
+ − 235
+ − 236 return 0 if %otherConstraints;
+ − 237
+ − 238 return 1;
167
+ − 239 }
+ − 240
49
+ − 241 1;
165
+ − 242
+ − 243