view Lib/IMPL/SQL/Schema/Constraint/ForeignKey.pm @ 165:76515373dac0

Added Class::Template, Rewritten SQL::Schema 'use parent' directive instead of 'use base'
author wizard
date Sat, 23 Apr 2011 23:06:48 +0400
parents 16ada169ca75
children 1f7a6d762394
line wrap: on
line source

package IMPL::SQL::Schema::Constraint::ForeignKey;
use strict;
use parent 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;