view Lib/Schema/DB/Constraint/ForeignKey.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 4267a2ac3d46
line wrap: on
line source

package Schema::DB::Constraint::ForeignKey;
use strict;
use Common;
use base qw(Schema::DB::Constraint);

BEGIN {
    DeclareProperty ReferencedPrimaryKey => ACCESS_READ;
    DeclareProperty OnDelete => ACCESS_READ;
    DeclareProperty OnUpdate => ACCESS_READ;
}

sub CTOR {
    my ($this,%args) = @_;
    
    $this->SUPER::CTOR(%args);
    
    
    die new Eexception("Referenced table must be an instance of a table object") if not UNIVERSAL::isa($args{'ReferencedTable'},'Schema::DB::Table');
    
    die new Exception("Referenced columns must be a not empty list of columns") if not UNIVERSAL::isa($args{'ReferencedColumns'},'ARRAY') or not scalar(@{$args{'ReferencedColumns'}});
    
    my @ReferencedColumns = map {Schema::DB::Constraint::ResolveColumn($args{'ReferencedTable'},$_)} @{$args{'ReferencedColumns'}};
    my $ForeingPK = $args{'ReferencedTable'}->PrimaryKey or die new Exception('The referenced table doesn\'t have a primary key');
    
    scalar (@ReferencedColumns) == scalar(@{$this->Columns}) or die new Exception('A foreing key columns doesn\'t match refenced columns');
    my @ColumnsCopy = @ReferencedColumns;
    
    die new Exception('A foreing key columns doesn\'t match refenced columns') if grep { not $_->Type->isSame((shift @ColumnsCopy)->Type)} $this->Columns;
    
    @ColumnsCopy = @ReferencedColumns;
    die new Exception('The foreign key must match to the primary key of the referenced table',$this->Name) if grep { not $_->Type->isSame(shift(@ColumnsCopy)->Type)} $ForeingPK->Columns;
    
    $this->{$ReferencedPrimaryKey} = $ForeingPK;
    
    $ForeingPK->ConnectFK($this);
}

sub Dispose {
    my ($this) = @_;

    $this->{$ReferencedPrimaryKey}->DisconnectFK($this) if not $this->{$ReferencedPrimaryKey}->isa('Object::Disposed');
    delete $this->{$ReferencedPrimaryKey};
    
    $this->SUPER::Dispose;
}

sub isSame {
    my ($this,$other) = @_;
    
    uc $this->OnDelete eq uc $other->OnDelete or return 0;
    uc $this->OnUpdate eq uc $other->OnUpdate or return 0;
    
    return $this->SUPER::isSame($other);
}



1;