view Lib/IMPL/SQL/Schema/Table.pm @ 250:129e48bb5afb

DOM refactoring ObjectToDOM methods are virtual QueryToDOM uses inflators Fixed transform for the complex values in the ObjectToDOM QueryToDOM doesn't allow to use complex values (HASHes) as values for nodes (overpost problem)
author sergey
date Wed, 07 Nov 2012 04:17:53 +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;