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