407
+ − 1 package IMPL::SQL::Schema::Table;
+ − 2 use strict;
+ − 3
+ − 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 };
+ − 21
+ − 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;
+ − 26
+ − 27 sub CTOR {
+ − 28 my ($this,%args) = @_;
+ − 29
+ − 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}) {
+ − 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}};
+ − 37 }
+ − 38 }
+ − 39
+ − 40 sub InsertColumn {
+ − 41 my ($this,$column,$index) = @_;
+ − 42
+ − 43 $index = ($this->{$columns} ? scalar(@{$this->{$columns}}) : 0) if not defined $index;
+ − 44
+ − 45 die new IMPL::InvalidArgumentException("The index is out of range") if ($index < 0 || $index > ($this->{$columns} ? scalar(@{$this->{$columns}}) : 0));
+ − 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
+ − 55 if (exists $this->{$columnsByName}->{$column->name}) {
+ − 56 die new IMPL::InvalidOperationException("The column already exists",$column->name);
+ − 57 } else {
+ − 58 $this->{$columnsByName}->{$column->name} = $column;
+ − 59 splice @{$this->{$columns}},$index,0,$column;
+ − 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')) {
+ − 70 $ColName = $NameOrColumn->name;
+ − 71 } elsif (not ref $NameOrColumn) {
+ − 72 $ColName = $NameOrColumn;
+ − 73 }
+ − 74
+ − 75 if (exists $this->{$columnsByName}->{$ColName}) {
+ − 76 my $index = 0;
+ − 77 foreach my $column(@{$this->{$columns}}) {
+ − 78 last if $column->name eq $ColName;
+ − 79 $index++;
+ − 80 }
+ − 81
+ − 82 my $column = $this->{$columns}[$index];
+ − 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
+ − 88 my $removed = splice @{$this->{$columns}},$index,1;
+ − 89 delete $this->{$columnsByName}->{$ColName};
+ − 90 return $removed;
+ − 91 } else {
+ − 92 die new IMPL::InvalidOperationException("The column not found",$NameOrColumn->name);
+ − 93 }
+ − 94 }
+ − 95
+ − 96 sub GetColumn {
+ − 97 my ($this,$name) = @_;
+ − 98
+ − 99 return $this->{$columnsByName}->{$name};
+ − 100 }
+ − 101
+ − 102 sub GetColumnAt {
+ − 103 my ($this,$index) = @_;
+ − 104
+ − 105 die new IMPL::InvalidArgumentException("The index is out of range")
+ − 106 if $index < 0 || $index >= ($this->{$columns} ? scalar(@{$this->{$columns}}) : 0);
+ − 107
+ − 108 return $this->{$columns}[$index];
+ − 109 }
+ − 110
+ − 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) = @_;
+ − 144
+ − 145 return scalar(@{$this->{$columns}});
+ − 146 }
+ − 147
+ − 148 sub ColumnsCount {
+ − 149 goto &columnsCount;
+ − 150 }
+ − 151
+ − 152 sub AddConstraint {
+ − 153 my $this = shift;
+ − 154 if (@_ == 1) {
+ − 155 my ($Constraint) = @_;
+ − 156
+ − 157 die new IMPL::InvalidArgumentException('The invalid parameter') if not is($Constraint,'IMPL::SQL::Schema::Constraint');
+ − 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 }
+ − 171 } elsif( @_ == 2) {
+ − 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
+ − 177 $params = {%{$params}};
+ − 178
+ − 179 $params->{table} = $this;
+ − 180
+ − 181 $this->AddConstraint($type->new(%$params));
+ − 182 } else {
+ − 183 die new IMPL::Exception("Wrong arguments number",scalar(@_));
+ − 184 }
+ − 185 }
+ − 186
+ − 187 sub RemoveConstraint {
+ − 188 my ($this,$Constraint,$Force) = @_;
+ − 189
+ − 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);
+ − 192
+ − 193 if (UNIVERSAL::isa($Constraint,'IMPL::SQL::Schema::Constraint::PrimaryKey')) {
+ − 194 not scalar keys %{$this->{$primaryKey}->ConnectedFK} or die new IMPL::InvalidOperationException('Can\'t remove Primary Key unless some foreign keys referenses it');
+ − 195
+ − 196 delete $this->{$primaryKey};
+ − 197 }
+ − 198 $Constraint->Dispose;
+ − 199 delete $this->{$constraints}->{$cn};
+ − 200 return $cn;
+ − 201 }
+ − 202
+ − 203 sub GetConstraint {
+ − 204 my ($this,$name) = @_;
+ − 205
+ − 206 return $this->{$constraints}{$name};
+ − 207 }
+ − 208
+ − 209 sub GetConstraints {
+ − 210 my ($this) = @_;
+ − 211
+ − 212 return wantarray ? values %{$this->{$constraints}} : [values %{$this->{$constraints}}];
+ − 213 }
+ − 214
+ − 215 sub GetColumnConstraints {
+ − 216 my ($this,@Columns) = @_;
+ − 217
+ − 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;
+ − 220
+ − 221 return grep {$_->HasColumn(@cn)} values %{$this->{$constraints}};
+ − 222 }
+ − 223
+ − 224 sub SetPrimaryKey {
+ − 225 my ($this,@ColumnList) = @_;
+ − 226
+ − 227 $this->AddConstraint(new IMPL::SQL::Schema::Constraint::PrimaryKey(name => $this->{$name}.'_PK', table => $this, columns => \@ColumnList));
+ − 228 }
+ − 229
+ − 230 sub LinkTo {
+ − 231 my ($this,$table,@ColumnList) = @_;
+ − 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);
+ − 234 $this->AddConstraint(new IMPL::SQL::Schema::Constraint::ForeignKey(name => $constraintName, table => $this, columns => \@ColumnList, referencedTable => $table, referencedColumns => $table->primaryKey->columns->as_list));
+ − 235 }
+ − 236
+ − 237 sub Dispose {
+ − 238 my ($this) = @_;
+ − 239
+ − 240 $_->Dispose() foreach values %{$this->{$constraints}};
+ − 241
+ − 242 undef %{$this};
+ − 243 $this->SUPER::Dispose();
+ − 244 }
+ − 245
+ − 246 sub SameValue {
+ − 247 my ($this,$other) = @_;
+ − 248
+ − 249 return 0 unless is($other, typeof($this));
+ − 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;
+ − 269 }
+ − 270
+ − 271 1;
+ − 272
+ − 273