view Lib/IMPL/SQL/Schema/Constraint/ForeignKey.pm @ 134:44977efed303

Significant performance optimizations Fixed recursion problems due converting objects to JSON Added cache support for the templates Added discovery feature for the web methods
author wizard
date Mon, 21 Jun 2010 02:39:53 +0400
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;