Mercurial > pub > Impl
comparison 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 |
comparison
equal
deleted
inserted
replaced
| 270:3f59fd828d5f | 271:56364d0c4b4f |
|---|---|
| 8 | 8 |
| 9 use IMPL::Class::Property::Direct; | 9 use IMPL::Class::Property::Direct; |
| 10 | 10 |
| 11 BEGIN { | 11 BEGIN { |
| 12 public _direct property referencedPrimaryKey => PROP_GET; | 12 public _direct property referencedPrimaryKey => PROP_GET; |
| 13 public _direct property OnDelete => PROP_GET; | 13 public _direct property onDelete => PROP_GET; |
| 14 public _direct property OnUpdate => PROP_GET; | 14 public _direct property onUpdate => PROP_GET; |
| 15 } | 15 } |
| 16 | 16 |
| 17 __PACKAGE__->PassThroughArgs; | 17 __PACKAGE__->PassThroughArgs; |
| 18 __PACKAGE__->RegisterAlias('fk'); | 18 __PACKAGE__->RegisterAlias('fk'); |
| 19 | 19 |
| 20 sub CTOR { | 20 sub CTOR { |
| 21 my ($this,%args) = @_; | 21 my ($this,%args) = @_; |
| 22 | 22 |
| 23 die new Eexception("Referenced table must be an instance of a table object") if not UNIVERSAL::isa($args{'referencedTable'},'IMPL::SQL::Schema::Table'); | 23 die new Exception("Referenced table must be an instance of a table object") if not is($args{'referencedTable'},'IMPL::SQL::Schema::Table'); |
| 24 | 24 |
| 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'}}); | 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'}}); |
| 26 | 26 |
| 27 my @ReferencedColumns = map {IMPL::SQL::Schema::Constraint::ResolveColumn($args{'referencedTable'},$_)} @{$args{'referencedColumns'}}; | 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'); | 28 my $ForeingPK = $args{'referencedTable'}->primaryKey or die new Exception('The referenced table doesn\'t have a primary key'); |
| 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}; | 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}; |
| 37 | 37 |
| 38 $this->{$referencedPrimaryKey} = $ForeingPK; | 38 $this->{$referencedPrimaryKey} = $ForeingPK; |
| 39 | 39 |
| 40 $ForeingPK->ConnectFK($this); | 40 $ForeingPK->ConnectFK($this); |
| 41 | |
| 42 $this->onUpdate($args{onUpdate}) if $args{onUpdate}; | |
| 43 $this->onDelete($args{onDelete}) if $args{onDelete}; | |
| 41 } | 44 } |
| 42 | 45 |
| 43 sub Dispose { | 46 sub Dispose { |
| 44 my ($this) = @_; | 47 my ($this) = @_; |
| 45 | 48 |
| 50 } | 53 } |
| 51 | 54 |
| 52 sub SameValue { | 55 sub SameValue { |
| 53 my ($this,$other) = @_; | 56 my ($this,$other) = @_; |
| 54 | 57 |
| 55 uc $this->OnDelete eq uc $other->OnDelete or return 0; | 58 uc $this->onDelete eq uc $other->onDelete or return 0; |
| 56 uc $this->OnUpdate eq uc $other->OnUpdate or return 0; | 59 uc $this->onUpdate eq uc $other->onUpdate or return 0; |
| 57 | 60 |
| 58 return $this->SUPER::SameValue($other); | 61 return $this->SUPER::SameValue($other); |
| 59 } | 62 } |
| 60 | 63 |
| 61 | 64 |
