Mercurial > pub > Impl
view Lib/IMPL/SQL/Schema/Constraint/ForeignKey.pm @ 320:28eba7e0c592
*web application action: added method to access HTTP request header.
author | sergey |
---|---|
date | Thu, 16 May 2013 17:16:41 +0400 |
parents | 68d905f8dc43 |
children |
line wrap: on
line source
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;