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