view Lib/IMPL/SQL/Schema/Table.pm @ 186:6c0fee769b0c

IMPL::Web::View::TTControl tests, fixes
author cin
date Fri, 30 Mar 2012 16:40:34 +0400
parents 6148f89bb7bf
children 4d0e1962161c
line wrap: on
line source

use strict;
package IMPL::SQL::Schema::Table;

use IMPL::lang qw(:declare :constants 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;