407
+ − 1 package IMPL::SQL::Schema::Constraint::ForeignKey;
+ − 2 use strict;
+ − 3 use warnings;
+ − 4
+ − 5 use IMPL::lang qw(:declare is);
+ − 6
+ − 7 use parent qw(IMPL::SQL::Schema::Constraint);
+ − 8
+ − 9
+ − 10 BEGIN {
+ − 11 public _direct property referencedPrimaryKey => PROP_GET;
+ − 12 public _direct property onDelete => PROP_GET;
+ − 13 public _direct property onUpdate => PROP_GET;
+ − 14 }
+ − 15
+ − 16 __PACKAGE__->PassThroughArgs;
+ − 17 __PACKAGE__->RegisterAlias('fk');
+ − 18
+ − 19 sub CTOR {
+ − 20 my ($this,%args) = @_;
+ − 21
+ − 22 die new Exception("Referenced table must be an instance of a table object") if not is($args{'referencedTable'},'IMPL::SQL::Schema::Table');
+ − 23
+ − 24 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'}});
+ − 25
+ − 26 my @ReferencedColumns = map {IMPL::SQL::Schema::Constraint::ResolveColumn($args{'referencedTable'},$_)} @{$args{'referencedColumns'}};
+ − 27 my $ForeingPK = $args{'referencedTable'}->primaryKey or die new Exception('The referenced table doesn\'t have a primary key');
+ − 28
+ − 29 scalar (@ReferencedColumns) == $this->columns->Count or die new Exception('A foreing key columns doesn\'t match refenced columns');
+ − 30 my @ColumnsCopy = @ReferencedColumns;
+ − 31
+ − 32 die new Exception('A foreing key columns doesn\'t match refenced columns') if grep { not $_->type->SameValue((shift @ColumnsCopy)->type)} @{$this->columns};
+ − 33
+ − 34 @ColumnsCopy = @ReferencedColumns;
+ − 35 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};
+ − 36
+ − 37 $this->{$referencedPrimaryKey} = $ForeingPK;
+ − 38
+ − 39 $ForeingPK->ConnectFK($this);
+ − 40
+ − 41 $this->onUpdate($args{onUpdate}) if $args{onUpdate};
+ − 42 $this->onDelete($args{onDelete}) if $args{onDelete};
+ − 43 }
+ − 44
+ − 45 sub Dispose {
+ − 46 my ($this) = @_;
+ − 47
+ − 48 $this->{$referencedPrimaryKey}->DisconnectFK($this) if not $this->{$referencedPrimaryKey}->isDisposed;
+ − 49 delete $this->{$referencedPrimaryKey};
+ − 50
+ − 51 $this->SUPER::Dispose;
+ − 52 }
+ − 53
+ − 54 sub SameValue {
+ − 55 my ($this,$other) = @_;
+ − 56
+ − 57 uc($this->onDelete || '') eq uc($other->onDelete || '')or return 0;
+ − 58 uc($this->onUpdate || '') eq uc($other->onUpdate || '') or return 0;
+ − 59
+ − 60 return $this->SUPER::SameValue($other);
+ − 61 }
+ − 62
+ − 63
+ − 64
+ − 65 1;