Mercurial > pub > Impl

comparison lib/IMPL/SQL/Schema/Constraint/ForeignKey.pm @ 407:c6e90e02dd17 ref20150831

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
renamed Lib->lib
author cin
date Fri, 04 Sep 2015 19:40:23 +0300
parents
children
comparison
equal deleted inserted replaced
406:f23fcb19d3c1 407:c6e90e02dd17
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;