Mercurial > pub > Impl
view Lib/IMPL/SQL/Schema/Table.pm @ 114:7084af955c57
minor changes, more strict code, no bugs fixed, no features added
author | wizard |
---|---|
date | Tue, 25 May 2010 01:26:42 +0400 |
parents | 16ada169ca75 |
children | 6ce1f052b90a |
line wrap: on
line source
use strict; package IMPL::SQL::Schema::Table; use IMPL::SQL::Schema::Column; use IMPL::SQL::Schema::Constraint; use IMPL::SQL::Schema::Constraint::PrimaryKey; use IMPL::SQL::Schema::Constraint::ForeignKey; use base qw(IMPL::Object IMPL::Object::Disposable); use IMPL::Class::Property; use IMPL::Class::Property::Direct; srand time; 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 => prop_none; 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'); } 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 Column { my ($this,$name) = @_; return $this->{$ColumnsByName}->{$name}; } sub ColumnAt { 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 AddConstraint { my ($this,$Constraint) = @_; die new IMPL::InvalidArgumentException('The invalid parameter') if not UNIVERSAL::isa($Constraint,'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; } } 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 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)); } sub Dispose { my ($this) = @_; $_->Dispose() foreach values %{$this->{$Constraints}}; undef %{$this}; $this->SUPER::Dispose(); } 1;