annotate Lib/Schema/DB/Table.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 use strict;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
2 package Schema::DB::Table;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
3 use Carp;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
4 use Common;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
5
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
6 use Schema::DB::Column;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
7 use Schema::DB::Constraint;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
8 use Schema::DB::Constraint::PrimaryKey;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
9 use Schema::DB::Constraint::ForeignKey;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
10
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
11 our @ISA = qw(Object);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
12
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
13 srand time;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
14
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
15 BEGIN {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
16 DeclareProperty Name => ACCESS_READ;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
17 DeclareProperty Schema => ACCESS_READ;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
18 DeclareProperty Columns => ACCESS_READ;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
19 DeclareProperty Constraints => ACCESS_READ;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
20 DeclareProperty ColumnsByName => ACCESS_NONE;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
21 DeclareProperty PrimaryKey => ACCESS_READ;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
22 DeclareProperty Tag => ACCESS_ALL;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
23 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
24
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
25 sub CTOR {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
26 my ($this,%args) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
27
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
28 $this->{$Name} = $args{'Name'} or die new Exception('a table name is required');
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
29 $this->{$Schema} = $args{'Schema'} or die new Exception('a parent schema is required');
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
30 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
31
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
32 sub InsertColumn {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
33 my ($this,$column,$index) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
34
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
35 $index = ($this->{$Columns} ? scalar(@{$this->{$Columns}}) : 0) if not defined $index;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
36
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
37 die new Exception("Index is out of range") if ($index < 0 || $index > ($this->{$Columns} ? scalar(@{$this->{$Columns}}) : 0));
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
38
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
39 if (UNIVERSAL::isa($column,'Schema::DB::Column')) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
40
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
41 } elsif (UNIVERSAL::isa($column,'HASH')) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
42 $column = new Schema::DB::Column(%{$column});
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
43 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
44 die new Exception("The invalid parameter");
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
45 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
46
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
47 if (exists $this->{$ColumnsByName}->{$column->Name}) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
48 die new Exception("The column already exists",$column->name);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
49 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
50 $this->{$ColumnsByName}->{$column->Name} = $column;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
51 splice @{$this->{$Columns}},$index,0,$column;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
52 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
53
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
54 return $column;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
55 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
56
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
57 sub RemoveColumn {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
58 my ($this,$NameOrColumn,$Force) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
59
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
60 my $ColName;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
61 if (UNIVERSAL::isa($NameOrColumn,'Schema::DB::Column')) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
62 $ColName = $NameOrColumn->Name;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
63 } elsif (not ref $NameOrColumn) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
64 $ColName = $NameOrColumn;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
65 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
66
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
67 if (exists $this->{$ColumnsByName}->{$ColName}) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
68 my $index = 0;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
69 foreach my $column(@{$this->{$Columns}}) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
70 last if $column->Name eq $ColName;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
71 $index++;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
72 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
73
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
74 my $column = $this->{$Columns}[$index];
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
75 if (my @constraints = $this->GetColumnConstraints($column)){
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
76 $Force or die new Exception('Can\'t remove column which is used in the constraints',@constraints);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
77 $this->RemoveConstraint($_) foreach @constraints;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
78 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
79
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
80 my $removed = splice @{$this->{$Columns}},$index,1;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
81 delete $this->{$ColumnsByName}->{$ColName};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
82 return $removed;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
83 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
84 die new Exception("The column not found",$NameOrColumn->Name);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
85 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
86 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
87
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
88 sub Column {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
89 my ($this,$name) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
90
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
91 return $this->{$ColumnsByName}->{$name};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
92 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
93
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
94 sub ColumnAt {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
95 my ($this,$index) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
96
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
97 die new Exception("The index is out of range") if $index < 0 || $index >= ($this->{$Columns} ? scalar(@{$this->{$Columns}}) : 0);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
98
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
99 return $this->{$Columns}[$index];
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
100 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
101
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
102 sub AddConstraint {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
103 my ($this,$Constraint) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
104
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
105 die new Exception('The invalid parameter') if not UNIVERSAL::isa($Constraint,'Schema::DB::Constraint');
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
106
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
107 $Constraint->Table == $this or die new Exception('The constaint must belong to the target table');
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
108
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
109 if (exists $this->{$Constraints}->{$Constraint->Name}) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
110 die new Exception('The table already has the specified constraint',$Constraint->Name);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
111 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
112 if (UNIVERSAL::isa($Constraint,'Schema::DB::Constraint::PrimaryKey')) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
113 not $this->{$PrimaryKey} or die new Exception('The table already has a primary key');
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
114 $this->{$PrimaryKey} = $Constraint;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
115 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
116
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
117 $this->{$Constraints}->{$Constraint->Name} = $Constraint;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
118 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
119 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
120
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
121 sub RemoveConstraint {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
122 my ($this,$Constraint,$Force) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
123
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
124 my $cn = UNIVERSAL::isa($Constraint,'Schema::DB::Constraint') ? $Constraint->Name : $Constraint;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
125 $Constraint = $this->{$Constraints}->{$cn} or die new Exception('The specified constraint doesn\'t exists',$cn);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
126
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
127 if (UNIVERSAL::isa($Constraint,'Schema::DB::Constraint::PrimaryKey')) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
128 not scalar keys %{$this->{$PrimaryKey}->ConnectedFK} or die new Exception('Can\'t remove Primary Key unless some foreign keys referenses it');
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
129
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
130 delete $this->{$PrimaryKey};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
131 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
132 $Constraint->Dispose;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
133 delete $this->{$Constraints}->{$cn};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
134 return $cn;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
135 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
136
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
137 sub GetColumnConstraints {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
138 my ($this,@Columns) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
139
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
140 my @cn = map { UNIVERSAL::isa($_ ,'Schema::DB::Column') ? $_ ->Name : $_ } @Columns;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
141 exists $this->{$ColumnsByName}->{$_} or die new Exception('The specified column isn\'t found',$_) foreach @cn;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
142
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
143 return grep {$_->HasColumn(@cn)} values %{$this->{$Constraints}};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
144 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
145
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
146 sub SetPrimaryKey {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
147 my ($this,@ColumnList) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
148
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
149 $this->AddConstraint(new Schema::DB::Constraint::PrimaryKey(Name => $this->{$Name}.'_PK', Table => $this,Columns => \@ColumnList));
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
150 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
151
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
152 sub LinkTo {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
153 my ($this,$table,@ColumnList) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
154 $table->PrimaryKey or die new Exception('The referenced table must have a primary key');
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
155 my $constraintName = $this->{$Name}.'_'.$table->Name.'_FK_'.join('_',map {ref $_ ? $_->Name : $_} @ColumnList);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
156 $this->AddConstraint(new Schema::DB::Constraint::ForeignKey(Name => $constraintName, Table => $this,Columns => \@ColumnList, ReferencedTable => $table, ReferencedColumns => scalar($table->PrimaryKey->Columns)));
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
157 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
158
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
159 sub Dispose {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
160 my ($this) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
161
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
162 $_->Dispose() foreach values %{$this->{$Constraints}};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
163
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
164 undef %{$this};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
165 $this->SUPER::Dispose();
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
166 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
167
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
168 1;