Mercurial > pub > Impl
view Lib/IMPL/SQL/Schema/Table.pm @ 245:7c517134c42f
Added Unsupported media type Web exception
corrected resourceLocation setting in the resource
Implemented localizable resources for text messages
fixed TT view scopings, INIT block in controls now sets globals correctly.
author | sergey |
---|---|
date | Mon, 29 Oct 2012 03:15:22 +0400 |
parents | 5c82eec23bb6 |
children | dacfe7c0311a |
line wrap: on
line source
use strict; package IMPL::SQL::Schema::Table; use IMPL::lang qw(:declare is); use parent qw( IMPL::Object IMPL::Object::Disposable ); require IMPL::SQL::Schema::Column; require IMPL::SQL::Schema::Constraint; require IMPL::SQL::Schema::Constraint::PrimaryKey; require IMPL::SQL::Schema::Constraint::ForeignKey; use IMPL::Class::Property::Direct; BEGIN { public _direct property name => PROP_GET; public _direct property schema => PROP_GET; public _direct property columns => PROP_GET; public _direct property constraints => PROP_GET; public _direct property columnsByName => 0; public _direct property primaryKey => PROP_GET; public _direct property tag => PROP_ALL; } sub CTOR { my ($this,%args) = @_; $this->{$name} = $args{'name'} or die new IMPL::InvalidArgumentException('a table name is required'); $this->{$schema} = $args{'schema'} or die new IMPL::InvalidArgumentException('a parent schema is required'); if ($args{columns}) { die new IMPL::InvalidOperationException('A columns property should be a reference to an array') unless ref $args{columns} eq 'ARRAY'; $this->InsertColumn($_) foreach @{$args{columns}}; } if ($args{constraints}) { die new IMPL::InvalidOperationException('A constraints property should be a reference to an array') unless ref $args{constraints} eq 'ARRAY'; $this->AddConstraint($_) foreach @{$args{constraints}}; } } sub InsertColumn { my ($this,$column,$index) = @_; $index = ($this->{$columns} ? scalar(@{$this->{$columns}}) : 0) if not defined $index; die new IMPL::InvalidArgumentException("The index is out of range") if ($index < 0 || $index > ($this->{$columns} ? scalar(@{$this->{$columns}}) : 0)); if (UNIVERSAL::isa($column,'IMPL::SQL::Schema::Column')) { } elsif (UNIVERSAL::isa($column,'HASH')) { $column = new IMPL::SQL::Schema::Column(%{$column}); } else { die new IMPL::InvalidArgumentException("The invalid column parameter"); } if (exists $this->{$columnsByName}->{$column->name}) { die new IMPL::InvalidOperationException("The column already exists",$column->name); } else { $this->{$columnsByName}->{$column->name} = $column; splice @{$this->{$columns}},$index,0,$column; } return $column; } sub RemoveColumn { my ($this,$NameOrColumn,$Force) = @_; my $ColName; if (UNIVERSAL::isa($NameOrColumn,'IMPL::SQL::Schema::Column')) { $ColName = $NameOrColumn->name; } elsif (not ref $NameOrColumn) { $ColName = $NameOrColumn; } if (exists $this->{$columnsByName}->{$ColName}) { my $index = 0; foreach my $column(@{$this->{$columns}}) { last if $column->name eq $ColName; $index++; } my $column = $this->{$columns}[$index]; if (my @constraints = $this->GetColumnConstraints($column)){ $Force or die new IMPL::InvalidOperationException('Can\'t remove column which is used in the constraints',@constraints); $this->RemoveConstraint($_) foreach @constraints; } my $removed = splice @{$this->{$columns}},$index,1; delete $this->{$columnsByName}->{$ColName}; return $removed; } else { die new IMPL::InvalidOperationException("The column not found",$NameOrColumn->name); } } sub GetColumn { my ($this,$name) = @_; return $this->{$columnsByName}->{$name}; } sub GetColumnAt { my ($this,$index) = @_; die new IMPL::InvalidArgumentException("The index is out of range") if $index < 0 || $index >= ($this->{$columns} ? scalar(@{$this->{$columns}}) : 0); return $this->{$columns}[$index]; } sub ColumnsCount { my ($this) = @_; return scalar(@{$this->{$columns}}); } sub AddConstraint { my $this = shift; if (@_ == 1) { my ($Constraint) = @_; die new IMPL::InvalidArgumentException('The invalid parameter') if not is($Constraint,typeof IMPL::SQL::Schema::Constraint); $Constraint->table == $this or die new IMPL::InvalidOperationException('The constaint must belong to the target table'); if (exists $this->{$constraints}->{$Constraint->name}) { die new IMPL::InvalidOperationException('The table already has the specified constraint',$Constraint->name); } else { if (UNIVERSAL::isa($Constraint,'IMPL::SQL::Schema::Constraint::PrimaryKey')) { not $this->{$primaryKey} or die new IMPL::InvalidOperationException('The table already has a primary key'); $this->{$primaryKey} = $Constraint; } $this->{$constraints}->{$Constraint->name} = $Constraint; } } elsif( @_ == 2) { my ($type,$params) = @_; $type = IMPL::SQL::Schema::Constraint->ResolveAlias($type) or die new IMPL::Exception("Can't resolve a constraint alias",$_[0]); $params->{table} = $this; $this->AddConstraint($type->new(%$params)); } else { die new IMPL::Exception("Wrong arguments number",scalar(@_)); } } sub RemoveConstraint { my ($this,$Constraint,$Force) = @_; my $cn = UNIVERSAL::isa($Constraint,'IMPL::SQL::Schema::Constraint') ? $Constraint->name : $Constraint; $Constraint = $this->{$constraints}->{$cn} or die new IMPL::InvalidOperationException('The specified constraint doesn\'t exists',$cn); if (UNIVERSAL::isa($Constraint,'IMPL::SQL::Schema::Constraint::PrimaryKey')) { not scalar keys %{$this->{$primaryKey}->ConnectedFK} or die new IMPL::InvalidOperationException('Can\'t remove Primary Key unless some foreign keys referenses it'); delete $this->{$primaryKey}; } $Constraint->Dispose; delete $this->{$constraints}->{$cn}; return $cn; } sub GetConstraint { my ($this,$name) = @_; return $this->{$constraints}{$name}; } sub GetConstraints { my ($this) = @_; return wantarray ? values %{$this->{$constraints}} : [values %{$this->{$constraints}}]; } sub GetColumnConstraints { my ($this,@Columns) = @_; my @cn = map { UNIVERSAL::isa($_ ,'IMPL::SQL::Schema::Column') ? $_ ->name : $_ } @Columns; exists $this->{$columnsByName}->{$_} or die new IMPL::InvalidOperationException('The specified column isn\'t found',$_) foreach @cn; return grep {$_->HasColumn(@cn)} values %{$this->{$constraints}}; } sub SetPrimaryKey { my ($this,@ColumnList) = @_; $this->AddConstraint(new IMPL::SQL::Schema::Constraint::PrimaryKey(name => $this->{$name}.'_PK', table => $this, columns => \@ColumnList)); } sub LinkTo { my ($this,$table,@ColumnList) = @_; $table->primaryKey or die new IMPL::InvalidOperationException('The referenced table must have a primary key'); my $constraintName = $this->{$name}.'_'.$table->name.'_FK_'.join('_',map {ref $_ ? $_->name : $_} @ColumnList); $this->AddConstraint(new IMPL::SQL::Schema::Constraint::ForeignKey(name => $constraintName, table => $this, columns => \@ColumnList, referencedTable => $table, referencedColumns => $table->primaryKey->columns->as_list)); } sub Dispose { my ($this) = @_; $_->Dispose() foreach values %{$this->{$constraints}}; undef %{$this}; $this->SUPER::Dispose(); } sub SameValue { my ($this,$other) = @_; return 0 unless is $other, typeof $this; return 0 unless $this->name eq $other->name; return 0 unless $this->ColumnsCount eq $other->ColumnsCount; for (my $i = 0; $i < $this->ColumsCount; $i ++) { return 0 unless $this->($i)->SameValue($other->GetColumnAt($i)); } my %thisConstraints = map { $_->name, $_ } $this->GetConstraints(); my %otherConstraints = map { $_->name, $_ } $other->GetConstraints(); foreach my $name ( keys %thisConstraints ) { return 0 unless $otherConstraints{$name}; return 0 unless $thisConstraints{$name}->SameValue(delete $otherConstraints{$name}); } return 0 if %otherConstraints; return 1; } 1;