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

renamed Lib->lib
author cin
date Fri, 04 Sep 2015 19:40:23 +0300
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/IMPL/SQL/Schema/Constraint/ForeignKey.pm	Fri Sep 04 19:40:23 2015 +0300
@@ -0,0 +1,65 @@
+package IMPL::SQL::Schema::Constraint::ForeignKey;
+use strict;
+use warnings;
+
+use IMPL::lang qw(:declare is);
+
+use parent qw(IMPL::SQL::Schema::Constraint);
+
+
+BEGIN {
+    public _direct property referencedPrimaryKey => PROP_GET;
+    public _direct property onDelete => PROP_GET;
+    public _direct property onUpdate => PROP_GET;
+}
+
+__PACKAGE__->PassThroughArgs;
+__PACKAGE__->RegisterAlias('fk');
+
+sub CTOR {
+    my ($this,%args) = @_;    
+    
+    die new Exception("Referenced table must be an instance of a table object") if not is($args{'referencedTable'},'IMPL::SQL::Schema::Table');
+    
+    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'}});
+    
+    my @ReferencedColumns = map {IMPL::SQL::Schema::Constraint::ResolveColumn($args{'referencedTable'},$_)} @{$args{'referencedColumns'}};
+    my $ForeingPK = $args{'referencedTable'}->primaryKey or die new Exception('The referenced table doesn\'t have a primary key');
+    
+    scalar (@ReferencedColumns) == $this->columns->Count or die new Exception('A foreing key columns doesn\'t match refenced columns');
+    my @ColumnsCopy = @ReferencedColumns;
+    
+    die new Exception('A foreing key columns doesn\'t match refenced columns') if grep { not $_->type->SameValue((shift @ColumnsCopy)->type)} @{$this->columns};
+    
+    @ColumnsCopy = @ReferencedColumns;
+    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};
+    
+    $this->{$referencedPrimaryKey} = $ForeingPK;
+    
+    $ForeingPK->ConnectFK($this);
+    
+    $this->onUpdate($args{onUpdate}) if $args{onUpdate};
+    $this->onDelete($args{onDelete}) if $args{onDelete};
+}
+
+sub Dispose {
+    my ($this) = @_;
+
+    $this->{$referencedPrimaryKey}->DisconnectFK($this) if not $this->{$referencedPrimaryKey}->isDisposed;
+    delete $this->{$referencedPrimaryKey};
+    
+    $this->SUPER::Dispose;
+}
+
+sub SameValue {
+    my ($this,$other) = @_;
+    
+    uc($this->onDelete || '') eq uc($other->onDelete || '')or return 0;
+    uc($this->onUpdate || '') eq uc($other->onUpdate || '') or return 0;
+    
+    return $this->SUPER::SameValue($other);
+}
+
+
+
+1;