Mercurial > pub > Impl

comparison lib/IMPL/SQL/Schema/Traits.pm @ 407:c6e90e02dd17 ref20150831

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
renamed Lib->lib
author cin
date Fri, 04 Sep 2015 19:40:23 +0300
parents
children
comparison
equal deleted inserted replaced
406:f23fcb19d3c1 407:c6e90e02dd17
1 package IMPL::SQL::Schema::Traits;
2 use strict;
3 use IMPL::_core::version;
4 use IMPL::Exception();
5
6 use parent qw(IMPL::Object);
7
8 # required for use with typeof operator
9 use IMPL::SQL::Schema::Constraint::PrimaryKey();
10 use IMPL::SQL::Schema::Constraint::Index();
11 use IMPL::SQL::Schema::Constraint::Unique();
12 use IMPL::SQL::Schema::Constraint::ForeignKey();
13
14 ###################################################
15
16 package IMPL::SQL::Schema::Traits::Table;
17 use base qw(IMPL::Object::Fields);
18
19 use fields qw(
20 name
21 columns
22 constraints
23 options
24 );
25
26 sub CTOR {
27 my ($this,$table,$columns,$constraints,$options) = @_;
28
29 $this->{name} = $table or die new IMPL::InvalidArgumentException(table => "A table name is required");
30 $this->{columns} = $columns if defined $columns;
31 $this->{constraints} = $constraints if defined $constraints;
32 $this->{options} = $options if defined $options;
33 }
34
35 ###################################################
36
37 package IMPL::SQL::Schema::Traits::Column;
38 use base qw(IMPL::Object::Fields);
39
40 use fields qw(
41 name
42 type
43 isNullable
44 defaultValue
45 tag
46 );
47
48 sub CTOR {
49 my ($this, $name, $type, %args) = @_;
50
51 $this->{name} = $name or die new IMPL::InvalidArgumentException("name");
52 $this->{type} = $type or die new IMPL::InvalidArgumentException("type");
53 $this->{isNullable} = $args{isNullable} if exists $args{isNullable};
54 $this->{defaultValue} = $args{defaultValue} if exists $args{defaultValue};
55 $this->{tag} = $args{tag} if exists $args{tag};
56 }
57
58 ##################################################
59
60 package IMPL::SQL::Schema::Traits::Constraint;
61 use base qw(IMPL::Object::Fields);
62
63 use fields qw(
64 name
65 columns
66 );
67
68 sub CTOR {
69 my ($this, $name, $columns) = @_;
70
71 $this->{name} = $name;
72 $this->{columns} = $columns; # list of columnNames
73 }
74
75 sub constraintClass {
76 die new IMPL::NotImplementedException();
77 }
78
79 ##################################################
80
81 package IMPL::SQL::Schema::Traits::PrimaryKey;
82
83 use base qw(IMPL::SQL::Schema::Traits::Constraint);
84
85 __PACKAGE__->PassThroughArgs;
86
87 use constant { constraintClass => typeof IMPL::SQL::Schema::Constraint::PrimaryKey };
88
89 ##################################################
90
91 package IMPL::SQL::Schema::Traits::Index;
92
93 use base qw(IMPL::SQL::Schema::Traits::Constraint);
94
95 __PACKAGE__->PassThroughArgs;
96
97 use constant { constraintClass => typeof IMPL::SQL::Schema::Constraint::Index };
98
99 ##################################################
100
101 package IMPL::SQL::Schema::Traits::Unique;
102
103 use base qw(IMPL::SQL::Schema::Traits::Constraint);
104
105 __PACKAGE__->PassThroughArgs;
106
107 use constant { constraintClass => typeof IMPL::SQL::Schema::Constraint::Unique };
108
109 ##################################################
110
111 package IMPL::SQL::Schema::Traits::ForeignKey;
112
113 use base qw(IMPL::SQL::Schema::Traits::Constraint);
114 use fields qw(
115 foreignTable
116 foreignColumns
117 onUpdate
118 onDelete
119 );
120
121 use constant { constraintClass => typeof IMPL::SQL::Schema::Constraint::ForeignKey };
122
123 our %CTOR = (
124 'IMPL::SQL::Schema::Traits::Constraint' => sub { @_[0..1] }
125 );
126
127 sub CTOR {
128 my ($this,$foreignTable,$foreignColumns,%args) = @_[0,3..$#_];
129
130 $this->{foreignTable} = $foreignTable;
131 $this->{foreignColumns} = $foreignColumns;
132
133 $this->{onDelete} = $args{onDelete} if $args{onDelete};
134 $this->{onUpdate} = $args{onUpdate} if $args{onUpdate};
135 }
136
137
138 ##################################################
139
140 package IMPL::SQL::Schema::Traits::CreateTable;
141
142 use IMPL::Const qw(:prop);
143 use IMPL::declare {
144 require => {
145 Table => '-IMPL::SQL::Schema::Traits::Table',
146 ArgException => '-IMPL::InvalidArgumentException',
147 OpException => '-IMPL::InvalidOperationException'
148 },
149 base => [
150 '-IMPL::SQL::Schema::Traits' => undef
151 ],
152 props => [
153 table => PROP_RO,
154 ]
155 };
156 use IMPL::lang;
157
158 sub CTOR {
159 my ($this,$table) = @_;
160
161 die ArgException->new("table", "An object of IMPL::SQL::Schema::Traits::Table type is required")
162 unless is($table, Table);
163
164 $this->table($table);
165 }
166
167 sub CanApply {
168 my ($this,$schema) = @_;
169
170 return( $schema->GetTable( $this->table->{name} ) ? 0 : 1 );
171 }
172
173 sub Apply {
174 my ($this,$schema) = @_;
175
176 my $args = {%{$this->table}};
177
178 my $constraints = delete $args->{constraints} || [];
179
180 my $table = $schema->AddTable($args);
181
182 $table->AddConstraint($_->constraintClass, $_) foreach @{$constraints};
183 }
184
185 ##################################################
186
187 package IMPL::SQL::Schema::Traits::DropTable;
188 use IMPL::Const qw(:prop);
189 use IMPL::declare {
190 require => {
191 ArgException => '-IMPL::InvalidArgumentException'
192 },
193 base => [
194 '-IMPL::SQL::Schema::Traits' => undef
195 ],
196 props => [
197 tableName => PROP_RO,
198 ]
199 };
200
201 sub CTOR {
202 my ($this,$tableName) = @_;
203
204 $this->tableName($tableName) or die ArgException->new("tableName is required");
205 }
206
207 sub CanApply {
208 my ($this,$schema) = @_;
209
210 return $schema->GetTable( $this->tableName ) ? 1 : 0;
211 }
212
213 sub Apply {
214 my ($this,$schema) = @_;
215
216 $schema->RemoveTable($this->tableName);
217 }
218
219 ##################################################
220
221 package IMPL::SQL::Schema::Traits::RenameTable;
222 use IMPL::Const qw(:prop);
223 use IMPL::declare {
224 require => {
225 ArgException => '-IMPL::InvalidArgumentException'
226 },
227 base => [
228 '-IMPL::SQL::Schema::Traits' => undef
229 ],
230 props => [
231 tableName => PROP_RO,
232 tableNewName => PROP_RO,
233 ]
234 };
235
236 sub CTOR {
237 my ($this, $oldName, $newName) = @_;
238
239 $this->tableName($oldName) or die ArgException->new("A table name is required");
240 $this->tableNewName($newName) or die ArgException->new("A new table name is required");
241 }
242
243 sub CanApply {
244 my ($this, $schema) = @_;
245
246 return ($schema->GetTable($this->tableName) and not $schema->GetTable($this->tableNewName) ? 1 : 0 );
247 }
248
249 sub Apply {
250 my ($this,$schema) = @_;
251
252 $schema->RenameTable($this->tableName, $this->tableNewName);
253
254 }
255
256 #################################################
257
258 package IMPL::SQL::Schema::Traits::AlterTableAddColumn;
259
260 use IMPL::Const qw(:prop);
261 use IMPL::declare {
262 require => {
263 Column => '-IMPL::SQL::Schema::Traits::Column',
264 ArgException => '-IMPL::InvalidArgumentException',
265 OpException => '-IMPL::InvalidOperationException'
266 },
267 base => [
268 '-IMPL::SQL::Schema::Traits' => undef
269 ],
270 props => [
271 tableName => PROP_RO,
272 column => PROP_RO,
273 position => PROP_RO
274 ]
275 };
276 use IMPL::lang;
277
278
279 sub CTOR {
280 my ($this,$tableName,$column) = @_;
281
282 $this->tableName($tableName) or die ArgException->new("A table name is required");
283
284 die ArgException->new("A column should be a IMPL::SQL::Schema::Traits::Column object")
285 unless is($column, Column);
286
287 $this->column($column);
288 }
289
290 sub CanApply {
291 my ($this,$schema) = @_;
292
293 my $table = $schema->GetTable($this->tableName)
294 or return 0;
295
296 return $table->GetColumn( $this->column->{name} ) ? 0 : 1;
297 }
298
299 sub Apply {
300 my ($this,$schema) = @_;
301
302 my $table = $schema->GetTable($this->tableName)
303 or die OpException->new("The specified table doesn't exists", $this->tableName);
304
305 if ($this->position) {
306 $table->AddColumn($this->column);
307 } else {
308 $table->InsertColumn($this->column,$this->position);
309 }
310 }
311
312 #################################################
313
314 package IMPL::SQL::Schema::Traits::AlterTableDropColumn;
315
316 use IMPL::Const qw(:prop);
317 use IMPL::declare {
318 require => {
319 FK => '-IMPL::SQL::Schema::Constraint::ForeignKey',
320 ArgException => '-IMPL::InvalidArgumentException',
321 OpException => '-IMPL::InvalidOperationException'
322 },
323 base => [
324 '-IMPL::SQL::Schema::Traits' => undef
325 ],
326 props => [
327 tableName => PROP_RO,
328 columnName => PROP_RO,
329 ]
330 };
331 use IMPL::lang;
332
333
334 sub CTOR {
335 my ($this,$table,$column) = @_;
336
337 $this->tableName($table) or die ArgException->new(tableName => "A table name should be specified");
338 $this->columnName($column) or die ArgException->new(columnName => "A column name should be specified");
339 }
340
341 sub CanApply {
342 my ($this,$schema) = @_;
343
344 my $table = $schema->GetTable($this->tableName)
345 or return 0;
346
347 $table->GetColumn($this->columnName) or
348 return 0;
349
350 # столбец
351 return $table->GetColumnConstraints($this->columnName)
352 ? 0
353 : 1
354 ;
355 }
356
357 sub Apply {
358 my ($this,$schema) = @_;
359
360 my $table = $schema->GetTable($this->tableName)
361 or die OpException->new("The specified table doesn't exists", $this->tableName);
362
363 $table->RemoveColumn($this->columnName);
364 }
365
366 #################################################
367
368 package IMPL::SQL::Schema::Traits::AlterTableChangeColumn;
369
370 use IMPL::Const qw(:prop);
371 use IMPL::declare {
372 require => {
373 Constraint => '-IMPL::SQL::Schema::Traits::Constraint',
374 ArgException => '-IMPL::InvalidArgumentException',
375 OpException => '-IMPL::InvalidOperationException'
376 },
377 base => [
378 '-IMPL::SQL::Schema::Traits' => undef
379 ],
380 props => [
381 tableName => PROP_RO,
382 columnName => PROP_RO,
383 columnType => PROP_RW,
384 defaultValue => PROP_RW,
385 isNullable => PROP_RW,
386 position => PROP_RW,
387 options => PROP_RW # hash diff format, (keys have a prefix '+' - add or update value, '-' remove value)
388 ]
389 };
390 use IMPL::lang;
391
392 sub CTOR {
393 my ($this, $table,$column,%args) = @_;
394
395 $this->tableName($table) or die ArgException->new(tableName => "A table name is required");
396 $this->columnName($column) or die ArgException->new(columnName => "A column name is required");
397
398 $this->$_($args{$_})
399 for (grep exists $args{$_}, qw(columnType defaultValue isNullable options));
400 }
401
402 sub CanApply {
403 my ($this,$schema) = @_;
404
405 my $table = $schema->GetTable($this->tableName)
406 or return 0;
407
408 return $table->GetColumn($this->columnName) ? 1 : 0;
409 }
410
411 sub Apply {
412 my ($this,$schema) = @_;
413
414 my $table = $schema->GetTable($this->tableName)
415 or die OpException->new("The specified table doesn't exists", $this->tableName);
416
417 my $column = $table->GetColumn($this->columnName)
418 or die OpException->new("The specified column doesn't exists", $this->tableName, $this->columnName);
419
420 $column->SetType($this->columnType) if defined $this->columnType;
421 $column->SetNullable($this->isNullable) if defined $this->isNullable;
422 $column->SetDefaultValue($this->defaultValue) if defined $this->defaultValue;
423 $column->SetOptions($this->options) if defined $this->options;
424
425 $table->SetColumnPosition($this->position)
426 if ($this->position);
427
428 }
429
430 #################################################
431
432 package IMPL::SQL::Schema::Traits::AlterTableAddConstraint;
433
434 use IMPL::Const qw(:prop);
435 use IMPL::declare {
436 require => {
437 Constraint => '-IMPL::SQL::Schema::Traits::Constraint',
438 ArgException => '-IMPL::InvalidArgumentException',
439 FK => '-IMPL::SQL::Schema::Traits::ForeignKey'
440 },
441 base => [
442 '-IMPL::SQL::Schema::Traits' => undef
443 ],
444 props => [
445 tableName => PROP_RO,
446 constraint => PROP_RO
447 ]
448 };
449 use IMPL::lang;
450
451 sub CTOR {
452 my ($this,$table,$constraint) = @_;
453
454 $this->tableName($table) or die ArgException->new( tableName => "A table name is required");
455
456 die ArgException->new(constaraint => "A valid " . Constraint . " is required")
457 unless is($constraint, Constraint);
458
459 $this->constraint($constraint);
460 }
461
462 sub CanApply {
463 my ($this, $schema) = @_;
464
465 my $table = $schema->GetTable($this->tableName)
466 or return 0;
467
468 my $constraint = $this->constraint;
469
470 my @columns = map $table->GetColumn($_), @{$constraint->{columns} || []};
471
472 # проверяем, что в таблице есть все столбцы для создания ограничения
473 return 0 if grep not($_), @columns;
474
475 if (is($constraint,FK)) {
476 my $foreignTable = $schema->GetTable($constraint->{foreignTable})
477 or return 0;
478
479 my @foreignColumns = map $foreignTable->GetColumn($_), @{$constraint->{foreignColumns}||[]};
480
481 # внешняя таблица имеет нужные столбцы
482 return 0
483 if grep not($_), @foreignColumns;
484
485 # типы столбцов во внешней таблице совпадают с типами столбцов ограничения
486 return 0
487 if grep not($columns[$_]->type->SameValue($foreignColumns[$_]->type)), (0 .. $#columns);
488 }
489
490 return 1;
491 }
492
493 sub Apply {
494 my ($this,$schema) = @_;
495
496 my $table = $schema->GetTable($this->tableName)
497 or die IMPL::InvalidOperationException->new("The specified table doesn't exists", $this->tableName);
498
499 my $constraint = $this->constraint;
500
501 if (is($constraint,FK)) {
502 my $args = { %$constraint };
503 $args->{referencedTable} = $schema->GetTable(delete $args->{foreignTable});
504 $args->{referencedColumns} = delete $args->{foreignColumns};
505 $table->AddConstraint($constraint->constraintClass, $args);
506 } else {
507 $table->AddConstraint($constraint->constraintClass, $constraint);
508 }
509
510 }
511
512 #################################################
513
514 package IMPL::SQL::Schema::Traits::AlterTableDropConstraint;
515 use IMPL::Const qw(:prop);
516 use IMPL::declare {
517 require => {
518 PK => '-IMPL::SQL::Schema::Constraint::PrimaryKey'
519 },
520 base => [
521 '-IMPL::SQL::Schema::Traits' => undef
522 ],
523 props => [
524 tableName => PROP_RO,
525 constraintName => PROP_RO
526 ]
527 };
528 use IMPL::lang qw(is);
529
530 sub CTOR {
531 my ($this,$table,$constraint) = @_;
532
533 die new IMPL::InvalidArgumentException( tableName => "A table name is required" ) unless $table;
534 die new IMPL::InvalidArgumentException( constraintName => "A constraint name is required" ) unless $constraint;
535
536 $this->tableName($table);
537 $this->constraintName($constraint);
538 }
539
540 sub CanApply {
541 my ($this,$schema) = @_;
542
543 my $table = $schema->GetTable($this->tableName)
544 or return 0;
545
546 my $constraint = $table->GetConstraint($this->constraintName)
547 or return 0;
548
549 # есть ли внешние ключи на данную таблицу
550 return (
551 is($constraint,PK)
552 && values( %{$constraint->connectedFK || {}} )
553 ? 0
554 : 1
555 );
556 }
557
558 sub Apply {
559 my ($this,$schema) = @_;
560
561 my $table = $schema->GetTable($this->tableName)
562 or die IMPL::InvalidOperationException->new("The specified table doesn't exists", $this->tableName);
563
564 $table->RemoveConstraint($this->constraintName);
565 }
566
567
568 1;
569
570 __END__
571
572 =pod
573
574 =head1 NAME
575
576 C<IMPL::SQL::Traits> - Операции над объектками SQL схемы.
577
578 =head1 DESCRIPTION
579
580 Изменения схемы могу быть представлены в виде последовательности примитивных операций.
581 Правила выполнения последовательности примитывных действий могут варьироваться
582 в зависимости от процессора, который их выполняет. Например C<IMPL::SQL::Schema::Traits::Processor>.
583
584 Данные, которые содержаться в примитивных операциях не могут существовать независимо от схемы.
585
586 =head1 OPERATIONS
587
588 =head2 General
589
590 Методы обще для всех примитивных операций.
591
592 =head3 C<CanApply($schema)>
593
594 Определяет возможность применения операции к указанной схеме.
595
596 Возвращаемое значение:
597
598 =over
599
600 =item C<true>
601
602 Операция приминима к схеме.
603
604 =item C<false>
605
606 Операция не может быть применена к схеме.
607
608 =back
609
610 =head3 C<Apply($schema)>
611
612 Применяет операцию к указанной схеме.
613
614 =head2 Primitive operations
615
616 =head3 C<IMPL::SQL::Schema::Traits::CreateTable>
617
618 Создает таблицу
619
620 =head4 C<CTOR($table)>
621
622 =head4 C<[get]table>
623
624 C<IMPL::SQL::Schema::Traits::Table> - описание создаваемой таблицы
625
626 =head3 C<IMPL::SQL::Schema::Traits::DropTable>
627
628 Удалает таблицу по имени
629
630 =head4 C<CTOR($tableName)>
631
632 =head4 C<[get]tableName>
633
634 Имя удаляемой таблицы
635
636 =head3 C<IMPL::SQL::Schema::Traits::RenameTable>
637
638 =head4 C<CTOR($tableName,$tableNewName)>
639
640 =head4 C<[get]tableName>
641
642 Имя таблицы, которую требуется переименовать
643
644 =head4 C<[get]tableNewName>
645
646 Новое имя таблицы
647
648 =head3 C<IMPL::SQL::Schema::Traits::AlterTableAddColumn>
649
650 Добавляет столбец в таблицу
651
652 =head4 C<CTOR($tableName,$column,$position)>
653
654 =head4 C<[get]tableName>
655
656 Имя таблицы в которую нужно добавить столбец
657
658 =head4 C<[get]column>
659
660 C<IMPL::SQL::Schema::Traits::Column> - описание столбца который нужно добавить
661
662 =head4 C<[get]position>
663
664 Позиция на которую нужно вставить столбец
665
666 =head3 C<IMPL::SQL::Schema::Traits::AlterTableDropColumn>
667
668 Удаляет столбец из таблицы
669
670 =head4 C<CTOR($tableName,$columnName)>
671
672 =head4 C<[get]tableName>
673
674 Имя таблицы в которой нужно удалить столбец
675
676 =head4 C<[get]columnName>
677
678 Имя столбца для удаления
679
680 =head3 C<IMPL::SQL::Schema::Traits::AlterTableChangeColumn>
681
682 Меняет описание столбца
683
684 =head4 C<CTOR($tableName,$columnName,%args)>
685
686 C<%args> - хеш, ключами которого являются оставшиеся свойства создаваемого объекта.
687
688 =head4 C<[get]tableName>
689
690 Имя таблицы в которой находится столбец.
691
692 =head4 C<[get]columnName>
693
694 Имя столбца для изменения
695
696 =head4 C<[get]columnType>
697
698 Новый тип столбца. Не задан, если тип не меняется
699
700 =head4 C<[get]defaultValue>
701
702 Значение по умолчанию. Не задано, если не меняется
703
704 =head4 C<[get]isNullable>
705
706 Может ли столбец содержать C<NULL>. Не задано, если не меняется.
707
708 =head4 C<[get]options>
709
710 Хеш опций, не задан, если опции не меняются. Данный хеш содержит разничу между
711 старыми и новыми значениями свойства C<tag> столбца.
712
713
714 =head3 C<IMPL::SQL::Schema::Traits::AlterTableAddConstraint>
715
716 Базовый класс для операций по добавлению ограничений
717
718 =head4 C<CTOR($tableName,$constraint)>
719
720 =head4 C<[get]tableName>
721
722 Имя таблицы в которую добавляется ограничение.
723
724 =head4 C<[get]constraint>
725
726 C<IMPL::SQL::Schema::Traits::Constraint> - описние ограничения, которое нужно добавить.
727
728 =head3 C<IMPL::SQL::Schema::Traits::AlterTableDropConstraint>
729
730 Удаляет ограничение на таблицу
731
732 =head4 C<CTOR($tableName,$constraintName)>
733
734 =head4 C<[get]tableName>
735
736 Имя таблицы в которой требуется удалить ограничение.
737
738 =head4 C<[get]constraintName>
739
740 Имя ограничения для удаления.
741
742 =cut