Mercurial > pub > Impl
comparison Lib/IMPL/SQL/Schema/Table.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 | 6ce1f052b90a |
children | 1f7a6d762394 |
comparison
equal
deleted
inserted
replaced
164:eb3e9861a761 | 165:76515373dac0 |
---|---|
1 use strict; | 1 use strict; |
2 package IMPL::SQL::Schema::Table; | 2 package IMPL::SQL::Schema::Table; |
3 | 3 |
4 use IMPL::SQL::Schema::Column; | 4 use IMPL::lang; |
5 use IMPL::SQL::Schema::Constraint; | 5 |
6 use IMPL::SQL::Schema::Constraint::PrimaryKey; | 6 use parent qw( |
7 use IMPL::SQL::Schema::Constraint::ForeignKey; | |
8 | |
9 use base qw( | |
10 IMPL::Object | 7 IMPL::Object |
11 IMPL::Object::Disposable | 8 IMPL::Object::Disposable |
12 IMPL::Object::Clonable | |
13 ); | 9 ); |
10 | |
11 use IMPL::SQL::Schema::Column(); | |
12 use IMPL::SQL::Schema::Constraint(); | |
13 use IMPL::SQL::Schema::Constraint::PrimaryKey(); | |
14 use IMPL::SQL::Schema::Constraint::ForeignKey(); | |
15 | |
14 use IMPL::Class::Property; | 16 use IMPL::Class::Property; |
15 use IMPL::Class::Property::Direct; | 17 use IMPL::Class::Property::Direct; |
16 | 18 |
17 BEGIN { | 19 BEGIN { |
18 public _direct property Name => prop_get; | 20 public _direct property name => prop_get; |
19 public _direct property Schema => prop_get; | 21 public _direct property schema => prop_get; |
20 public _direct property Columns => prop_get; | 22 public _direct property columns => prop_get; |
21 public _direct property Constraints => prop_get; | 23 public _direct property constraints => prop_get; |
22 public _direct property ColumnsByName => prop_none; | 24 public _direct property columnsByName => prop_none; |
23 public _direct property PrimaryKey => prop_get; | 25 public _direct property primaryKey => prop_get; |
24 public _direct property Tag => prop_all; | 26 public _direct property tag => prop_all; |
25 } | 27 } |
26 | 28 |
27 sub CTOR { | 29 sub CTOR { |
28 my ($this,%args) = @_; | 30 my ($this,%args) = @_; |
29 | 31 |
30 $this->{$Name} = $args{'Name'} or die new IMPL::InvalidArgumentException('a table name is required'); | 32 $this->{$name} = $args{'name'} or die new IMPL::InvalidArgumentException('a table name is required'); |
31 $this->{$Schema} = $args{'Schema'} or die new IMPL::InvalidArgumentException('a parent schema is required'); | 33 $this->{$schema} = $args{'schema'} or die new IMPL::InvalidArgumentException('a parent schema is required'); |
34 | |
35 if ($args{columns}) { | |
36 die new IMPL::InvalidOperationException('A columns property should be a reference to an array') unless ref $args{columns} eq 'ARRAY'; | |
37 | |
38 $this->InsertColumn($_) foreach @{$args{columns}}; | |
39 } | |
40 | |
41 if ($args{constraints}) { | |
42 die new IMPL::InvalidOperationException('A constraints property should be a reference to an array') unless ref $args{constraints} eq 'ARRAY'; | |
43 | |
44 $this->AddConstraint($_) foreach @{$args{constraints}}; | |
45 } | |
32 } | 46 } |
33 | 47 |
34 sub InsertColumn { | 48 sub InsertColumn { |
35 my ($this,$column,$index) = @_; | 49 my ($this,$column,$index) = @_; |
36 | 50 |
37 $index = ($this->{$Columns} ? scalar(@{$this->{$Columns}}) : 0) if not defined $index; | 51 $index = ($this->{$columns} ? scalar(@{$this->{$columns}}) : 0) if not defined $index; |
38 | 52 |
39 die new IMPL::InvalidArgumentException("The index is out of range") if ($index < 0 || $index > ($this->{$Columns} ? scalar(@{$this->{$Columns}}) : 0)); | 53 die new IMPL::InvalidArgumentException("The index is out of range") if ($index < 0 || $index > ($this->{$columns} ? scalar(@{$this->{$columns}}) : 0)); |
40 | 54 |
41 if (UNIVERSAL::isa($column,'IMPL::SQL::Schema::Column')) { | 55 if (UNIVERSAL::isa($column,'IMPL::SQL::Schema::Column')) { |
42 | 56 |
43 } elsif (UNIVERSAL::isa($column,'HASH')) { | 57 } elsif (UNIVERSAL::isa($column,'HASH')) { |
44 $column = new IMPL::SQL::Schema::Column(%{$column}); | 58 $column = new IMPL::SQL::Schema::Column(%{$column}); |
45 } else { | 59 } else { |
46 die new IMPL::InvalidArgumentException("The invalid column parameter"); | 60 die new IMPL::InvalidArgumentException("The invalid column parameter"); |
47 } | 61 } |
48 | 62 |
49 if (exists $this->{$ColumnsByName}->{$column->Name}) { | 63 if (exists $this->{$columnsByName}->{$column->name}) { |
50 die new IMPL::InvalidOperationException("The column already exists",$column->name); | 64 die new IMPL::InvalidOperationException("The column already exists",$column->name); |
51 } else { | 65 } else { |
52 $this->{$ColumnsByName}->{$column->Name} = $column; | 66 $this->{$columnsByName}->{$column->name} = $column; |
53 splice @{$this->{$Columns}},$index,0,$column; | 67 splice @{$this->{$columns}},$index,0,$column; |
54 } | 68 } |
55 | 69 |
56 return $column; | 70 return $column; |
57 } | 71 } |
58 | 72 |
59 sub RemoveColumn { | 73 sub RemoveColumn { |
60 my ($this,$NameOrColumn,$Force) = @_; | 74 my ($this,$NameOrColumn,$Force) = @_; |
61 | 75 |
62 my $ColName; | 76 my $ColName; |
63 if (UNIVERSAL::isa($NameOrColumn,'IMPL::SQL::Schema::Column')) { | 77 if (UNIVERSAL::isa($NameOrColumn,'IMPL::SQL::Schema::Column')) { |
64 $ColName = $NameOrColumn->Name; | 78 $ColName = $NameOrColumn->name; |
65 } elsif (not ref $NameOrColumn) { | 79 } elsif (not ref $NameOrColumn) { |
66 $ColName = $NameOrColumn; | 80 $ColName = $NameOrColumn; |
67 } | 81 } |
68 | 82 |
69 if (exists $this->{$ColumnsByName}->{$ColName}) { | 83 if (exists $this->{$columnsByName}->{$ColName}) { |
70 my $index = 0; | 84 my $index = 0; |
71 foreach my $column(@{$this->{$Columns}}) { | 85 foreach my $column(@{$this->{$columns}}) { |
72 last if $column->Name eq $ColName; | 86 last if $column->name eq $ColName; |
73 $index++; | 87 $index++; |
74 } | 88 } |
75 | 89 |
76 my $column = $this->{$Columns}[$index]; | 90 my $column = $this->{$columns}[$index]; |
77 if (my @constraints = $this->GetColumnConstraints($column)){ | 91 if (my @constraints = $this->GetColumnConstraints($column)){ |
78 $Force or die new IMPL::InvalidOperationException('Can\'t remove column which is used in the constraints',@constraints); | 92 $Force or die new IMPL::InvalidOperationException('Can\'t remove column which is used in the constraints',@constraints); |
79 $this->RemoveConstraint($_) foreach @constraints; | 93 $this->RemoveConstraint($_) foreach @constraints; |
80 } | 94 } |
81 | 95 |
82 my $removed = splice @{$this->{$Columns}},$index,1; | 96 my $removed = splice @{$this->{$columns}},$index,1; |
83 delete $this->{$ColumnsByName}->{$ColName}; | 97 delete $this->{$columnsByName}->{$ColName}; |
84 return $removed; | 98 return $removed; |
85 } else { | 99 } else { |
86 die new IMPL::InvalidOperationException("The column not found",$NameOrColumn->Name); | 100 die new IMPL::InvalidOperationException("The column not found",$NameOrColumn->name); |
87 } | 101 } |
88 } | 102 } |
89 | 103 |
90 sub Column { | 104 sub Column { |
91 my ($this,$name) = @_; | 105 my ($this,$name) = @_; |
92 | 106 |
93 return $this->{$ColumnsByName}->{$name}; | 107 return $this->{$columnsByName}->{$name}; |
94 } | 108 } |
95 | 109 |
96 sub ColumnAt { | 110 sub ColumnAt { |
97 my ($this,$index) = @_; | 111 my ($this,$index) = @_; |
98 | 112 |
99 die new IMPL::InvalidArgumentException("The index is out of range") if $index < 0 || $index >= ($this->{$Columns} ? scalar(@{$this->{$Columns}}) : 0); | 113 die new IMPL::InvalidArgumentException("The index is out of range") |
100 | 114 if $index < 0 || $index >= ($this->{$columns} ? scalar(@{$this->{$columns}}) : 0); |
101 return $this->{$Columns}[$index]; | 115 |
116 return $this->{$columns}[$index]; | |
117 } | |
118 | |
119 sub ColumnsCount { | |
120 my ($this) = @_; | |
121 | |
122 return scalar(@{$this->{$columns}}); | |
102 } | 123 } |
103 | 124 |
104 sub AddConstraint { | 125 sub AddConstraint { |
105 my ($this,$Constraint) = @_; | 126 my ($this,$Constraint) = @_; |
106 | 127 |
107 die new IMPL::InvalidArgumentException('The invalid parameter') if not UNIVERSAL::isa($Constraint,'IMPL::SQL::Schema::Constraint'); | 128 if (ref $Constraint eq 'HASH') { |
108 | 129 $Constraint = new IMPL::SQL::Schema::Constraint( %$Constraint, table => $this ); |
109 $Constraint->Table == $this or die new IMPL::InvalidOperationException('The constaint must belong to the target table'); | 130 } else { |
110 | 131 die new IMPL::InvalidArgumentException('The invalid parameter') if not is($Constraint,typeof IMPL::SQL::Schema::Constraint); |
111 if (exists $this->{$Constraints}->{$Constraint->Name}) { | 132 } |
112 die new IMPL::InvalidOperationException('The table already has the specified constraint',$Constraint->Name); | 133 |
134 $Constraint->table == $this or die new IMPL::InvalidOperationException('The constaint must belong to the target table'); | |
135 | |
136 if (exists $this->{$constraints}->{$Constraint->name}) { | |
137 die new IMPL::InvalidOperationException('The table already has the specified constraint',$Constraint->name); | |
113 } else { | 138 } else { |
114 if (UNIVERSAL::isa($Constraint,'IMPL::SQL::Schema::Constraint::PrimaryKey')) { | 139 if (UNIVERSAL::isa($Constraint,'IMPL::SQL::Schema::Constraint::PrimaryKey')) { |
115 not $this->{$PrimaryKey} or die new IMPL::InvalidOperationException('The table already has a primary key'); | 140 not $this->{$primaryKey} or die new IMPL::InvalidOperationException('The table already has a primary key'); |
116 $this->{$PrimaryKey} = $Constraint; | 141 $this->{$primaryKey} = $Constraint; |
117 } | 142 } |
118 | 143 |
119 $this->{$Constraints}->{$Constraint->Name} = $Constraint; | 144 $this->{$constraints}->{$Constraint->name} = $Constraint; |
120 } | 145 } |
121 } | 146 } |
122 | 147 |
123 sub RemoveConstraint { | 148 sub RemoveConstraint { |
124 my ($this,$Constraint,$Force) = @_; | 149 my ($this,$Constraint,$Force) = @_; |
125 | 150 |
126 my $cn = UNIVERSAL::isa($Constraint,'IMPL::SQL::Schema::Constraint') ? $Constraint->Name : $Constraint; | 151 my $cn = UNIVERSAL::isa($Constraint,'IMPL::SQL::Schema::Constraint') ? $Constraint->name : $Constraint; |
127 $Constraint = $this->{$Constraints}->{$cn} or die new IMPL::InvalidOperationException('The specified constraint doesn\'t exists',$cn); | 152 $Constraint = $this->{$constraints}->{$cn} or die new IMPL::InvalidOperationException('The specified constraint doesn\'t exists',$cn); |
128 | 153 |
129 if (UNIVERSAL::isa($Constraint,'IMPL::SQL::Schema::Constraint::PrimaryKey')) { | 154 if (UNIVERSAL::isa($Constraint,'IMPL::SQL::Schema::Constraint::PrimaryKey')) { |
130 not scalar keys %{$this->{$PrimaryKey}->ConnectedFK} or die new IMPL::InvalidOperationException('Can\'t remove Primary Key unless some foreign keys referenses it'); | 155 not scalar keys %{$this->{$primaryKey}->ConnectedFK} or die new IMPL::InvalidOperationException('Can\'t remove Primary Key unless some foreign keys referenses it'); |
131 | 156 |
132 delete $this->{$PrimaryKey}; | 157 delete $this->{$primaryKey}; |
133 } | 158 } |
134 $Constraint->Dispose; | 159 $Constraint->Dispose; |
135 delete $this->{$Constraints}->{$cn}; | 160 delete $this->{$constraints}->{$cn}; |
136 return $cn; | 161 return $cn; |
162 } | |
163 | |
164 sub GetConstraint { | |
165 my ($this,$name) = @_; | |
166 | |
167 return $this->{$constraints}{$name}; | |
137 } | 168 } |
138 | 169 |
139 sub GetColumnConstraints { | 170 sub GetColumnConstraints { |
140 my ($this,@Columns) = @_; | 171 my ($this,@Columns) = @_; |
141 | 172 |
142 my @cn = map { UNIVERSAL::isa($_ ,'IMPL::SQL::Schema::Column') ? $_ ->Name : $_ } @Columns; | 173 my @cn = map { UNIVERSAL::isa($_ ,'IMPL::SQL::Schema::Column') ? $_ ->name : $_ } @Columns; |
143 exists $this->{$ColumnsByName}->{$_} or die new IMPL::InvalidOperationException('The specified column isn\'t found',$_) foreach @cn; | 174 exists $this->{$columnsByName}->{$_} or die new IMPL::InvalidOperationException('The specified column isn\'t found',$_) foreach @cn; |
144 | 175 |
145 return grep {$_->HasColumn(@cn)} values %{$this->{$Constraints}}; | 176 return grep {$_->HasColumn(@cn)} values %{$this->{$constraints}}; |
146 } | 177 } |
147 | 178 |
148 sub SetPrimaryKey { | 179 sub SetPrimaryKey { |
149 my ($this,@ColumnList) = @_; | 180 my ($this,@ColumnList) = @_; |
150 | 181 |
151 $this->AddConstraint(new IMPL::SQL::Schema::Constraint::PrimaryKey(Name => $this->{$Name}.'_PK', Table => $this,Columns => \@ColumnList)); | 182 $this->AddConstraint(new IMPL::SQL::Schema::Constraint::PrimaryKey(name => $this->{$name}.'_PK', table => $this, columns => \@ColumnList)); |
152 } | 183 } |
153 | 184 |
154 sub LinkTo { | 185 sub LinkTo { |
155 my ($this,$table,@ColumnList) = @_; | 186 my ($this,$table,@ColumnList) = @_; |
156 $table->PrimaryKey or die new IMPL::InvalidOperationException('The referenced table must have a primary key'); | 187 $table->primaryKey or die new IMPL::InvalidOperationException('The referenced table must have a primary key'); |
157 my $constraintName = $this->{$Name}.'_'.$table->Name.'_FK_'.join('_',map {ref $_ ? $_->Name : $_} @ColumnList); | 188 my $constraintName = $this->{$name}.'_'.$table->name.'_FK_'.join('_',map {ref $_ ? $_->name : $_} @ColumnList); |
158 $this->AddConstraint(new IMPL::SQL::Schema::Constraint::ForeignKey(Name => $constraintName, Table => $this,Columns => \@ColumnList, ReferencedTable => $table, ReferencedColumns => $table->PrimaryKey->Columns)); | 189 $this->AddConstraint(new IMPL::SQL::Schema::Constraint::ForeignKey(name => $constraintName, table => $this, columns => \@ColumnList, referencedTable => $table, referencedColumns => $table->primaryKey->columns)); |
159 } | 190 } |
160 | 191 |
161 sub Dispose { | 192 sub Dispose { |
162 my ($this) = @_; | 193 my ($this) = @_; |
163 | 194 |
164 $_->Dispose() foreach values %{$this->{$Constraints}}; | 195 $_->Dispose() foreach values %{$this->{$constraints}}; |
165 | 196 |
166 undef %{$this}; | 197 undef %{$this}; |
167 $this->SUPER::Dispose(); | 198 $this->SUPER::Dispose(); |
168 } | 199 } |
169 | 200 |
170 1; | 201 1; |
202 | |
203 |