Mercurial > pub > Impl
diff Lib/IMPL/SQL/Schema/Constraint/ForeignKey.pm @ 49:16ada169ca75
migrating to the Eclipse IDE
author | wizard@linux-odin.local |
---|---|
date | Fri, 26 Feb 2010 10:49:21 +0300 |
parents | 0004faa276dc |
children | 76515373dac0 |
line wrap: on
line diff
--- a/Lib/IMPL/SQL/Schema/Constraint/ForeignKey.pm Fri Feb 26 01:43:42 2010 +0300 +++ b/Lib/IMPL/SQL/Schema/Constraint/ForeignKey.pm Fri Feb 26 10:49:21 2010 +0300 @@ -1,58 +1,58 @@ -package IMPL::SQL::Schema::Constraint::ForeignKey; -use strict; -use base qw(IMPL::SQL::Schema::Constraint); -use IMPL::Class::Property; -use IMPL::Class::Property::Direct; - -BEGIN { - public _direct property ReferencedPrimaryKey => prop_get; - public _direct property OnDelete => prop_get; - public _direct property OnUpdate => prop_get; -} - -__PACKAGE__->PassThroughArgs; - -sub CTOR { - my ($this,%args) = @_; - - die new Eexception("Referenced table must be an instance of a table object") if not UNIVERSAL::isa($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) == 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}->isDisposed; - 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; \ No newline at end of file +package IMPL::SQL::Schema::Constraint::ForeignKey; +use strict; +use base qw(IMPL::SQL::Schema::Constraint); +use IMPL::Class::Property; +use IMPL::Class::Property::Direct; + +BEGIN { + public _direct property ReferencedPrimaryKey => prop_get; + public _direct property OnDelete => prop_get; + public _direct property OnUpdate => prop_get; +} + +__PACKAGE__->PassThroughArgs; + +sub CTOR { + my ($this,%args) = @_; + + die new Eexception("Referenced table must be an instance of a table object") if not UNIVERSAL::isa($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) == 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}->isDisposed; + 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;