Mercurial > pub > Impl

comparison Lib/IMPL/SQL/Schema/Traits.pm @ 164:eb3e9861a761

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
SQL traits in progress
author wizard
date Mon, 28 Mar 2011 01:36:24 +0400
parents 6ce1f052b90a
children 76515373dac0
comparison
equal deleted inserted replaced
163:6ce1f052b90a 164:eb3e9861a761
1 package IMPL::SQL::Traits; 1 package IMPL::SQL::Traits;
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 base qw(IMPL::Object IMPL::Object::Autofill); 6 use IMPL::base qw(IMPL::Object);
7 7
8 # this is a base class for all table traits 8 ###################################################
9
9 package IMPL::SQL::Traits::Table; 10 package IMPL::SQL::Traits::Table;
10 11 use IMPL::base qw(IMPL::Object::Fields);
11 our @ISA = qw(IMPL::SQL::Traits); 12
12 13 use fields qw(
13 use IMPL::Class::Property; 14 name
14 15 columns
15 BEGIN { 16 constraints
16 public property tableName => prop_all; 17 options
17 } 18 );
18 19
19 sub verify { 20 sub CTOR {
20 my ($this, $schema) = @_; 21 my ($this,$table,$columns,$constraints,$options) = @_;
21 } 22
22 23 $this->{name} = $table;
23 package IMPL::SQL::Traits::Table::Create; 24 $this->{columns} = $columns;
24 25 $this->{constraints} = $constraints;
25 our @ISA = qw(IMPL::SQL::Traits::Table); 26 $this->{options} = $options;
26 27 }
27 package IMPL::SQL::Traits::Table::Drop; 28
28 29 ###################################################
29 our @ISA = qw(IMPL::SQL::Traits::Table);
30
31 package IMPL::SQL::Traits::Table::AlterAttributes;
32
33 our @ISA = qw(IMPL::SQL::Traits::Table);
34
35 package IMPL::SQL::Traits::Table::AlterName;
36
37 our @ISA = qw(IMPL::SQL::Traits::Table);
38
39
40 30
41 package IMPL::SQL::Traits::Column; 31 package IMPL::SQL::Traits::Column;
42 32 use IMPL::base qw(IMPL::Object::Fields);
43 our @ISA = qw(SQL::IMPL::Traits); 33
44 34 use fields qw(
45 package IMPL::SQL::Traits::Column::Create; 35 name
46 36 type
47 our @ISA = qw(IMPL::SQL::Traits::Column); 37 isNullable
48 38 defaultValue
49 package IMPL::SQL::Traits::Column::Drop; 39 tag
50 40 );
51 our @ISA = qw(IMPL::SQL::Traits::Column); 41
52 42 sub CTOR {
53 package IMPL::SQL::Traits::Column::Alter; 43 my ($this, $name, $type, %args) = @_;
54 44
55 our @ISA = qw(IMPL::SQL::Traits::Column); 45 $this->{name} = $name or die new IMPL::InvalidArgumentException("name");
46 $this->{type} = $type or die new IMPL::InvalidArgumentException("type");
47 $this->{isNullable} = $args{isNullable} if exists $args{isNullable};
48 $this->{defaultValue} = $args{defaultValue} if exists $args{defaultValue};
49 $this->{tag} = $args{tag} if exists $args{tag};
50 }
51
52 ##################################################
53
54 package IMPL::SQL::Traits::Constraint;
55 use IMPL::base qw(IMPL::Object::Fields);
56
57 use fields qw(
58 name
59 tableName
60 columns
61 );
62
63 sub CTOR {
64 my ($this, $name, $tableName, $columns) = @_;
65
66 $this->{name} = $name;
67 $this->{tableName} = $tableName;
68 $$this->{columns} = $columns;
69 }
70
71 ##################################################
72
73 package IMPL::SQL::Traits::PrimaryKey;
74
75 use IMPL::base qw(IMPL::SQL::Traits::Constraint);
76
77 __PACKAGE__->PassThroughArgs;
78
79 ##################################################
80
81 package IMPL::SQL::Traits::Index;
82
83 use IMPL::base qw(IMPL::SQL::Traits::Constraint);
84
85 __PACKAGE__->PassThroughArgs;
86
87 ##################################################
88
89 package IMPL::SQL::Traits::Unique;
90
91 use IMPL::base qw(IMPL::SQL::Traits::Constraint);
92
93 __PACKAGE__->PassThroughArgs;
94
95 ##################################################
96
97 package IMPL::SQL::Traits::ForeignKey;
98
99 use IMPL::base qw(IMPL::SQL::Traits::Constraint);
100 use fields qw(
101 foreignTable
102 foreignColumns
103 );
104
105 our %CTOR = (
106 'IMPL::SQL::Traits::Constraint' => sub { @_[0..2] }
107 );
108
109 sub CTOR {
110 my ($this,$foreignTable,$foreignColumns) = @_[0,4,5];
111
112 $this->{foreignTable} = $foreignTable;
113 $this->{foreignColunms} = $foreignColumns;
114 }
115
116
117 ##################################################
118
119 package IMPL::SQL::Traits::CreateTable;
120
121 use IMPL::base qw(IMPL::SQL::Traits);
122 use IMPL::Class::Property;
123 use IMPL::lang;
124
125 BEGIN {
126 public property table => prop_get | owner_set;
127 }
128
129 sub CTOR {
130 my ($this,$table) = @_;
131
132 die new IMPL::InvalidArgumentException("table", "An object of IMPL::SQL::Traits::Table type is required")
133 unless is $table, typeof IMPL::SQL::Traits::Table;
134
135 $this->table($table);
136 }
137
138 sub apply {
139 my ($this,$schema) = @_;
140
141 return 0 if ( $schema->GetTable( $this->table->{name} ) );
142
143 $schema->AddTable($this->table);
144 return 1;
145 }
146
147 ##################################################
148
149 package IMPL::SQL::Traits::DropTable;
150 use IMPL::base qw(IMPL::SQL::Traits);
151 use IMPL::Class::Property;
152
153 BEGIN {
154 public property tableName => prop_get | owner_set;
155 }
156
157 sub CTOR {
158 my ($this,$tableName) = @_;
159
160 $this->tableName($tableName) or die new IMPL::InvalidArgumentException("tableName is required");
161 }
162
163 sub apply {
164 my ($this,$schema) = @_;
165
166 return 0 if $schema->GetTable( $this->tableName );
167
168 $schema->RemoveTable($this->tableName);
169
170 return 1;
171 }
172
173 ##################################################
174
175 package IMPL::SQL::Traits::RenameTable;
176 use IMPL::base qw(IMPL::SQL::Traits);
177 use IMPL::Class::Property;
178
179 BEGIN {
180 public property tableName => prop_get | owner_set;
181 public property tableNewName => prop_get | owner_set;
182 }
183
184 sub CTOR {
185 my ($this, $oldName, $newName) = @_;
186
187 $this->tableName($oldName) or die new IMPL::InvalidArgumentException("A table name is required");
188 $this->tableNewName($newName) or die new IMPL::InvalidArgumentException("A new table name is required");
189 }
190
191 sub apply {
192 my ($this,$schema) = @_;
193
194 return 0 if not $schema->GetTable($this->tableName) or $schema->GetTable($this->tableNewName);
195
196 $this->RenameTable($this->tableName, $this->tableNewName);
197
198 return 1;
199 }
200
201 #################################################
202
203 package IMPL::SQL::Traits::AlterTableAddColumn;
204 use IMPL::base qw(IMPL::SQL::Traits);
205 use IMPL::Class::Property;
206 use IMPL::lang;
207
208 BEGIN {
209 public property tableName => prop_get | owner_set;
210 public property column => prop_get | owner_set;
211 }
212
213 sub CTOR {
214 my ($this,$tableName,$column) = @_;
215
216 $this->tableName($tableName) or die new IMPL::InvalidArgumentException("A table name is required");
217
218 die new IMPL::InvalidArgumentException("A column should be a IMPL::SQL::Traits::Column object")
219 unless is $column, typeof IMPL::SQL::Traits::Column;
220
221 $this->column($column);
222 }
223
224 sub apply {
225 my ($this,$schema) = @_;
226
227 my $table = $schema->GetTable($this->tableName) or return 0;
228
229 return 0 if $table->GetColumn( $this->column->{name} );
230
231 $table->AddColumn($this->column);
232
233 return 1;
234 }
235
236 #################################################
237
238 package IMPL::SQL::Traits::AlterTableDropColumn;
239 use IMPL::base qw(IMPL::SQL::Traits);
240 use IMPL::Class::Property;
241
242 BEGIN {
243 public property tableName => prop_get | owner_set;
244 public property columnName => prop_get | owner_set;
245 }
246
247 sub CTOR {
248 my ($this,$table,$column) = @_;
249
250 $this->tableName($table) or die new IMPL::InvalidArgumentException(tableName => "A table name should be specified");
251 $this->columnName($column) or die new IMPL::InvalidArgumentException(columnName => "A column name should be specified");
252 }
253
254 sub apply {
255 my ($this,$schema) = @_;
256
257 local $@;
258
259 return eval {
260 $schema->GetTable($this->tableName)->RemoveColumn($this->columnName);
261 return 1;
262 } || 0;
263 }
264
265 #################################################
266
267 package IMPL::SQL::Traits::AlterTableChangeColumn;
268 use IMPL::base qw(IMPL::SQL::Traits);
269 use IMPL::Class::Property;
270
271 BEGIN {
272 public property tableName => prop_get | owner_set;
273 public property columnName => prop_get | owner_set;
274 public property columnType => prop_get | owner_set;
275 public property defaultValue => prop_get | owner_set;
276 public property isNullable => prop_get | owner_set;
277 public property options => prop_get | owner_set;
278 }
279
280 sub CTOR {
281 my ($this, $table,$column,%args) = @_;
282
283 $this->tableName($table) or die new IMPL::InvalidArgumentException(tableName => "A table name is required");
284 $this->columnName($column) or die new IMPL::InvalidArgumentException(columnName => "A column name is required");
285
286 $this->$_($args{$_})
287 for (grep exists $args{$_}, qw(columnType defaultValue isNullable options));
288 }
289
290 sub apply {
291 my ($this,$schema) = @_;
292
293 local $@;
294
295 return eval {
296 my $column = $schema->GetTable($this->tableName)->GetColumn($this->columnName);
297 $column->SetType($this->columnType) if $this->columnType;
298 $column->SetNullable($this->isNullable) if $this->isNullable;
299 $column->SetDefaultValue($this->defaultValue) if $this->defaultValue;
300 $column->SetOptions($this->options) if $this->options;
301
302 return 1;
303 } || 0;
304 }
305
306 #################################################
307
308 package IMPL::SQL::Traits::AlterTableAddConstraint;
309 use IMPL::base qw(IMPL::SQL::Traits);
310 use IMPL::Class::Property;
311 use IMPL::lang;
312
313 BEGIN {
314 public property tableName => prop_get | owner_set;
315 public property constraint => prop_get | owner_set;
316 }
317
318 sub CTOR {
319 my ($this,$table,$constraint) = @_;
320
321 $this->tableName($table) or die new IMPL::InvalidArgumentException( tableName => "A table name is required");
322
323 die new IMPL::InvalidArgumentException(constaraint => "A valid IMPL::SQL::Traits::Constarint is required")
324 unless is $constraint, typeof IMPL::SQL::Traits::Constraint;
325
326 $this->constraint($constraint);
327 }
328
329 sub apply {
330 my ($this,$schema) = @_;
331
332 local $@;
333
334 return eval {
335 $schema->GetTable($this->tableName)->AddConstraint($this->constraint);
336 return 1;
337 } || 0;
338
339 }
340
341 #################################################
342
343 package IMPL::SQL::Traits::AlterTableDropConstraint;
344 use IMPL::base qw(IMPL::SQL::Traits);
345 use IMPL::Class::Property;
346
347 BEGIN {
348 public property tableName => prop_get | owner_set;
349 public property constraintName => prop_get | owner_set;
350 }
351
352 sub CTOR {
353 my ($this,$table,$constraint) = @_;
354
355 die new IMPL::InvalidArgumentException( tableName => "A table name is required" ) unless $table;
356 die new IMPL::InvalidArgumentException( constraintName => "A constraint name is required" ) unless $constraint;
357 }
358
359 sub apply {
360 my ($this,$schema) = @_;
361
362 my $table = $schema->GetTable($this->tableName) or return 0;
363
364 return 0 unless $table->GetConstraint($this->constraintName);
365
366 $table->RemoveConstraint($this->constraintName);
367 return 1;
368 }
56 369
57 370
58 1; 371 1;
59 372
60 __END__ 373 __END__
66 C<IMPL::SQL::Traits> - Операции над объектками SQL схемы. 379 C<IMPL::SQL::Traits> - Операции над объектками SQL схемы.
67 380
68 =head1 DESCRIPTION 381 =head1 DESCRIPTION
69 382
70 Изменения схемы могу быть представлены в виде последовательности примитивных операций. 383 Изменения схемы могу быть представлены в виде последовательности примитивных операций.
71 384 Правила выполнения последовательности примитывных действий могут варьироваться
385 в зависимости от процессора, который их выполняет. Например C<IMPL::SQL::Traits::Processor>.
386
387 Данные, которые содержаться в примитивных операциях не могут существовать независимо от схемы.
388
389 =head1 OPEARATIONS
390
391 =head2 General
392
393 Методы обще для всех примитивных операций.
394
395 =over
396
397 =item C<apply($schema)>
398
399 Пытается приминить операцию к указанной схеме.
400
401 Возвращаемое значение:
402
403 =over
404
405 =item C<true>
406
407 Операция успешно применена к схеме.
408
409 =item C<false>
410
411 Операция не может быть применена к схеме.
412
413 =back
414
415 =back
416
417 =head2 Primitive operations
418
419 =over
420
421 =item C<IMPL::SQL::Traits::CreateTable>
422
423 Создает таблицу
424
425 =over
426
427 =item C<CTOR($table)>
428
429 =item C<[get]table>
430
431 C<IMPL::SQL::Traits::Table> - описание создаваемой таблицы
432
433 =back
434
435 =item C<IMPL::SQL::Traits::DropTable>
436
437 Удалает таблицу по имени
438
439 =over
440
441 =item C<CTOR($tableName)>
442
443 =item C<[get]tableName>
444
445 Имя удаляемой таблицы
446
447 =back
448
449 =item C<IMPL::SQL::Traits::RenameTable>
450
451 =over
452
453 =item C<CTOR($tableName,$tableNewName)>
454
455 =item C<[get]tableName>
456
457 Имя таблицы, которую требуется переименовать
458
459 =item C<[get]tableNewName>
460
461 Новое имя таблицы
462
463 =back
464
465 =item C<IMPL::SQL::Traits::AlterTableAddColumn>
466
467 Добавляет столбец в таблицу
468
469 =over
470
471 =item C<CTOR($tableName,$column)>
472
473 =item C<[get]tableName>
474
475 Имя таблицы в которую нужно добавить столбец
476
477 =item C<[get]column>
478
479 C<IMPL::SQL::Traits::Column> - описание столбца который нужно добавить
480
481 =back
482
483 =item C<IMPL::SQL::Traits::AlterTableDropColumn>
484
485 Удаляет столбец из таблицы
486
487 =over
488
489 =item C<CTOR($tableName,$columnName)>
490
491 =item C<[get]tableName>
492
493 Имя таблицы в которой нужно удалить столбец
494
495 =item C<[get]columnName>
496
497 Имя столбца для удаления
498
499 =back
500
501 =item C<IMPL::SQL::Traits::AlterTableChangeColumn>
502
503 Меняет описание столбца
504
505 =over
506
507 =item C<CTOR($tableName,$columnName,%args)>
508
509 C<%args> - хеш, ключами которого являются оставшиеся свойства создаваемого объекта.
510
511 =item C<[get]tableName>
512
513 Имя таблицы в которой находится столбец.
514
515 =item C<[get]columnName>
516
517 Имя столбца для изменения
518
519 =item C<[get]columnType>
520
521 Новый тип столбца. Не задан, если тип не меняется
522
523 =item C<[get]defaultValue>
524
525 Значение по умолчанию. Не задано, если не меняется
526
527 =item C<[get]isNullable>
528
529 Может ли столбец содержать C<NULL>. Не задано, если не меняется.
530
531 =item C<[get]options>
532
533 Хеш опций, не задан, если опции не меняются
534
535 =back
536
537 =item C<IMPL::SQL::Traits::AlterTableAddConstraint>
538
539 Базовый класс для операций по добавлению ограничений
540
541 =over
542
543 =item C<CTOR($tableName,$constraint)>
544
545 =item C<[get]tableName>
546
547 Имя таблицы в которую добавляется ограничение.
548
549 =item C<[get]constraint>
550
551 C<IMPL::SQL::Traits::Constraint> - описние ограничения, которое нужно добавить.
552
553 =back
554
555 =item C<IMPL::SQL::Traits::AlterTableDropConstraint>
556
557 Удаляет ограничение на таблицу
558
559 =over
560
561 =item C<CTOR($tableName,$constraintName)>
562
563 =item C<[get]tableName>
564
565 Имя таблицы в которой требуется удалить ограничение.
566
567 =item C<[get]constraintName>
568
569 Имя ограничения для удаления.
570
571 =back
572
573 =back
72 574
73 =cut 575 =cut