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