view Lib/IMPL/SQL/Schema/Table.pm @ 59:0f3e369553bd

Rewritten property implementation (probably become slower but more flexible) Configuration infrastructure in progress (in the aspect of the lazy activation) Initial concept for the code generator
author wizard
date Tue, 09 Mar 2010 02:50:45 +0300
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;