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