view Lib/IMPL/SQL/Schema/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 76515373dac0
line wrap: on
line source

package IMPL::SQL::Schema::Constraint::ForeignKey;
use strict;
use base qw(IMPL::SQL::Schema::Constraint);
use IMPL::Class::Property;
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;

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) == 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}->isDisposed;
    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;