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 |