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 {