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