Mercurial > pub > Impl
comparison Lib/IMPL/SQL/Schema/Constraint/ForeignKey.pm @ 165:76515373dac0
Added Class::Template,
Rewritten SQL::Schema
'use parent' directive instead of 'use base'
author | wizard |
---|---|
date | Sat, 23 Apr 2011 23:06:48 +0400 |
parents | 16ada169ca75 |
children | 1f7a6d762394 |
comparison
equal
deleted
inserted
replaced
164:eb3e9861a761 | 165:76515373dac0 |
---|---|
1 package IMPL::SQL::Schema::Constraint::ForeignKey; | 1 package IMPL::SQL::Schema::Constraint::ForeignKey; |
2 use strict; | 2 use strict; |
3 use base qw(IMPL::SQL::Schema::Constraint); | 3 use parent qw(IMPL::SQL::Schema::Constraint); |
4 use IMPL::Class::Property; | 4 use IMPL::Class::Property; |
5 use IMPL::Class::Property::Direct; | 5 use IMPL::Class::Property::Direct; |
6 | 6 |
7 BEGIN { | 7 BEGIN { |
8 public _direct property ReferencedPrimaryKey => prop_get; | 8 public _direct property referencedPrimaryKey => prop_get; |
9 public _direct property OnDelete => prop_get; | 9 public _direct property OnDelete => prop_get; |
10 public _direct property OnUpdate => prop_get; | 10 public _direct property OnUpdate => prop_get; |
11 } | 11 } |
12 | 12 |
13 __PACKAGE__->PassThroughArgs; | 13 __PACKAGE__->PassThroughArgs; |
14 | 14 |
15 sub CTOR { | 15 sub CTOR { |
16 my ($this,%args) = @_; | 16 my ($this,%args) = @_; |
17 | 17 |
18 die new Eexception("Referenced table must be an instance of a table object") if not UNIVERSAL::isa($args{'ReferencedTable'},'IMPL::SQL::Schema::Table'); | 18 die new Eexception("Referenced table must be an instance of a table object") if not UNIVERSAL::isa($args{'referencedTable'},'IMPL::SQL::Schema::Table'); |
19 | 19 |
20 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'}}); | 20 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'}}); |
21 | 21 |
22 my @ReferencedColumns = map {IMPL::SQL::Schema::Constraint::ResolveColumn($args{'ReferencedTable'},$_)} @{$args{'ReferencedColumns'}}; | 22 my @ReferencedColumns = map {IMPL::SQL::Schema::Constraint::ResolveColumn($args{'referencedTable'},$_)} @{$args{'referencedColumns'}}; |
23 my $ForeingPK = $args{'ReferencedTable'}->PrimaryKey or die new Exception('The referenced table doesn\'t have a primary key'); | 23 my $ForeingPK = $args{'referencedTable'}->primaryKey or die new Exception('The referenced table doesn\'t have a primary key'); |
24 | 24 |
25 scalar (@ReferencedColumns) == scalar(@{$this->Columns}) or die new Exception('A foreing key columns doesn\'t match refenced columns'); | 25 scalar (@ReferencedColumns) == scalar(@{$this->columns}) or die new Exception('A foreing key columns doesn\'t match refenced columns'); |
26 my @ColumnsCopy = @ReferencedColumns; | 26 my @ColumnsCopy = @ReferencedColumns; |
27 | 27 |
28 die new Exception('A foreing key columns doesn\'t match refenced columns') if grep { not $_->Type->isSame((shift @ColumnsCopy)->Type)} @{$this->Columns}; | 28 die new Exception('A foreing key columns doesn\'t match refenced columns') if grep { not $_->type->isSame((shift @ColumnsCopy)->type)} @{$this->columns}; |
29 | 29 |
30 @ColumnsCopy = @ReferencedColumns; | 30 @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}; | 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}; |
32 | 32 |
33 $this->{$ReferencedPrimaryKey} = $ForeingPK; | 33 $this->{$referencedPrimaryKey} = $ForeingPK; |
34 | 34 |
35 $ForeingPK->ConnectFK($this); | 35 $ForeingPK->ConnectFK($this); |
36 } | 36 } |
37 | 37 |
38 sub Dispose { | 38 sub Dispose { |
39 my ($this) = @_; | 39 my ($this) = @_; |
40 | 40 |
41 $this->{$ReferencedPrimaryKey}->DisconnectFK($this) if not $this->{$ReferencedPrimaryKey}->isDisposed; | 41 $this->{$referencedPrimaryKey}->DisconnectFK($this) if not $this->{$referencedPrimaryKey}->isDisposed; |
42 delete $this->{$ReferencedPrimaryKey}; | 42 delete $this->{$referencedPrimaryKey}; |
43 | 43 |
44 $this->SUPER::Dispose; | 44 $this->SUPER::Dispose; |
45 } | 45 } |
46 | 46 |
47 sub isSame { | 47 sub isSame { |