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