Mercurial > pub > Impl

comparison Lib/IMPL/SQL/Schema/Traits.pm @ 194:4d0e1962161c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Replaced tabs with spaces IMPL::Web::View - fixed document model, new features (control classes, document constructor parameters)
author cin
date Tue, 10 Apr 2012 20:08:29 +0400
parents d1676be8afcc
children dacfe7c0311a
comparison
equal deleted inserted replaced
193:8e8401c0aea4 194:4d0e1962161c
2 use strict; 2 use strict;
3 use IMPL::_core::version; 3 use IMPL::_core::version;
4 use IMPL::Exception(); 4 use IMPL::Exception();
5 5
6 use parent qw(IMPL::Object); 6 use parent qw(IMPL::Object);
7 use IMPL::Code::Loader();
8 7
9 # required for use with typeof operator 8 # required for use with typeof operator
10 use IMPL::SQL::Schema::Constraint::PrimaryKey(); 9 use IMPL::SQL::Schema::Constraint::PrimaryKey();
11 use IMPL::SQL::Schema::Constraint::Index(); 10 use IMPL::SQL::Schema::Constraint::Index();
12 use IMPL::SQL::Schema::Constraint::Unique(); 11 use IMPL::SQL::Schema::Constraint::Unique();
16 15
17 package IMPL::SQL::Schema::Traits::Table; 16 package IMPL::SQL::Schema::Traits::Table;
18 use base qw(IMPL::Object::Fields); 17 use base qw(IMPL::Object::Fields);
19 18
20 use fields qw( 19 use fields qw(
21 name 20 name
22 columns 21 columns
23 constraints 22 constraints
24 options 23 options
25 ); 24 );
26 25
27 sub CTOR { 26 sub CTOR {
28 my ($this,$table,$columns,$constraints,$options) = @_; 27 my ($this,$table,$columns,$constraints,$options) = @_;
29 28
30 $this->{name} = $table or die new IMPL::InvalidArgumentException(table => "A table name is required"); 29 $this->{name} = $table or die new IMPL::InvalidArgumentException(table => "A table name is required");
31 $this->{columns} = $columns if defined $columns; 30 $this->{columns} = $columns if defined $columns;
32 $this->{constraints} = $constraints if defined $constraints; 31 $this->{constraints} = $constraints if defined $constraints;
33 $this->{options} = $options if defined $options; 32 $this->{options} = $options if defined $options;
34 } 33 }
35 34
36 ################################################### 35 ###################################################
37 36
38 package IMPL::SQL::Schema::Traits::Column; 37 package IMPL::SQL::Schema::Traits::Column;
39 use base qw(IMPL::Object::Fields); 38 use base qw(IMPL::Object::Fields);
40 39
41 use fields qw( 40 use fields qw(
42 name 41 name
43 type 42 type
44 isNullable 43 isNullable
45 defaultValue 44 defaultValue
46 tag 45 tag
47 ); 46 );
48 47
49 sub CTOR { 48 sub CTOR {
50 my ($this, $name, $type, %args) = @_; 49 my ($this, $name, $type, %args) = @_;
51 50
52 $this->{name} = $name or die new IMPL::InvalidArgumentException("name"); 51 $this->{name} = $name or die new IMPL::InvalidArgumentException("name");
53 $this->{type} = $type or die new IMPL::InvalidArgumentException("type"); 52 $this->{type} = $type or die new IMPL::InvalidArgumentException("type");
54 $this->{isNullable} = $args{isNullable} if exists $args{isNullable}; 53 $this->{isNullable} = $args{isNullable} if exists $args{isNullable};
55 $this->{defaultValue} = $args{defaultValue} if exists $args{defaultValue}; 54 $this->{defaultValue} = $args{defaultValue} if exists $args{defaultValue};
56 $this->{tag} = $args{tag} if exists $args{tag}; 55 $this->{tag} = $args{tag} if exists $args{tag};
57 } 56 }
58 57
59 ################################################## 58 ##################################################
60 59
61 package IMPL::SQL::Schema::Traits::Constraint; 60 package IMPL::SQL::Schema::Traits::Constraint;
62 use base qw(IMPL::Object::Fields); 61 use base qw(IMPL::Object::Fields);
63 62
64 use fields qw( 63 use fields qw(
65 name 64 name
66 columns 65 columns
67 ); 66 );
68 67
69 sub CTOR { 68 sub CTOR {
70 my ($this, $name, $columns) = @_; 69 my ($this, $name, $columns) = @_;
71 70
72 $this->{name} = $name; 71 $this->{name} = $name;
73 $this->{columns} = $columns; # list of columnNames 72 $this->{columns} = $columns; # list of columnNames
74 } 73 }
75 74
76 sub constraintClass { 75 sub constraintClass {
77 die new IMPL::NotImplementedException(); 76 die new IMPL::NotImplementedException();
78 } 77 }
79 78
80 ################################################## 79 ##################################################
81 80
82 package IMPL::SQL::Schema::Traits::PrimaryKey; 81 package IMPL::SQL::Schema::Traits::PrimaryKey;
111 110
112 package IMPL::SQL::Schema::Traits::ForeignKey; 111 package IMPL::SQL::Schema::Traits::ForeignKey;
113 112
114 use base qw(IMPL::SQL::Schema::Traits::Constraint); 113 use base qw(IMPL::SQL::Schema::Traits::Constraint);
115 use fields qw( 114 use fields qw(
116 foreignTable 115 foreignTable
117 foreignColumns 116 foreignColumns
118 ); 117 );
119 118
120 use constant { constraintClass => typeof IMPL::SQL::Schema::Constraint::ForeignKey }; 119 use constant { constraintClass => typeof IMPL::SQL::Schema::Constraint::ForeignKey };
121 120
122 our %CTOR = ( 121 our %CTOR = (
123 'IMPL::SQL::Schema::Traits::Constraint' => sub { @_[0..1] } 122 'IMPL::SQL::Schema::Traits::Constraint' => sub { @_[0..1] }
124 ); 123 );
125 124
126 sub CTOR { 125 sub CTOR {
127 my ($this,$foreignTable,$foreignColumns) = @_[0,3,4]; 126 my ($this,$foreignTable,$foreignColumns) = @_[0,3,4];
128 127
129 $this->{foreignTable} = $foreignTable; 128 $this->{foreignTable} = $foreignTable;
130 $this->{foreignColunms} = $foreignColumns; 129 $this->{foreignColunms} = $foreignColumns;
131 } 130 }
132 131
133 132
134 ################################################## 133 ##################################################
135 134
138 use parent qw(-norequire IMPL::SQL::Schema::Traits); 137 use parent qw(-norequire IMPL::SQL::Schema::Traits);
139 use IMPL::Class::Property; 138 use IMPL::Class::Property;
140 use IMPL::lang; 139 use IMPL::lang;
141 140
142 BEGIN { 141 BEGIN {
143 public property table => prop_get | owner_set; 142 public property table => prop_get | owner_set;
144 } 143 }
145 144
146 sub CTOR { 145 sub CTOR {
147 my ($this,$table) = @_; 146 my ($this,$table) = @_;
148 147
149 die new IMPL::InvalidArgumentException("table", "An object of IMPL::SQL::Schema::Traits::Table type is required") 148 die new IMPL::InvalidArgumentException("table", "An object of IMPL::SQL::Schema::Traits::Table type is required")
150 unless is $table, typeof IMPL::SQL::Schema::Traits::Table; 149 unless is $table, typeof IMPL::SQL::Schema::Traits::Table;
151 150
152 $this->table($table); 151 $this->table($table);
153 } 152 }
154 153
155 sub apply { 154 sub apply {
156 my ($this,$schema) = @_; 155 my ($this,$schema) = @_;
157 156
158 return 0 if ( $schema->GetTable( $this->table->{name} ) ); 157 return 0 if ( $schema->GetTable( $this->table->{name} ) );
159 158
160 $schema->AddTable($this->table); 159 $schema->AddTable($this->table);
161 return 1; 160 return 1;
162 } 161 }
163 162
164 ################################################## 163 ##################################################
165 164
166 package IMPL::SQL::Schema::Traits::DropTable; 165 package IMPL::SQL::Schema::Traits::DropTable;
167 use parent qw(-norequire IMPL::SQL::Schema::Traits); 166 use parent qw(-norequire IMPL::SQL::Schema::Traits);
168 use IMPL::Class::Property; 167 use IMPL::Class::Property;
169 168
170 BEGIN { 169 BEGIN {
171 public property tableName => prop_get | owner_set; 170 public property tableName => prop_get | owner_set;
172 } 171 }
173 172
174 sub CTOR { 173 sub CTOR {
175 my ($this,$tableName) = @_; 174 my ($this,$tableName) = @_;
176 175
177 $this->tableName($tableName) or die new IMPL::InvalidArgumentException("tableName is required"); 176 $this->tableName($tableName) or die new IMPL::InvalidArgumentException("tableName is required");
178 } 177 }
179 178
180 sub apply { 179 sub apply {
181 my ($this,$schema) = @_; 180 my ($this,$schema) = @_;
182 181
183 return 0 if $schema->GetTable( $this->tableName ); 182 return 0 if $schema->GetTable( $this->tableName );
184 183
185 $schema->RemoveTable($this->tableName); 184 $schema->RemoveTable($this->tableName);
186 185
187 return 1; 186 return 1;
188 } 187 }
189 188
190 ################################################## 189 ##################################################
191 190
192 package IMPL::SQL::Schema::Traits::RenameTable; 191 package IMPL::SQL::Schema::Traits::RenameTable;
193 use parent qw(-norequire IMPL::SQL::Schema::Traits); 192 use parent qw(-norequire IMPL::SQL::Schema::Traits);
194 use IMPL::Class::Property; 193 use IMPL::Class::Property;
195 194
196 BEGIN { 195 BEGIN {
197 public property tableName => prop_get | owner_set; 196 public property tableName => prop_get | owner_set;
198 public property tableNewName => prop_get | owner_set; 197 public property tableNewName => prop_get | owner_set;
199 } 198 }
200 199
201 sub CTOR { 200 sub CTOR {
202 my ($this, $oldName, $newName) = @_; 201 my ($this, $oldName, $newName) = @_;
203 202
204 $this->tableName($oldName) or die new IMPL::InvalidArgumentException("A table name is required"); 203 $this->tableName($oldName) or die new IMPL::InvalidArgumentException("A table name is required");
205 $this->tableNewName($newName) or die new IMPL::InvalidArgumentException("A new table name is required"); 204 $this->tableNewName($newName) or die new IMPL::InvalidArgumentException("A new table name is required");
206 } 205 }
207 206
208 sub apply { 207 sub apply {
209 my ($this,$schema) = @_; 208 my ($this,$schema) = @_;
210 209
211 return 0 if not $schema->GetTable($this->tableName) or $schema->GetTable($this->tableNewName); 210 return 0 if not $schema->GetTable($this->tableName) or $schema->GetTable($this->tableNewName);
212 211
213 $this->RenameTable($this->tableName, $this->tableNewName); 212 $this->RenameTable($this->tableName, $this->tableNewName);
214 213
215 return 1; 214 return 1;
216 } 215 }
217 216
218 ################################################# 217 #################################################
219 218
220 package IMPL::SQL::Schema::Traits::AlterTableAddColumn; 219 package IMPL::SQL::Schema::Traits::AlterTableAddColumn;
221 use parent qw(-norequire IMPL::SQL::Schema::Traits); 220 use parent qw(-norequire IMPL::SQL::Schema::Traits);
222 use IMPL::Class::Property; 221 use IMPL::Class::Property;
223 use IMPL::lang; 222 use IMPL::lang;
224 223
225 BEGIN { 224 BEGIN {
226 public property tableName => prop_get | owner_set; 225 public property tableName => prop_get | owner_set;
227 public property column => prop_get | owner_set; 226 public property column => prop_get | owner_set;
228 } 227 }
229 228
230 sub CTOR { 229 sub CTOR {
231 my ($this,$tableName,$column) = @_; 230 my ($this,$tableName,$column) = @_;
232 231
233 $this->tableName($tableName) or die new IMPL::InvalidArgumentException("A table name is required"); 232 $this->tableName($tableName) or die new IMPL::InvalidArgumentException("A table name is required");
234 233
235 die new IMPL::InvalidArgumentException("A column should be a IMPL::SQL::Schema::Traits::Column object") 234 die new IMPL::InvalidArgumentException("A column should be a IMPL::SQL::Schema::Traits::Column object")
236 unless is $column, typeof IMPL::SQL::Schema::Traits::Column; 235 unless is $column, typeof IMPL::SQL::Schema::Traits::Column;
237 236
238 $this->column($column); 237 $this->column($column);
239 } 238 }
240 239
241 sub apply { 240 sub apply {
242 my ($this,$schema) = @_; 241 my ($this,$schema) = @_;
243 242
244 my $table = $schema->GetTable($this->tableName) or return 0; 243 my $table = $schema->GetTable($this->tableName) or return 0;
245 244
246 return 0 if $table->GetColumn( $this->column->{name} ); 245 return 0 if $table->GetColumn( $this->column->{name} );
247 246
248 $table->AddColumn($this->column); 247 $table->AddColumn($this->column);
249 248
250 return 1; 249 return 1;
251 } 250 }
252 251
253 ################################################# 252 #################################################
254 253
255 package IMPL::SQL::Schema::Traits::AlterTableDropColumn; 254 package IMPL::SQL::Schema::Traits::AlterTableDropColumn;
256 use parent qw(-norequire IMPL::SQL::Schema::Traits); 255 use parent qw(-norequire IMPL::SQL::Schema::Traits);
257 use IMPL::Class::Property; 256 use IMPL::Class::Property;
258 257
259 BEGIN { 258 BEGIN {
260 public property tableName => prop_get | owner_set; 259 public property tableName => prop_get | owner_set;
261 public property columnName => prop_get | owner_set; 260 public property columnName => prop_get | owner_set;
262 } 261 }
263 262
264 sub CTOR { 263 sub CTOR {
265 my ($this,$table,$column) = @_; 264 my ($this,$table,$column) = @_;
266 265
267 $this->tableName($table) or die new IMPL::InvalidArgumentException(tableName => "A table name should be specified"); 266 $this->tableName($table) or die new IMPL::InvalidArgumentException(tableName => "A table name should be specified");
268 $this->columnName($column) or die new IMPL::InvalidArgumentException(columnName => "A column name should be specified"); 267 $this->columnName($column) or die new IMPL::InvalidArgumentException(columnName => "A column name should be specified");
269 } 268 }
270 269
271 sub apply { 270 sub apply {
272 my ($this,$schema) = @_; 271 my ($this,$schema) = @_;
273 272
274 local $@; 273 local $@;
275 274
276 return eval { 275 return eval {
277 $schema->GetTable($this->tableName)->RemoveColumn($this->columnName); 276 $schema->GetTable($this->tableName)->RemoveColumn($this->columnName);
278 return 1; 277 return 1;
279 } || 0; 278 } || 0;
280 } 279 }
281 280
282 ################################################# 281 #################################################
283 282
284 package IMPL::SQL::Schema::Traits::AlterTableChangeColumn; 283 package IMPL::SQL::Schema::Traits::AlterTableChangeColumn;
285 use parent qw(-norequire IMPL::SQL::Schema::Traits); 284 use parent qw(-norequire IMPL::SQL::Schema::Traits);
286 use IMPL::Class::Property; 285 use IMPL::Class::Property;
287 286
288 BEGIN { 287 BEGIN {
289 public property tableName => prop_get | owner_set; 288 public property tableName => prop_get | owner_set;
290 public property columnName => prop_get | owner_set; 289 public property columnName => prop_get | owner_set;
291 public property columnType => prop_all; 290 public property columnType => prop_all;
292 public property defaultValue => prop_all; 291 public property defaultValue => prop_all;
293 public property isNullable => prop_all; 292 public property isNullable => prop_all;
294 public property options => prop_all; # hash diff format, (keys have a prefix '+' - add or update value, '-' remove value) 293 public property options => prop_all; # hash diff format, (keys have a prefix '+' - add or update value, '-' remove value)
295 } 294 }
296 295
297 sub CTOR { 296 sub CTOR {
298 my ($this, $table,$column,%args) = @_; 297 my ($this, $table,$column,%args) = @_;
299 298
300 $this->tableName($table) or die new IMPL::InvalidArgumentException(tableName => "A table name is required"); 299 $this->tableName($table) or die new IMPL::InvalidArgumentException(tableName => "A table name is required");
301 $this->columnName($column) or die new IMPL::InvalidArgumentException(columnName => "A column name is required"); 300 $this->columnName($column) or die new IMPL::InvalidArgumentException(columnName => "A column name is required");
302 301
303 $this->$_($args{$_}) 302 $this->$_($args{$_})
304 for (grep exists $args{$_}, qw(columnType defaultValue isNullable options)); 303 for (grep exists $args{$_}, qw(columnType defaultValue isNullable options));
305 } 304 }
306 305
307 sub apply { 306 sub apply {
308 my ($this,$schema) = @_; 307 my ($this,$schema) = @_;
309 308
310 local $@; 309 local $@;
311 310
312 return eval { 311 return eval {
313 my $column = $schema->GetTable($this->tableName)->GetColumn($this->columnName); 312 my $column = $schema->GetTable($this->tableName)->GetColumn($this->columnName);
314 $column->SetType($this->columnType) if defined $this->columnType; 313 $column->SetType($this->columnType) if defined $this->columnType;
315 $column->SetNullable($this->isNullable) if defined $this->isNullable; 314 $column->SetNullable($this->isNullable) if defined $this->isNullable;
316 $column->SetDefaultValue($this->defaultValue) if defined $this->defaultValue; 315 $column->SetDefaultValue($this->defaultValue) if defined $this->defaultValue;
317 $column->SetOptions($this->options) if defined $this->options; 316 $column->SetOptions($this->options) if defined $this->options;
318 317
319 return 1; 318 return 1;
320 } || 0; 319 } || 0;
321 } 320 }
322 321
323 ################################################# 322 #################################################
324 323
325 package IMPL::SQL::Schema::Traits::AlterTableAddConstraint; 324 package IMPL::SQL::Schema::Traits::AlterTableAddConstraint;
326 use parent qw(-norequire IMPL::SQL::Schema::Traits); 325 use parent qw(-norequire IMPL::SQL::Schema::Traits);
327 use IMPL::Class::Property; 326 use IMPL::Class::Property;
328 use IMPL::lang; 327 use IMPL::lang;
329 328
330 BEGIN { 329 BEGIN {
331 public property tableName => prop_get | owner_set; 330 public property tableName => prop_get | owner_set;
332 public property constraint => prop_get | owner_set; 331 public property constraint => prop_get | owner_set;
333 } 332 }
334 333
335 sub CTOR { 334 sub CTOR {
336 my ($this,$table,$constraint) = @_; 335 my ($this,$table,$constraint) = @_;
337 336
338 $this->tableName($table) or die new IMPL::InvalidArgumentException( tableName => "A table name is required"); 337 $this->tableName($table) or die new IMPL::InvalidArgumentException( tableName => "A table name is required");
339 338
340 die new IMPL::InvalidArgumentException(constaraint => "A valid IMPL::SQL::Schema::Traits::Constarint is required") 339 die new IMPL::InvalidArgumentException(constaraint => "A valid IMPL::SQL::Schema::Traits::Constarint is required")
341 unless is $constraint, typeof IMPL::SQL::Schema::Traits::Constraint; 340 unless is $constraint, typeof IMPL::SQL::Schema::Traits::Constraint;
342 341
343 $this->constraint($constraint); 342 $this->constraint($constraint);
344 } 343 }
345 344
346 sub apply { 345 sub apply {
347 my ($this,$schema) = @_; 346 my ($this,$schema) = @_;
348 347
349 local $@; 348 local $@;
350 349
351 return eval { 350 return eval {
352 $schema->GetTable($this->tableName)->AddConstraint($this->constraint->constraintClass, $this->constraint); 351 $schema->GetTable($this->tableName)->AddConstraint($this->constraint->constraintClass, $this->constraint);
353 return 1; 352 return 1;
354 } || 0; 353 } || 0;
355 354
356 } 355 }
357 356
358 ################################################# 357 #################################################
359 358
360 package IMPL::SQL::Schema::Traits::AlterTableDropConstraint; 359 package IMPL::SQL::Schema::Traits::AlterTableDropConstraint;
361 use parent qw(-norequire IMPL::SQL::Schema::Traits); 360 use parent qw(-norequire IMPL::SQL::Schema::Traits);
362 use IMPL::Class::Property; 361 use IMPL::Class::Property;
363 362
364 BEGIN { 363 BEGIN {
365 public property tableName => prop_get | owner_set; 364 public property tableName => prop_get | owner_set;
366 public property constraintName => prop_get | owner_set; 365 public property constraintName => prop_get | owner_set;
367 } 366 }
368 367
369 sub CTOR { 368 sub CTOR {
370 my ($this,$table,$constraint) = @_; 369 my ($this,$table,$constraint) = @_;
371 370
372 die new IMPL::InvalidArgumentException( tableName => "A table name is required" ) unless $table; 371 die new IMPL::InvalidArgumentException( tableName => "A table name is required" ) unless $table;
373 die new IMPL::InvalidArgumentException( constraintName => "A constraint name is required" ) unless $constraint; 372 die new IMPL::InvalidArgumentException( constraintName => "A constraint name is required" ) unless $constraint;
374 373
375 $this->tableName($table); 374 $this->tableName($table);
376 $this->constraintName($constraint); 375 $this->constraintName($constraint);
377 } 376 }
378 377
379 sub apply { 378 sub apply {
380 my ($this,$schema) = @_; 379 my ($this,$schema) = @_;
381 380
382 my $table = $schema->GetTable($this->tableName) or return 0; 381 my $table = $schema->GetTable($this->tableName) or return 0;
383 382
384 return 0 unless $table->GetConstraint($this->constraintName); 383 return 0 unless $table->GetConstraint($this->constraintName);
385 384
386 $table->RemoveConstraint($this->constraintName); 385 $table->RemoveConstraint($this->constraintName);
387 return 1; 386 return 1;
388 } 387 }
389 388
390 389
391 1; 390 1;
392 391