view Lib/Schema/DB/Constraint/ForeignKey.pm @ 55:609b59c9f03c

Web application rewrote prop_list implementation to support IMPL::Object::List
author wizard
date Wed, 03 Mar 2010 17:40:18 +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;