view Lib/IMPL/SQL/Schema/Constraint/ForeignKey.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 56364d0c4b4f
line wrap: on
line source

package IMPL::SQL::Schema::Constraint::ForeignKey;
use strict;
use warnings;

use IMPL::lang qw(:declare is);

use parent qw(IMPL::SQL::Schema::Constraint);

use IMPL::Class::Property::Direct;

BEGIN {
    public _direct property referencedPrimaryKey => PROP_GET;
    public _direct property OnDelete => PROP_GET;
    public _direct property OnUpdate => PROP_GET;
}

__PACKAGE__->PassThroughArgs;
__PACKAGE__->RegisterAlias('fk');

sub CTOR {
    my ($this,%args) = @_;    
    
    die new Eexception("Referenced table must be an instance of a table object") if not UNIVERSAL::isa($args{'referencedTable'},'IMPL::SQL::Schema::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 {IMPL::SQL::Schema::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) == $this->columns->Count 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->SameValue((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->SameValue(shift(@ColumnsCopy)->type)} @{$ForeingPK->columns};
    
    $this->{$referencedPrimaryKey} = $ForeingPK;
    
    $ForeingPK->ConnectFK($this);
}

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

    $this->{$referencedPrimaryKey}->DisconnectFK($this) if not $this->{$referencedPrimaryKey}->isDisposed;
    delete $this->{$referencedPrimaryKey};
    
    $this->SUPER::Dispose;
}

sub SameValue {
    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::SameValue($other);
}



1;