Mercurial > pub > Impl
annotate Lib/IMPL/SQL/Schema/Constraint/ForeignKey.pm @ 282:68d905f8dc43
*IMPL::SQL fixed warnings
| author | cin |
|---|---|
| date | Tue, 12 Feb 2013 01:24:36 +0400 |
| parents | 4ddb27ff4a0b |
| children |
| rev | line source |
|---|---|
| 49 | 1 package IMPL::SQL::Schema::Constraint::ForeignKey; |
| 2 use strict; | |
| 167 | 3 use warnings; |
| 4 | |
| 232 | 5 use IMPL::lang qw(:declare is); |
| 167 | 6 |
| 165 | 7 use parent qw(IMPL::SQL::Schema::Constraint); |
| 167 | 8 |
| 49 | 9 |
| 10 BEGIN { | |
| 167 | 11 public _direct property referencedPrimaryKey => PROP_GET; |
|
271
56364d0c4b4f
+IMPL::SQL::Schema::MySQL: added basic support for MySQL
cin
parents:
232
diff
changeset
|
12 public _direct property onDelete => PROP_GET; |
|
56364d0c4b4f
+IMPL::SQL::Schema::MySQL: added basic support for MySQL
cin
parents:
232
diff
changeset
|
13 public _direct property onUpdate => PROP_GET; |
| 49 | 14 } |
| 15 | |
| 16 __PACKAGE__->PassThroughArgs; | |
| 168 | 17 __PACKAGE__->RegisterAlias('fk'); |
| 49 | 18 |
| 19 sub CTOR { | |
| 20 my ($this,%args) = @_; | |
| 21 | |
|
271
56364d0c4b4f
+IMPL::SQL::Schema::MySQL: added basic support for MySQL
cin
parents:
232
diff
changeset
|
22 die new Exception("Referenced table must be an instance of a table object") if not is($args{'referencedTable'},'IMPL::SQL::Schema::Table'); |
| 49 | 23 |
| 165 | 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'}}); |
| 49 | 25 |
| 165 | 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'); | |
| 49 | 28 |
| 168 | 29 scalar (@ReferencedColumns) == $this->columns->Count or die new Exception('A foreing key columns doesn\'t match refenced columns'); |
| 49 | 30 my @ColumnsCopy = @ReferencedColumns; |
| 31 | |
| 167 | 32 die new Exception('A foreing key columns doesn\'t match refenced columns') if grep { not $_->type->SameValue((shift @ColumnsCopy)->type)} @{$this->columns}; |
| 49 | 33 |
| 34 @ColumnsCopy = @ReferencedColumns; | |
| 167 | 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}; |
| 49 | 36 |
| 165 | 37 $this->{$referencedPrimaryKey} = $ForeingPK; |
| 49 | 38 |
| 39 $ForeingPK->ConnectFK($this); | |
|
271
56364d0c4b4f
+IMPL::SQL::Schema::MySQL: added basic support for MySQL
cin
parents:
232
diff
changeset
|
40 |
|
56364d0c4b4f
+IMPL::SQL::Schema::MySQL: added basic support for MySQL
cin
parents:
232
diff
changeset
|
41 $this->onUpdate($args{onUpdate}) if $args{onUpdate}; |
|
56364d0c4b4f
+IMPL::SQL::Schema::MySQL: added basic support for MySQL
cin
parents:
232
diff
changeset
|
42 $this->onDelete($args{onDelete}) if $args{onDelete}; |
| 49 | 43 } |
| 44 | |
| 45 sub Dispose { | |
| 46 my ($this) = @_; | |
| 47 | |
| 165 | 48 $this->{$referencedPrimaryKey}->DisconnectFK($this) if not $this->{$referencedPrimaryKey}->isDisposed; |
| 49 delete $this->{$referencedPrimaryKey}; | |
| 49 | 50 |
| 51 $this->SUPER::Dispose; | |
| 52 } | |
| 53 | |
| 167 | 54 sub SameValue { |
| 49 | 55 my ($this,$other) = @_; |
| 56 | |
| 282 | 57 uc($this->onDelete || '') eq uc($other->onDelete || '')or return 0; |
| 58 uc($this->onUpdate || '') eq uc($other->onUpdate || '') or return 0; | |
| 49 | 59 |
| 167 | 60 return $this->SUPER::SameValue($other); |
| 49 | 61 } |
| 62 | |
| 63 | |
| 64 | |
| 65 1; |