Mercurial > pub > Impl

comparison Lib/IMPL/SQL/Schema/Traits.pm @ 165:76515373dac0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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