Mercurial > pub > Impl
view Lib/Schema/DB/Constraint/ForeignKey.pm @ 99:6dd659f6f66c
Minor changes, DOM schema is in development (in the aspect of a forms)
author | wizard |
---|---|
date | Wed, 05 May 2010 17:33:55 +0400 |
parents | 16ada169ca75 |
children | 4267a2ac3d46 |
line wrap: on
line source
package Schema::DB::Constraint::ForeignKey; use strict; use Common; use base qw(Schema::DB::Constraint); BEGIN { DeclareProperty ReferencedPrimaryKey => ACCESS_READ; DeclareProperty OnDelete => ACCESS_READ; DeclareProperty OnUpdate => ACCESS_READ; } sub CTOR { my ($this,%args) = @_; $this->SUPER::CTOR(%args); die new Eexception("Referenced table must be an instance of a table object") if not UNIVERSAL::isa($args{'ReferencedTable'},'Schema::DB::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 {Schema::DB::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) == scalar(@{$this->Columns}) 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->isSame((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->isSame(shift(@ColumnsCopy)->Type)} $ForeingPK->Columns; $this->{$ReferencedPrimaryKey} = $ForeingPK; $ForeingPK->ConnectFK($this); } sub Dispose { my ($this) = @_; $this->{$ReferencedPrimaryKey}->DisconnectFK($this) if not $this->{$ReferencedPrimaryKey}->isa('Object::Disposed'); delete $this->{$ReferencedPrimaryKey}; $this->SUPER::Dispose; } sub isSame { 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::isSame($other); } 1;