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