|
49
|
1 package IMPL::SQL::Schema::Constraint::ForeignKey;
|
|
|
2 use strict;
|
|
|
3 use base qw(IMPL::SQL::Schema::Constraint);
|
|
|
4 use IMPL::Class::Property;
|
|
|
5 use IMPL::Class::Property::Direct;
|
|
|
6
|
|
|
7 BEGIN {
|
|
|
8 public _direct property ReferencedPrimaryKey => prop_get;
|
|
|
9 public _direct property OnDelete => prop_get;
|
|
|
10 public _direct property OnUpdate => prop_get;
|
|
|
11 }
|
|
|
12
|
|
|
13 __PACKAGE__->PassThroughArgs;
|
|
|
14
|
|
|
15 sub CTOR {
|
|
|
16 my ($this,%args) = @_;
|
|
|
17
|
|
|
18 die new Eexception("Referenced table must be an instance of a table object") if not UNIVERSAL::isa($args{'ReferencedTable'},'IMPL::SQL::Schema::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 {IMPL::SQL::Schema::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}->isDisposed;
|
|
|
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;
|
