49
+ − 1 package Schema::DB::Constraint::ForeignKey;
+ − 2 use strict;
+ − 3 use Common;
+ − 4 use base qw(Schema::DB::Constraint);
+ − 5
+ − 6 BEGIN {
+ − 7 DeclareProperty ReferencedPrimaryKey => ACCESS_READ;
+ − 8 DeclareProperty OnDelete => ACCESS_READ;
+ − 9 DeclareProperty OnUpdate => ACCESS_READ;
+ − 10 }
+ − 11
+ − 12 sub CTOR {
+ − 13 my ($this,%args) = @_;
+ − 14
+ − 15 $this->SUPER::CTOR(%args);
+ − 16
+ − 17
+ − 18 die new Eexception("Referenced table must be an instance of a table object") if not UNIVERSAL::isa($args{'ReferencedTable'},'Schema::DB::Table');
+ − 19
+ − 20 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'}});
+ − 21
+ − 22 my @ReferencedColumns = map {Schema::DB::Constraint::ResolveColumn($args{'ReferencedTable'},$_)} @{$args{'ReferencedColumns'}};
+ − 23 my $ForeingPK = $args{'ReferencedTable'}->PrimaryKey or die new Exception('The referenced table doesn\'t have a primary key');
+ − 24
+ − 25 scalar (@ReferencedColumns) == scalar(@{$this->Columns}) or die new Exception('A foreing key columns doesn\'t match refenced columns');
+ − 26 my @ColumnsCopy = @ReferencedColumns;
+ − 27
+ − 28 die new Exception('A foreing key columns doesn\'t match refenced columns') if grep { not $_->Type->isSame((shift @ColumnsCopy)->Type)} $this->Columns;
+ − 29
+ − 30 @ColumnsCopy = @ReferencedColumns;
+ − 31 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;
+ − 32
+ − 33 $this->{$ReferencedPrimaryKey} = $ForeingPK;
+ − 34
+ − 35 $ForeingPK->ConnectFK($this);
+ − 36 }
+ − 37
+ − 38 sub Dispose {
+ − 39 my ($this) = @_;
+ − 40
+ − 41 $this->{$ReferencedPrimaryKey}->DisconnectFK($this) if not $this->{$ReferencedPrimaryKey}->isa('Object::Disposed');
+ − 42 delete $this->{$ReferencedPrimaryKey};
+ − 43
+ − 44 $this->SUPER::Dispose;
+ − 45 }
+ − 46
+ − 47 sub isSame {
+ − 48 my ($this,$other) = @_;
+ − 49
+ − 50 uc $this->OnDelete eq uc $other->OnDelete or return 0;
+ − 51 uc $this->OnUpdate eq uc $other->OnUpdate or return 0;
+ − 52
+ − 53 return $this->SUPER::isSame($other);
+ − 54 }
+ − 55
+ − 56
+ − 57
+ − 58 1;