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