annotate Lib/Schema/DB/Constraint.pm @ 31:d59526f6310e

Small fixes to Test framework (correct handlinf of the compilation errors in the test units) Imported and refactored SQL DB schema from the old project
author Sergey
date Mon, 09 Nov 2009 01:39:16 +0300
parents 03e58a454b20
children 16ada169ca75
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
1 package Schema::DB::Constraint;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
2 use Common;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
3 our @ISA = qw(Object);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
4
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
5 BEGIN {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
6 DeclareProperty Name => ACCESS_READ;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
7 DeclareProperty Table => ACCESS_READ;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
8 DeclareProperty Columns => ACCESS_READ;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
9 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
10
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
11 sub CTOR {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
12 my ($this,%args) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
13 die new Exception("The table argument must be an instance of a table object") if not UNIVERSAL::isa($args{'Table'},'Schema::DB::Table');
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
14 $this->{$Name} = $args{'Name'};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
15 $this->{$Table} = $args{'Table'};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
16 $this->{$Columns} = [map { ResolveColumn($this->Table,$_) } @{$args{'Columns'}}];
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
17 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
18
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
19 sub ResolveColumn {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
20 my ($Table,$Column) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
21
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
22 my $cn = UNIVERSAL::isa($Column,'Schema::DB::Column') ? $Column->Name : $Column;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
23
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
24 my $resolved = $Table->Column($cn);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
25 die new Exception("The column is not found in the table", $cn, $Table->Name) if not $resolved;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
26 return $resolved;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
27 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
28
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
29 sub HasColumn {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
30 my ($this,@Columns) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
31
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
32 my %Columns = map { $_, 1} @Columns;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
33
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
34 return scalar(grep { $Columns{$_->Name} } $this->Columns) == scalar(@Columns);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
35 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
36
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
37 sub UniqName {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
38 my ($this) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
39 return $this->{$Table}->Name.'_'.$this->{$Name};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
40 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
41
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
42 sub Dispose {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
43 my ($this) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
44
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
45 delete @$this{$Table,$Columns};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
46 $this->SUPER::Dispose;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
47 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
48 1;