Mercurial > pub > Impl
comparison Lib/IMPL/SQL/Schema/Traits.pm @ 165:76515373dac0
Added Class::Template,
Rewritten SQL::Schema
'use parent' directive instead of 'use base'
author | wizard |
---|---|
date | Sat, 23 Apr 2011 23:06:48 +0400 |
parents | eb3e9861a761 |
children | 1f7a6d762394 |
comparison
equal
deleted
inserted
replaced
164:eb3e9861a761 | 165:76515373dac0 |
---|---|
1 package IMPL::SQL::Traits; | 1 package IMPL::SQL::Schema::Traits; |
2 use strict; | 2 use strict; |
3 use IMPL::_core::version; | 3 use IMPL::_core::version; |
4 use IMPL::Exception(); | 4 use IMPL::Exception(); |
5 | 5 |
6 use IMPL::base qw(IMPL::Object); | 6 use parent qw(IMPL::Object); |
7 use IMPL::Code::Loader(); | |
8 | |
9 BEGIN { | |
10 IMPL::Code::Loader->Provide(__PACKAGE__); | |
11 } | |
7 | 12 |
8 ################################################### | 13 ################################################### |
9 | 14 |
10 package IMPL::SQL::Traits::Table; | 15 package IMPL::SQL::Schema::Traits::Table; |
11 use IMPL::base qw(IMPL::Object::Fields); | 16 use base qw(IMPL::Object::Fields); |
12 | 17 |
13 use fields qw( | 18 use fields qw( |
14 name | 19 name |
15 columns | 20 columns |
16 constraints | 21 constraints |
18 ); | 23 ); |
19 | 24 |
20 sub CTOR { | 25 sub CTOR { |
21 my ($this,$table,$columns,$constraints,$options) = @_; | 26 my ($this,$table,$columns,$constraints,$options) = @_; |
22 | 27 |
23 $this->{name} = $table; | 28 $this->{name} = $table or die new IMPL::InvalidArgumentException(table => "A table name is required"); |
24 $this->{columns} = $columns; | 29 $this->{columns} = $columns if defined $columns; |
25 $this->{constraints} = $constraints; | 30 $this->{constraints} = $constraints if defined $constraints; |
26 $this->{options} = $options; | 31 $this->{options} = $options if defined $options; |
27 } | 32 } |
28 | 33 |
29 ################################################### | 34 ################################################### |
30 | 35 |
31 package IMPL::SQL::Traits::Column; | 36 package IMPL::SQL::Schema::Traits::Column; |
32 use IMPL::base qw(IMPL::Object::Fields); | 37 use base qw(IMPL::Object::Fields); |
33 | 38 |
34 use fields qw( | 39 use fields qw( |
35 name | 40 name |
36 type | 41 type |
37 isNullable | 42 isNullable |
49 $this->{tag} = $args{tag} if exists $args{tag}; | 54 $this->{tag} = $args{tag} if exists $args{tag}; |
50 } | 55 } |
51 | 56 |
52 ################################################## | 57 ################################################## |
53 | 58 |
54 package IMPL::SQL::Traits::Constraint; | 59 package IMPL::SQL::Schema::Traits::Constraint; |
55 use IMPL::base qw(IMPL::Object::Fields); | 60 use base qw(IMPL::Object::Fields); |
56 | 61 |
57 use fields qw( | 62 use fields qw( |
58 name | 63 name |
59 tableName | 64 tableName |
60 columns | 65 columns |
68 $$this->{columns} = $columns; | 73 $$this->{columns} = $columns; |
69 } | 74 } |
70 | 75 |
71 ################################################## | 76 ################################################## |
72 | 77 |
73 package IMPL::SQL::Traits::PrimaryKey; | 78 package IMPL::SQL::Schema::Traits::PrimaryKey; |
74 | 79 |
75 use IMPL::base qw(IMPL::SQL::Traits::Constraint); | 80 use base qw(IMPL::SQL::Schema::Traits::Constraint); |
76 | 81 |
77 __PACKAGE__->PassThroughArgs; | 82 __PACKAGE__->PassThroughArgs; |
78 | 83 |
79 ################################################## | 84 ################################################## |
80 | 85 |
81 package IMPL::SQL::Traits::Index; | 86 package IMPL::SQL::Schema::Traits::Index; |
82 | 87 |
83 use IMPL::base qw(IMPL::SQL::Traits::Constraint); | 88 use base qw(IMPL::SQL::Schema::Traits::Constraint); |
84 | 89 |
85 __PACKAGE__->PassThroughArgs; | 90 __PACKAGE__->PassThroughArgs; |
86 | 91 |
87 ################################################## | 92 ################################################## |
88 | 93 |
89 package IMPL::SQL::Traits::Unique; | 94 package IMPL::SQL::Schema::Traits::Unique; |
90 | 95 |
91 use IMPL::base qw(IMPL::SQL::Traits::Constraint); | 96 use base qw(IMPL::SQL::Schema::Traits::Constraint); |
92 | 97 |
93 __PACKAGE__->PassThroughArgs; | 98 __PACKAGE__->PassThroughArgs; |
94 | 99 |
95 ################################################## | 100 ################################################## |
96 | 101 |
97 package IMPL::SQL::Traits::ForeignKey; | 102 package IMPL::SQL::Schema::Traits::ForeignKey; |
98 | 103 |
99 use IMPL::base qw(IMPL::SQL::Traits::Constraint); | 104 use base qw(IMPL::SQL::Schema::Traits::Constraint); |
100 use fields qw( | 105 use fields qw( |
101 foreignTable | 106 foreignTable |
102 foreignColumns | 107 foreignColumns |
103 ); | 108 ); |
104 | 109 |
105 our %CTOR = ( | 110 our %CTOR = ( |
106 'IMPL::SQL::Traits::Constraint' => sub { @_[0..2] } | 111 'IMPL::SQL::Schema::Traits::Constraint' => sub { @_[0..2] } |
107 ); | 112 ); |
108 | 113 |
109 sub CTOR { | 114 sub CTOR { |
110 my ($this,$foreignTable,$foreignColumns) = @_[0,4,5]; | 115 my ($this,$foreignTable,$foreignColumns) = @_[0,4,5]; |
111 | 116 |
114 } | 119 } |
115 | 120 |
116 | 121 |
117 ################################################## | 122 ################################################## |
118 | 123 |
119 package IMPL::SQL::Traits::CreateTable; | 124 package IMPL::SQL::Schema::Traits::CreateTable; |
120 | 125 |
121 use IMPL::base qw(IMPL::SQL::Traits); | 126 use parent qw(-norequire IMPL::SQL::Schema::Traits); |
122 use IMPL::Class::Property; | 127 use IMPL::Class::Property; |
123 use IMPL::lang; | 128 use IMPL::lang; |
124 | 129 |
125 BEGIN { | 130 BEGIN { |
126 public property table => prop_get | owner_set; | 131 public property table => prop_get | owner_set; |
127 } | 132 } |
128 | 133 |
129 sub CTOR { | 134 sub CTOR { |
130 my ($this,$table) = @_; | 135 my ($this,$table) = @_; |
131 | 136 |
132 die new IMPL::InvalidArgumentException("table", "An object of IMPL::SQL::Traits::Table type is required") | 137 die new IMPL::InvalidArgumentException("table", "An object of IMPL::SQL::Schema::Traits::Table type is required") |
133 unless is $table, typeof IMPL::SQL::Traits::Table; | 138 unless is $table, typeof IMPL::SQL::Schema::Traits::Table; |
134 | 139 |
135 $this->table($table); | 140 $this->table($table); |
136 } | 141 } |
137 | 142 |
138 sub apply { | 143 sub apply { |
144 return 1; | 149 return 1; |
145 } | 150 } |
146 | 151 |
147 ################################################## | 152 ################################################## |
148 | 153 |
149 package IMPL::SQL::Traits::DropTable; | 154 package IMPL::SQL::Schema::Traits::DropTable; |
150 use IMPL::base qw(IMPL::SQL::Traits); | 155 use parent qw(-norequire IMPL::SQL::Schema::Traits); |
151 use IMPL::Class::Property; | 156 use IMPL::Class::Property; |
152 | 157 |
153 BEGIN { | 158 BEGIN { |
154 public property tableName => prop_get | owner_set; | 159 public property tableName => prop_get | owner_set; |
155 } | 160 } |
170 return 1; | 175 return 1; |
171 } | 176 } |
172 | 177 |
173 ################################################## | 178 ################################################## |
174 | 179 |
175 package IMPL::SQL::Traits::RenameTable; | 180 package IMPL::SQL::Schema::Traits::RenameTable; |
176 use IMPL::base qw(IMPL::SQL::Traits); | 181 use parent qw(-norequire IMPL::SQL::Schema::Traits); |
177 use IMPL::Class::Property; | 182 use IMPL::Class::Property; |
178 | 183 |
179 BEGIN { | 184 BEGIN { |
180 public property tableName => prop_get | owner_set; | 185 public property tableName => prop_get | owner_set; |
181 public property tableNewName => prop_get | owner_set; | 186 public property tableNewName => prop_get | owner_set; |
198 return 1; | 203 return 1; |
199 } | 204 } |
200 | 205 |
201 ################################################# | 206 ################################################# |
202 | 207 |
203 package IMPL::SQL::Traits::AlterTableAddColumn; | 208 package IMPL::SQL::Schema::Traits::AlterTableAddColumn; |
204 use IMPL::base qw(IMPL::SQL::Traits); | 209 use parent qw(-norequire IMPL::SQL::Schema::Traits); |
205 use IMPL::Class::Property; | 210 use IMPL::Class::Property; |
206 use IMPL::lang; | 211 use IMPL::lang; |
207 | 212 |
208 BEGIN { | 213 BEGIN { |
209 public property tableName => prop_get | owner_set; | 214 public property tableName => prop_get | owner_set; |
213 sub CTOR { | 218 sub CTOR { |
214 my ($this,$tableName,$column) = @_; | 219 my ($this,$tableName,$column) = @_; |
215 | 220 |
216 $this->tableName($tableName) or die new IMPL::InvalidArgumentException("A table name is required"); | 221 $this->tableName($tableName) or die new IMPL::InvalidArgumentException("A table name is required"); |
217 | 222 |
218 die new IMPL::InvalidArgumentException("A column should be a IMPL::SQL::Traits::Column object") | 223 die new IMPL::InvalidArgumentException("A column should be a IMPL::SQL::Schema::Traits::Column object") |
219 unless is $column, typeof IMPL::SQL::Traits::Column; | 224 unless is $column, typeof IMPL::SQL::Schema::Traits::Column; |
220 | 225 |
221 $this->column($column); | 226 $this->column($column); |
222 } | 227 } |
223 | 228 |
224 sub apply { | 229 sub apply { |
233 return 1; | 238 return 1; |
234 } | 239 } |
235 | 240 |
236 ################################################# | 241 ################################################# |
237 | 242 |
238 package IMPL::SQL::Traits::AlterTableDropColumn; | 243 package IMPL::SQL::Schema::Traits::AlterTableDropColumn; |
239 use IMPL::base qw(IMPL::SQL::Traits); | 244 use parent qw(-norequire IMPL::SQL::Schema::Traits); |
240 use IMPL::Class::Property; | 245 use IMPL::Class::Property; |
241 | 246 |
242 BEGIN { | 247 BEGIN { |
243 public property tableName => prop_get | owner_set; | 248 public property tableName => prop_get | owner_set; |
244 public property columnName => prop_get | owner_set; | 249 public property columnName => prop_get | owner_set; |
262 } || 0; | 267 } || 0; |
263 } | 268 } |
264 | 269 |
265 ################################################# | 270 ################################################# |
266 | 271 |
267 package IMPL::SQL::Traits::AlterTableChangeColumn; | 272 package IMPL::SQL::Schema::Traits::AlterTableChangeColumn; |
268 use IMPL::base qw(IMPL::SQL::Traits); | 273 use parent qw(-norequire IMPL::SQL::Schema::Traits); |
269 use IMPL::Class::Property; | 274 use IMPL::Class::Property; |
270 | 275 |
271 BEGIN { | 276 BEGIN { |
272 public property tableName => prop_get | owner_set; | 277 public property tableName => prop_get | owner_set; |
273 public property columnName => prop_get | owner_set; | 278 public property columnName => prop_get | owner_set; |
303 } || 0; | 308 } || 0; |
304 } | 309 } |
305 | 310 |
306 ################################################# | 311 ################################################# |
307 | 312 |
308 package IMPL::SQL::Traits::AlterTableAddConstraint; | 313 package IMPL::SQL::Schema::Traits::AlterTableAddConstraint; |
309 use IMPL::base qw(IMPL::SQL::Traits); | 314 use parent qw(-norequire IMPL::SQL::Schema::Traits); |
310 use IMPL::Class::Property; | 315 use IMPL::Class::Property; |
311 use IMPL::lang; | 316 use IMPL::lang; |
312 | 317 |
313 BEGIN { | 318 BEGIN { |
314 public property tableName => prop_get | owner_set; | 319 public property tableName => prop_get | owner_set; |
318 sub CTOR { | 323 sub CTOR { |
319 my ($this,$table,$constraint) = @_; | 324 my ($this,$table,$constraint) = @_; |
320 | 325 |
321 $this->tableName($table) or die new IMPL::InvalidArgumentException( tableName => "A table name is required"); | 326 $this->tableName($table) or die new IMPL::InvalidArgumentException( tableName => "A table name is required"); |
322 | 327 |
323 die new IMPL::InvalidArgumentException(constaraint => "A valid IMPL::SQL::Traits::Constarint is required") | 328 die new IMPL::InvalidArgumentException(constaraint => "A valid IMPL::SQL::Schema::Traits::Constarint is required") |
324 unless is $constraint, typeof IMPL::SQL::Traits::Constraint; | 329 unless is $constraint, typeof IMPL::SQL::Schema::Traits::Constraint; |
325 | 330 |
326 $this->constraint($constraint); | 331 $this->constraint($constraint); |
327 } | 332 } |
328 | 333 |
329 sub apply { | 334 sub apply { |
338 | 343 |
339 } | 344 } |
340 | 345 |
341 ################################################# | 346 ################################################# |
342 | 347 |
343 package IMPL::SQL::Traits::AlterTableDropConstraint; | 348 package IMPL::SQL::Schema::Traits::AlterTableDropConstraint; |
344 use IMPL::base qw(IMPL::SQL::Traits); | 349 use parent qw(-norequire IMPL::SQL::Schema::Traits); |
345 use IMPL::Class::Property; | 350 use IMPL::Class::Property; |
346 | 351 |
347 BEGIN { | 352 BEGIN { |
348 public property tableName => prop_get | owner_set; | 353 public property tableName => prop_get | owner_set; |
349 public property constraintName => prop_get | owner_set; | 354 public property constraintName => prop_get | owner_set; |
380 | 385 |
381 =head1 DESCRIPTION | 386 =head1 DESCRIPTION |
382 | 387 |
383 Изменения схемы могу быть представлены в виде последовательности примитивных операций. | 388 Изменения схемы могу быть представлены в виде последовательности примитивных операций. |
384 Правила выполнения последовательности примитывных действий могут варьироваться | 389 Правила выполнения последовательности примитывных действий могут варьироваться |
385 в зависимости от процессора, который их выполняет. Например C<IMPL::SQL::Traits::Processor>. | 390 в зависимости от процессора, который их выполняет. Например C<IMPL::SQL::Schema::Traits::Processor>. |
386 | 391 |
387 Данные, которые содержаться в примитивных операциях не могут существовать независимо от схемы. | 392 Данные, которые содержаться в примитивных операциях не могут существовать независимо от схемы. |
388 | 393 |
389 =head1 OPEARATIONS | 394 =head1 OPEARATIONS |
390 | 395 |
416 | 421 |
417 =head2 Primitive operations | 422 =head2 Primitive operations |
418 | 423 |
419 =over | 424 =over |
420 | 425 |
421 =item C<IMPL::SQL::Traits::CreateTable> | 426 =item C<IMPL::SQL::Schema::Traits::CreateTable> |
422 | 427 |
423 Создает таблицу | 428 Создает таблицу |
424 | 429 |
425 =over | 430 =over |
426 | 431 |
427 =item C<CTOR($table)> | 432 =item C<CTOR($table)> |
428 | 433 |
429 =item C<[get]table> | 434 =item C<[get]table> |
430 | 435 |
431 C<IMPL::SQL::Traits::Table> - описание создаваемой таблицы | 436 C<IMPL::SQL::Schema::Traits::Table> - описание создаваемой таблицы |
432 | 437 |
433 =back | 438 =back |
434 | 439 |
435 =item C<IMPL::SQL::Traits::DropTable> | 440 =item C<IMPL::SQL::Schema::Traits::DropTable> |
436 | 441 |
437 Удалает таблицу по имени | 442 Удалает таблицу по имени |
438 | 443 |
439 =over | 444 =over |
440 | 445 |
444 | 449 |
445 Имя удаляемой таблицы | 450 Имя удаляемой таблицы |
446 | 451 |
447 =back | 452 =back |
448 | 453 |
449 =item C<IMPL::SQL::Traits::RenameTable> | 454 =item C<IMPL::SQL::Schema::Traits::RenameTable> |
450 | 455 |
451 =over | 456 =over |
452 | 457 |
453 =item C<CTOR($tableName,$tableNewName)> | 458 =item C<CTOR($tableName,$tableNewName)> |
454 | 459 |
460 | 465 |
461 Новое имя таблицы | 466 Новое имя таблицы |
462 | 467 |
463 =back | 468 =back |
464 | 469 |
465 =item C<IMPL::SQL::Traits::AlterTableAddColumn> | 470 =item C<IMPL::SQL::Schema::Traits::AlterTableAddColumn> |
466 | 471 |
467 Добавляет столбец в таблицу | 472 Добавляет столбец в таблицу |
468 | 473 |
469 =over | 474 =over |
470 | 475 |
474 | 479 |
475 Имя таблицы в которую нужно добавить столбец | 480 Имя таблицы в которую нужно добавить столбец |
476 | 481 |
477 =item C<[get]column> | 482 =item C<[get]column> |
478 | 483 |
479 C<IMPL::SQL::Traits::Column> - описание столбца который нужно добавить | 484 C<IMPL::SQL::Schema::Traits::Column> - описание столбца который нужно добавить |
480 | 485 |
481 =back | 486 =back |
482 | 487 |
483 =item C<IMPL::SQL::Traits::AlterTableDropColumn> | 488 =item C<IMPL::SQL::Schema::Traits::AlterTableDropColumn> |
484 | 489 |
485 Удаляет столбец из таблицы | 490 Удаляет столбец из таблицы |
486 | 491 |
487 =over | 492 =over |
488 | 493 |
496 | 501 |
497 Имя столбца для удаления | 502 Имя столбца для удаления |
498 | 503 |
499 =back | 504 =back |
500 | 505 |
501 =item C<IMPL::SQL::Traits::AlterTableChangeColumn> | 506 =item C<IMPL::SQL::Schema::Traits::AlterTableChangeColumn> |
502 | 507 |
503 Меняет описание столбца | 508 Меняет описание столбца |
504 | 509 |
505 =over | 510 =over |
506 | 511 |
532 | 537 |
533 Хеш опций, не задан, если опции не меняются | 538 Хеш опций, не задан, если опции не меняются |
534 | 539 |
535 =back | 540 =back |
536 | 541 |
537 =item C<IMPL::SQL::Traits::AlterTableAddConstraint> | 542 =item C<IMPL::SQL::Schema::Traits::AlterTableAddConstraint> |
538 | 543 |
539 Базовый класс для операций по добавлению ограничений | 544 Базовый класс для операций по добавлению ограничений |
540 | 545 |
541 =over | 546 =over |
542 | 547 |
546 | 551 |
547 Имя таблицы в которую добавляется ограничение. | 552 Имя таблицы в которую добавляется ограничение. |
548 | 553 |
549 =item C<[get]constraint> | 554 =item C<[get]constraint> |
550 | 555 |
551 C<IMPL::SQL::Traits::Constraint> - описние ограничения, которое нужно добавить. | 556 C<IMPL::SQL::Schema::Traits::Constraint> - описние ограничения, которое нужно добавить. |
552 | 557 |
553 =back | 558 =back |
554 | 559 |
555 =item C<IMPL::SQL::Traits::AlterTableDropConstraint> | 560 =item C<IMPL::SQL::Schema::Traits::AlterTableDropConstraint> |
556 | 561 |
557 Удаляет ограничение на таблицу | 562 Удаляет ограничение на таблицу |
558 | 563 |
559 =over | 564 =over |
560 | 565 |