Mercurial > pub > Impl
comparison Lib/IMPL/SQL/Schema/Constraint/ForeignKey.pm @ 167:1f7a6d762394
SQL schema in progress
author | sourcer |
---|---|
date | Thu, 12 May 2011 08:57:19 +0400 |
parents | 76515373dac0 |
children | 6148f89bb7bf |
comparison
equal
deleted
inserted
replaced
166:4267a2ac3d46 | 167:1f7a6d762394 |
---|---|
1 package IMPL::SQL::Schema::Constraint::ForeignKey; | 1 package IMPL::SQL::Schema::Constraint::ForeignKey; |
2 use strict; | 2 use strict; |
3 use warnings; | |
4 | |
5 use IMPL::lang qw(:declare :constants is); | |
6 | |
3 use parent qw(IMPL::SQL::Schema::Constraint); | 7 use parent qw(IMPL::SQL::Schema::Constraint); |
4 use IMPL::Class::Property; | 8 |
5 use IMPL::Class::Property::Direct; | 9 use IMPL::Class::Property::Direct; |
6 | 10 |
7 BEGIN { | 11 BEGIN { |
8 public _direct property referencedPrimaryKey => prop_get; | 12 public _direct property referencedPrimaryKey => PROP_GET; |
9 public _direct property OnDelete => prop_get; | 13 public _direct property OnDelete => PROP_GET; |
10 public _direct property OnUpdate => prop_get; | 14 public _direct property OnUpdate => PROP_GET; |
11 } | 15 } |
12 | 16 |
13 __PACKAGE__->PassThroughArgs; | 17 __PACKAGE__->PassThroughArgs; |
14 | 18 |
15 sub CTOR { | 19 sub CTOR { |
23 my $ForeingPK = $args{'referencedTable'}->primaryKey or die new Exception('The referenced table doesn\'t have a primary key'); | 27 my $ForeingPK = $args{'referencedTable'}->primaryKey or die new Exception('The referenced table doesn\'t have a primary key'); |
24 | 28 |
25 scalar (@ReferencedColumns) == scalar(@{$this->columns}) or die new Exception('A foreing key columns doesn\'t match refenced columns'); | 29 scalar (@ReferencedColumns) == scalar(@{$this->columns}) or die new Exception('A foreing key columns doesn\'t match refenced columns'); |
26 my @ColumnsCopy = @ReferencedColumns; | 30 my @ColumnsCopy = @ReferencedColumns; |
27 | 31 |
28 die new Exception('A foreing key columns doesn\'t match refenced columns') if grep { not $_->type->isSame((shift @ColumnsCopy)->type)} @{$this->columns}; | 32 die new Exception('A foreing key columns doesn\'t match refenced columns') if grep { not $_->type->SameValue((shift @ColumnsCopy)->type)} @{$this->columns}; |
29 | 33 |
30 @ColumnsCopy = @ReferencedColumns; | 34 @ColumnsCopy = @ReferencedColumns; |
31 die new Exception('The foreign key must match to the primary key of the referenced table',$this->name) if grep { not $_->type->isSame(shift(@ColumnsCopy)->type)} @{$ForeingPK->columns}; | 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}; |
32 | 36 |
33 $this->{$referencedPrimaryKey} = $ForeingPK; | 37 $this->{$referencedPrimaryKey} = $ForeingPK; |
34 | 38 |
35 $ForeingPK->ConnectFK($this); | 39 $ForeingPK->ConnectFK($this); |
36 } | 40 } |
42 delete $this->{$referencedPrimaryKey}; | 46 delete $this->{$referencedPrimaryKey}; |
43 | 47 |
44 $this->SUPER::Dispose; | 48 $this->SUPER::Dispose; |
45 } | 49 } |
46 | 50 |
47 sub isSame { | 51 sub SameValue { |
48 my ($this,$other) = @_; | 52 my ($this,$other) = @_; |
49 | 53 |
50 uc $this->OnDelete eq uc $other->OnDelete or return 0; | 54 uc $this->OnDelete eq uc $other->OnDelete or return 0; |
51 uc $this->OnUpdate eq uc $other->OnUpdate or return 0; | 55 uc $this->OnUpdate eq uc $other->OnUpdate or return 0; |
52 | 56 |
53 return $this->SUPER::isSame($other); | 57 return $this->SUPER::SameValue($other); |
54 } | 58 } |
55 | 59 |
56 | 60 |
57 | 61 |
58 1; | 62 1; |