|
163
|
1 package IMPL::SQL::Traits;
|
|
49
|
2 use strict;
|
|
163
|
3 use IMPL::_core::version;
|
|
|
4 use IMPL::Exception();
|
|
|
5
|
|
164
|
6 use IMPL::base qw(IMPL::Object);
|
|
49
|
7
|
|
164
|
8 ###################################################
|
|
|
9
|
|
163
|
10 package IMPL::SQL::Traits::Table;
|
|
164
|
11 use IMPL::base qw(IMPL::Object::Fields);
|
|
163
|
12
|
|
164
|
13 use fields qw(
|
|
|
14 name
|
|
|
15 columns
|
|
|
16 constraints
|
|
|
17 options
|
|
|
18 );
|
|
|
19
|
|
|
20 sub CTOR {
|
|
|
21 my ($this,$table,$columns,$constraints,$options) = @_;
|
|
|
22
|
|
|
23 $this->{name} = $table;
|
|
|
24 $this->{columns} = $columns;
|
|
|
25 $this->{constraints} = $constraints;
|
|
|
26 $this->{options} = $options;
|
|
|
27 }
|
|
|
28
|
|
|
29 ###################################################
|
|
|
30
|
|
|
31 package IMPL::SQL::Traits::Column;
|
|
|
32 use IMPL::base qw(IMPL::Object::Fields);
|
|
|
33
|
|
|
34 use fields qw(
|
|
|
35 name
|
|
|
36 type
|
|
|
37 isNullable
|
|
|
38 defaultValue
|
|
|
39 tag
|
|
|
40 );
|
|
|
41
|
|
|
42 sub CTOR {
|
|
|
43 my ($this, $name, $type, %args) = @_;
|
|
|
44
|
|
|
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;
|
|
163
|
94
|
|
164
|
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);
|
|
163
|
177 use IMPL::Class::Property;
|
|
49
|
178
|
|
|
179 BEGIN {
|
|
164
|
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;
|
|
49
|
211 }
|
|
|
212
|
|
164
|
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;
|
|
49
|
263 }
|
|
|
264
|
|
164
|
265 #################################################
|
|
163
|
266
|
|
164
|
267 package IMPL::SQL::Traits::AlterTableChangeColumn;
|
|
|
268 use IMPL::base qw(IMPL::SQL::Traits);
|
|
|
269 use IMPL::Class::Property;
|
|
49
|
270
|
|
164
|
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 }
|
|
49
|
279
|
|
164
|
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 }
|
|
49
|
289
|
|
164
|
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 }
|
|
49
|
305
|
|
164
|
306 #################################################
|
|
163
|
307
|
|
164
|
308 package IMPL::SQL::Traits::AlterTableAddConstraint;
|
|
|
309 use IMPL::base qw(IMPL::SQL::Traits);
|
|
|
310 use IMPL::Class::Property;
|
|
|
311 use IMPL::lang;
|
|
49
|
312
|
|
164
|
313 BEGIN {
|
|
|
314 public property tableName => prop_get | owner_set;
|
|
|
315 public property constraint => prop_get | owner_set;
|
|
|
316 }
|
|
49
|
317
|
|
164
|
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 }
|
|
49
|
328
|
|
164
|
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 }
|
|
49
|
340
|
|
164
|
341 #################################################
|
|
49
|
342
|
|
164
|
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 }
|
|
163
|
351
|
|
164
|
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 }
|
|
49
|
358
|
|
164
|
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 }
|
|
163
|
369
|
|
49
|
370
|
|
|
371 1;
|
|
163
|
372
|
|
|
373 __END__
|
|
|
374
|
|
|
375 =pod
|
|
|
376
|
|
|
377 =head1 NAME
|
|
|
378
|
|
|
379 C<IMPL::SQL::Traits> - Операции над объектками SQL схемы.
|
|
|
380
|
|
|
381 =head1 DESCRIPTION
|
|
|
382
|
|
|
383 Изменения схемы могу быть представлены в виде последовательности примитивных операций.
|
|
164
|
384 Правила выполнения последовательности примитывных действий могут варьироваться
|
|
|
385 в зависимости от процессора, который их выполняет. Например C<IMPL::SQL::Traits::Processor>.
|
|
163
|
386
|
|
164
|
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
|
|
163
|
574
|
|
|
575 =cut |
