|
407
|
1 package IMPL::SQL::Schema::Traits::mysql::Handler;
|
|
|
2 use strict;
|
|
|
3 use parent qw(IMPL::Object);
|
|
|
4 use IMPL::Class::Property;
|
|
|
5
|
|
|
6 BEGIN {
|
|
|
7 public _direct property SqlBatch => prop_all;
|
|
|
8 }
|
|
|
9
|
|
|
10 sub formatTypeNameInteger {
|
|
|
11 my ($type) = @_;
|
|
|
12
|
|
|
13 return $type->Name.($type->MaxLength ? '('.$type->MaxLength.')' : '').($type->Unsigned ? ' UNSIGNED': '').($type->Zerofill ? ' ZEROFILL' : '');
|
|
|
14 }
|
|
|
15
|
|
|
16 sub formatTypeNameReal {
|
|
|
17 my ($type) = @_;
|
|
|
18
|
|
|
19 return $type->Name.($type->MaxLength ? '('.$type->MaxLength.', '.$type->Scale.')' : '').($type->Unsigned ? ' UNSIGNED': '').($type->Zerofill ? ' ZEROFILL' : '');
|
|
|
20 }
|
|
|
21
|
|
|
22 sub formatTypeNameNumeric {
|
|
|
23 my ($type) = @_;
|
|
|
24 $type->MaxLength or die new IMPL::InvalidArgumentException('The length and precission must be specified',$type->Name);
|
|
|
25 return $type->Name.($type->MaxLength ? '('.$type->MaxLength.', '.$type->Scale.')' : '').($type->Unsigned ? ' UNSIGNED': '').($type->Zerofill ? ' ZEROFILL' : '');
|
|
|
26 }
|
|
|
27
|
|
|
28 sub formatTypeName {
|
|
|
29 my ($type) = @_;
|
|
|
30 return $type->Name;
|
|
|
31 }
|
|
|
32
|
|
|
33 sub formatTypeNameChar {
|
|
|
34 my ($type) = @_;
|
|
|
35
|
|
|
36 return (
|
|
|
37 $type->Name.'('.$type->MaxLength.')'. (UNIVERSAL::isa($type,'IMPL::SQL::Schema::Type::mysql::CHAR') ? $type->Encoding : '')
|
|
|
38 );
|
|
|
39 }
|
|
|
40
|
|
|
41 sub formatTypeNameVarChar {
|
|
|
42 my ($type) = @_;
|
|
|
43
|
|
|
44 return (
|
|
|
45 $type->Name.'('.$type->MaxLength.')'. (UNIVERSAL::isa($type,'IMPL::SQL::Schema::Type::mysql::VARCHAR') ? $type->Encoding : '')
|
|
|
46 );
|
|
|
47 }
|
|
|
48
|
|
|
49 sub formatTypeNameEnum {
|
|
|
50 my ($type) = @_;
|
|
|
51 die new Exception('Enum must be a type of either IMPL::SQL::Schema::Type::mysql::ENUM or IMPL::SQL::Schema::Type::mysql::SET') if not (UNIVERSAL::isa($type,'IMPL::SQL::Schema::Type::mysql::ENUM') or UNIVERSAL::isa($type,'IMPL::SQL::Schema::Type::mysql::SET'));
|
|
|
52 return (
|
|
|
53 $type->Name.'('.join(',',map {quote($_)} $type->Values).')'
|
|
|
54 );
|
|
|
55 }
|
|
|
56
|
|
|
57 sub quote{
|
|
|
58 if (wantarray) {
|
|
|
59 return map { my $str=$_; $str=~ s/'/''/g; "'$str'"; } @_;
|
|
|
60 } else {
|
|
|
61 return join '',map { my $str=$_; $str=~ s/'/''/g; "'$str'"; } @_;
|
|
|
62 }
|
|
|
63 }
|
|
|
64
|
|
|
65 sub quote_names {
|
|
|
66 if (wantarray) {
|
|
|
67 return map { my $str=$_; $str=~ s/`/``/g; "`$str`"; } @_;
|
|
|
68 } else {
|
|
|
69 return join '',map { my $str=$_; $str=~ s/`/``/g; "`$str`"; } @_;
|
|
|
70 }
|
|
|
71 }
|
|
|
72
|
|
|
73 sub formatStringValue {
|
|
|
74 my ($value) = @_;
|
|
|
75
|
|
|
76 if (ref $value) {
|
|
|
77 if (UNIVERSAL::isa($value,'IMPL::SQL::Schema::mysql::Expression')) {
|
|
|
78 return $value->as_string;
|
|
|
79 } else {
|
|
|
80 die new Exception('Can\'t format the object as a value',ref $value);
|
|
|
81 }
|
|
|
82 } else {
|
|
|
83 return quote($value);
|
|
|
84 }
|
|
|
85 }
|
|
|
86
|
|
|
87
|
|
|
88 sub formatNumberValue {
|
|
|
89 my ($value) = @_;
|
|
|
90
|
|
|
91 if (ref $value) {
|
|
|
92 if (UNIVERSAL::isa($value,'IMPL::SQL::Schema::mysql::Expression')) {
|
|
|
93 return $value->as_string;
|
|
|
94 } else {
|
|
|
95 die new Exception('Can\'t format the object as a value',ref $value);
|
|
|
96 }
|
|
|
97 } else {
|
|
|
98 $value =~ /^((\+|-)\s*)?\d+(\.\d+)?(e(\+|-)?\d+)?$/ or die new Exception('The specified value isn\'t a valid number',$value);
|
|
|
99 return $value;
|
|
|
100 }
|
|
|
101 }
|
|
|
102
|
|
|
103
|
|
|
104 my %TypesFormat = (
|
|
|
105 TINYINT => {
|
|
|
106 formatType => \&formatTypeNameInteger,
|
|
|
107 formatValue => \&formatNumberValue
|
|
|
108 },
|
|
|
109 SMALLINT => {
|
|
|
110 formatType => \&formatTypeNameInteger,
|
|
|
111 formatValue => \&formatNumberValue
|
|
|
112 },
|
|
|
113 MEDIUMINT => {
|
|
|
114 formatType => \&formatTypeNameInteger,
|
|
|
115 formatValue => \&formatNumberValue
|
|
|
116 },
|
|
|
117 INT => {
|
|
|
118 formatType => \&formatTypeNameInteger,
|
|
|
119 formatValue => \&formatNumberValue
|
|
|
120 },
|
|
|
121 INTEGER => {
|
|
|
122 formatType => \&formatTypeNameInteger,
|
|
|
123 formatValue => \&formatNumberValue
|
|
|
124 },
|
|
|
125 BIGINT => {
|
|
|
126 formatType => \&formatTypeNameInteger,
|
|
|
127 formatValue => \&formatNumberValue
|
|
|
128 },
|
|
|
129 REAL => {
|
|
|
130 formatType => \&formatTypeNameReal,
|
|
|
131 formatValue => \&formatNumberValue
|
|
|
132 },
|
|
|
133 DOUBLE => {
|
|
|
134 formatType => \&formatTypeNameReal,
|
|
|
135 formatValue => \&formatNumberValue
|
|
|
136 },
|
|
|
137 FLOAT => {
|
|
|
138 formatType => \&formatTypeNameReal,
|
|
|
139 formatValue => \&formatNumberValue
|
|
|
140 },
|
|
|
141 DECIMAL => {
|
|
|
142 formatType => \&formatTypeNameNumeric,
|
|
|
143 formatValue => \&formatNumberValue
|
|
|
144 },
|
|
|
145 NUMERIC => {
|
|
|
146 formatType => \&formatTypeNameNumeric,
|
|
|
147 formatValue => \&formatNumberValue
|
|
|
148 },
|
|
|
149 DATE => {
|
|
|
150 formatType => \&formatTypeName,
|
|
|
151 formatValue => \&formatStringValue
|
|
|
152 },
|
|
|
153 TIME => {
|
|
|
154 formatType => \&formatTypeName,
|
|
|
155 formatValue => \&formatStringValue
|
|
|
156 },
|
|
|
157 TIMESTAMP => {
|
|
|
158 formatType => \&formatTypeName,
|
|
|
159 formatValue => \&formatStringValue
|
|
|
160 },
|
|
|
161 DATETIME => {
|
|
|
162 formatType => \&formatTypeName,
|
|
|
163 formatValue => \&formatStringValue
|
|
|
164 },
|
|
|
165 CHAR => {
|
|
|
166 formatType => \&formatTypeNameChar,
|
|
|
167 formatValue => \&formatStringValue
|
|
|
168 },
|
|
|
169 VARCHAR => {
|
|
|
170 formatType => \&formatTypeNameVarChar,
|
|
|
171 formatValue => \&formatStringValue
|
|
|
172 },
|
|
|
173 TINYBLOB => {
|
|
|
174 formatType => \&formatTypeName,
|
|
|
175 formatValue => \&formatStringValue
|
|
|
176 },
|
|
|
177 BLOB => {
|
|
|
178 formatType => \&formatTypeName,
|
|
|
179 formatValue => \&formatStringValue
|
|
|
180 },
|
|
|
181 MEDIUMBLOB => {
|
|
|
182 formatType => \&formatTypeName,
|
|
|
183 formatValue => \&formatStringValue
|
|
|
184 },
|
|
|
185 LONGBLOB => {
|
|
|
186 formatType => \&formatTypeName,
|
|
|
187 formatValue => \&formatStringValue
|
|
|
188 },
|
|
|
189 TINYTEXT => {
|
|
|
190 formatType => \&formatTypeName,
|
|
|
191 formatValue => \&formatStringValue
|
|
|
192 },
|
|
|
193 TEXT => {
|
|
|
194 formatType => \&formatTypeName,
|
|
|
195 formatValue => \&formatStringValue
|
|
|
196 },
|
|
|
197 MEDIUMTEXT => {
|
|
|
198 formatType => \&formatTypeName,
|
|
|
199 formatValue => \&formatStringValue
|
|
|
200 },
|
|
|
201 LONGTEXT => {
|
|
|
202 formatType => \&formatTypeName,
|
|
|
203 formatValue => \&formatStringValue
|
|
|
204 },
|
|
|
205 ENUM => {
|
|
|
206 formatType => \&formatTypeNameEnum,
|
|
|
207 formatValue => \&formatStringValue
|
|
|
208 },
|
|
|
209 SET => {
|
|
|
210 formatType => \&formatTypeNameEnum,
|
|
|
211 formatValue => \&formatStringValue
|
|
|
212 }
|
|
|
213 );
|
|
|
214
|
|
|
215
|
|
|
216 =pod
|
|
|
217 CREATE TABLE 'test'.'New Table' (
|
|
|
218 'dd' INTEGER UNSIGNED NOT NULL AUTO_INCREMENT,
|
|
|
219 `ff` VARCHAR(45) NOT NULL,
|
|
|
220 `ffg` VARCHAR(45) NOT NULL DEFAULT 'aaa',
|
|
|
221 `ddf` INTEGER UNSIGNED NOT NULL,
|
|
|
222 PRIMARY KEY(`dd`),
|
|
|
223 UNIQUE `Index_2`(`ffg`),
|
|
|
224 CONSTRAINT `FK_New Table_1` FOREIGN KEY `FK_New Table_1` (`ddf`)
|
|
|
225 REFERENCES `user` (`id`)
|
|
|
226 ON DELETE RESTRICT
|
|
|
227 ON UPDATE RESTRICT
|
|
|
228 )
|
|
|
229 ENGINE = InnoDB;
|
|
|
230 =cut
|
|
|
231 sub formatCreateTable {
|
|
|
232 my ($table,$level,%options) = @_;
|
|
|
233
|
|
|
234 my @sql;
|
|
|
235
|
|
|
236 # table body
|
|
|
237 push @sql, map { formatColumn($_,$level+1) } @{$table->Columns} ;
|
|
|
238 if ($options{'skip_foreign_keys'}) {
|
|
|
239 push @sql, map { formatConstraint($_,$level+1) } grep {not UNIVERSAL::isa($_,'IMPL::SQL::Schema::Constraint::ForeignKey')} values %{$table->Constraints};
|
|
|
240 } else {
|
|
|
241 push @sql, map { formatConstraint($_,$level+1) } values %{$table->Constraints};
|
|
|
242 }
|
|
|
243
|
|
|
244 for(my $i = 0 ; $i < @sql -1; $i++) {
|
|
|
245 $sql[$i] .= ',';
|
|
|
246 }
|
|
|
247
|
|
|
248 unshift @sql, "CREATE TABLE ".quote_names($table->Name)."(";
|
|
|
249
|
|
|
250 if ($table->Tag) {
|
|
|
251 push @sql, ")";
|
|
|
252 push @sql, formatTableTag($table->Tag,$level);
|
|
|
253 $sql[$#sql].=';';
|
|
|
254 } else {
|
|
|
255 push @sql, ');';
|
|
|
256 }
|
|
|
257
|
|
|
258 return map { (" " x $level) . $_ } @sql;
|
|
|
259 }
|
|
|
260
|
|
|
261 sub formatDropTable {
|
|
|
262 my ($tableName,$level) = @_;
|
|
|
263
|
|
|
264 return " "x$level."DROP TABLE ".quote_names($tableName).";";
|
|
|
265 }
|
|
|
266
|
|
|
267 sub formatTableTag {
|
|
|
268 my ($tag,$level) = @_;
|
|
|
269 return map { " "x$level . "$_ = ".$tag->{$_} } grep {/^(ENGINE)$/i} keys %{$tag};
|
|
|
270 }
|
|
|
271
|
|
|
272 sub formatColumn {
|
|
|
273 my ($column,$level) = @_;
|
|
|
274 $level ||= 0;
|
|
|
275 return " "x$level.quote_names($column->Name)." ".formatType($column->Type)." ".($column->CanBeNull ? 'NULL' : 'NOT NULL').($column->DefaultValue ? formatValueToType($column->DefaultValue,$column->Type) : '' ).($column->Tag ? ' '.join(' ',$column->Tag) : '');
|
|
|
276 }
|
|
|
277
|
|
|
278 sub formatType {
|
|
|
279 my ($type) = @_;
|
|
|
280 my $format = $TypesFormat{uc $type->Name} or die new Exception('The unknown type name',$type->Name);
|
|
|
281 $format->{formatType}->($type);
|
|
|
282 }
|
|
|
283
|
|
|
284 sub formatValueToType {
|
|
|
285 my ($value,$type) = @_;
|
|
|
286
|
|
|
287 my $format = $TypesFormat{uc $type->Name} or die new Exception('The unknown type name',$type->Name);
|
|
|
288 $format->{formatValue}->($value);
|
|
|
289 }
|
|
|
290
|
|
|
291 sub formatConstraint {
|
|
|
292 my ($constraint,$level) = @_;
|
|
|
293
|
|
|
294 if (UNIVERSAL::isa($constraint,'IMPL::SQL::Schema::Constraint::ForeignKey')) {
|
|
|
295 return formatForeignKey($constraint,$level);
|
|
|
296 } else {
|
|
|
297 return formatIndex($constraint, $level);
|
|
|
298 }
|
|
|
299 }
|
|
|
300
|
|
|
301 sub formatIndex {
|
|
|
302 my ($constraint,$level) = @_;
|
|
|
303
|
|
|
304 my $name = quote_names($constraint->Name);
|
|
|
305 my $columns = join(',',map quote_names($_->Name),@{$constraint->Columns});
|
|
|
306
|
|
|
307 if (ref $constraint eq 'IMPL::SQL::Schema::Constraint::PrimaryKey') {
|
|
|
308 return " "x$level."PRIMARY KEY ($columns)";
|
|
|
309 } elsif ($constraint eq 'IMPL::SQL::Schema::Constraint::Unique') {
|
|
|
310 return " "x$level."UNIQUE $name ($columns)";
|
|
|
311 } elsif ($constraint eq 'IMPL::SQL::Schema::Constraint::Index') {
|
|
|
312 return " "x$level."INDEX $name ($columns)";
|
|
|
313 } else {
|
|
|
314 die new IMPL::InvalidArgumentException('The unknown constraint', ref $constraint);
|
|
|
315 }
|
|
|
316
|
|
|
317 }
|
|
|
318
|
|
|
319 sub formatForeignKey {
|
|
|
320 my ($constraint,$level) = @_;
|
|
|
321
|
|
|
322 my $name = quote_names($constraint->Name);
|
|
|
323 my $columns = join(',',map quote_names($_->Name),@{$constraint->Columns});
|
|
|
324
|
|
|
325 not $constraint->OnDelete or grep { uc $constraint->OnDelete eq $_ } ('RESTRICT','CASCADE','SET NULL','NO ACTION','SET DEFAULT') or die new IMPL::Exception('Invalid ON DELETE reference',$constraint->OnDelete);
|
|
|
326 not $constraint->OnUpdate or grep { uc $constraint->OnUpdate eq $_ } ('RESTRICT','CASCADE','SET NULL','NO ACTION','SET DEFAULT') or die new IMPL::Exception('Invalid ON UPDATE reference',$constraint->OnUpdate);
|
|
|
327
|
|
|
328 my $refname = quote_names($constraint->ReferencedPrimaryKey->Table->Name);
|
|
|
329 my $refcolumns = join(',',map quote_names($_->Name),@{$constraint->ReferencedPrimaryKey->Columns});
|
|
|
330 return (
|
|
|
331 " "x$level.
|
|
|
332 "CONSTRAINT $name FOREIGN KEY $name ($columns) REFERENCES $refname ($refcolumns)".
|
|
|
333 ($constraint->OnUpdate ? 'ON UPDATE'.$constraint->OnUpdate : '').
|
|
|
334 ($constraint->OnDelete ? 'ON DELETE'.$constraint->OnDelete : '')
|
|
|
335 );
|
|
|
336 }
|
|
|
337
|
|
|
338 sub formatAlterTableRename {
|
|
|
339 my ($oldName,$newName,$level) = @_;
|
|
|
340
|
|
|
341 return " "x$level."ALTER TABLE ".quote_names($oldName)." RENAME TO ".quote_names($newName).";";
|
|
|
342 }
|
|
|
343
|
|
|
344 sub formatAlterTableDropColumn {
|
|
|
345 my ($tableName, $columnName,$level) = @_;
|
|
|
346
|
|
|
347 return " "x$level."ALTER TABLE ".quote_names($tableName)." DROP COLUMN ".quote_names($columnName).";";
|
|
|
348 }
|
|
|
349
|
|
|
350 =pod
|
|
|
351 ALTER TABLE `test`.`user` ADD COLUMN `my_col` VARCHAR(45) NOT NULL AFTER `name2`
|
|
|
352 =cut
|
|
|
353 sub formatAlterTableAddColumn {
|
|
|
354 my ($tableName, $column, $table, $pos, $level) = @_;
|
|
|
355
|
|
|
356 my $posSpec = $pos == 0 ? 'FIRST' : 'AFTER '.quote_names($table->ColumnAt($pos-1)->Name);
|
|
|
357
|
|
|
358 return " "x$level."ALTER TABLE ".quote_names($tableName)." ADD COLUMN ".formatColumn($column) .' '. $posSpec.";";
|
|
|
359 }
|
|
|
360
|
|
|
361 =pod
|
|
|
362 ALTER TABLE `test`.`manager` MODIFY COLUMN `description` VARCHAR(256) NOT NULL DEFAULT NULL;
|
|
|
363 =cut
|
|
|
364 sub formatAlterTableChangeColumn {
|
|
|
365 my ($tableName,$column,$table,$pos,$level) = @_;
|
|
|
366 my $posSpec = $pos == 0 ? 'FIRST' : 'AFTER '.quote_names($table->ColumnAt($pos-1)->Name);
|
|
|
367 return " "x$level."ALTER TABLE ".quote_names($tableName)." MODIFY COLUMN ".formatColumn($column).' '. $posSpec.";";
|
|
|
368 }
|
|
|
369
|
|
|
370 =pod
|
|
|
371 ALTER TABLE `test`.`manager` DROP INDEX `Index_2`;
|
|
|
372 =cut
|
|
|
373 sub formatAlterTableDropConstraint {
|
|
|
374 my ($tableName,$constraint,$level) = @_;
|
|
|
375 my $constraintName;
|
|
|
376 if (ref $constraint eq 'IMPL::SQL::Schema::Constraint::PrimaryKey') {
|
|
|
377 $constraintName = 'PRIMARY KEY';
|
|
|
378 } elsif (ref $constraint eq 'IMPL::SQL::Schema::Constraint::ForeignKey') {
|
|
|
379 $constraintName = 'FOREIGN KEY '.quote_names($constraint->Name);
|
|
|
380 } elsif (UNIVERSAL::isa($constraint,'IMPL::SQL::Schema::Constraint::Index')) {
|
|
|
381 $constraintName = 'INDEX '.quote_names($constraint->Name);
|
|
|
382 } else {
|
|
|
383 die new IMPL::Exception("The unknow type of the constraint",ref $constraint);
|
|
|
384 }
|
|
|
385 return " "x$level."ALTER TABLE ".quote_names($tableName)." DROP $constraintName;";
|
|
|
386 }
|
|
|
387
|
|
|
388 =pod
|
|
|
389 ALTER TABLE `test`.`session` ADD INDEX `Index_2`(`id`, `name`);
|
|
|
390 =cut
|
|
|
391 sub formatAlterTableAddConstraint {
|
|
|
392 my ($tableName,$constraint,$level) = @_;
|
|
|
393
|
|
|
394 return " "x$level."ALTER TABLE ".quote_names($tableName)." ADD ".formatConstraint($constraint,0).';';
|
|
|
395 }
|
|
|
396
|
|
|
397 sub CreateTable {
|
|
|
398 my ($this,$tbl,%option) = @_;
|
|
|
399
|
|
|
400 push @{$this->{$SqlBatch}},join("\n",formatCreateTable($tbl,0,%option));
|
|
|
401
|
|
|
402 return 1;
|
|
|
403 }
|
|
|
404
|
|
|
405 sub DropTable {
|
|
|
406 my ($this,$tbl) = @_;
|
|
|
407
|
|
|
408 push @{$this->{$SqlBatch}},join("\n",formatDropTable($tbl,0));
|
|
|
409
|
|
|
410 return 1;
|
|
|
411 }
|
|
|
412
|
|
|
413 sub RenameTable {
|
|
|
414 my ($this,$oldName,$newName) = @_;
|
|
|
415
|
|
|
416 push @{$this->{$SqlBatch}},join("\n",formatAlterTableRename($oldName,$newName,0));
|
|
|
417
|
|
|
418 return 1;
|
|
|
419 }
|
|
|
420
|
|
|
421 sub AlterTableAddColumn {
|
|
|
422 my ($this,$tblName,$column,$table,$pos) = @_;
|
|
|
423
|
|
|
424 push @{$this->{$SqlBatch}},join("\n",formatAlterTableAddColumn($tblName,$column,$table,$pos,0));
|
|
|
425
|
|
|
426 return 1;
|
|
|
427 }
|
|
|
428 sub AlterTableDropColumn {
|
|
|
429 my ($this,$tblName,$columnName) = @_;
|
|
|
430
|
|
|
431 push @{$this->{$SqlBatch}},join("\n",formatAlterTableDropColumn($tblName,$columnName,0));
|
|
|
432
|
|
|
433 return 1;
|
|
|
434 }
|
|
|
435
|
|
|
436 sub AlterTableChangeColumn {
|
|
|
437 my ($this,$tblName,$column,$table,$pos) = @_;
|
|
|
438
|
|
|
439 push @{$this->{$SqlBatch}},join("\n",formatAlterTableChangeColumn($tblName,$column,$table,$pos,0));
|
|
|
440
|
|
|
441 return 1;
|
|
|
442 }
|
|
|
443
|
|
|
444 sub AlterTableAddConstraint {
|
|
|
445 my ($this,$tblName,$constraint) = @_;
|
|
|
446
|
|
|
447 push @{$this->{$SqlBatch}},join("\n",formatAlterTableAddConstraint($tblName,$constraint,0));
|
|
|
448
|
|
|
449 return 1;
|
|
|
450 }
|
|
|
451
|
|
|
452 sub AlterTableDropConstraint {
|
|
|
453 my ($this,$tblName,$constraint) = @_;
|
|
|
454
|
|
|
455 push @{$this->{$SqlBatch}},join("\n",formatAlterTableDropConstraint($tblName,$constraint,0));
|
|
|
456
|
|
|
457 return 1;
|
|
|
458 }
|
|
|
459
|
|
|
460 sub Sql {
|
|
|
461 my ($this) = @_;
|
|
|
462 if (wantarray) {
|
|
|
463 @{$this->SqlBatch || []};
|
|
|
464 } else {
|
|
|
465 return join("\n",$this->SqlBatch);
|
|
|
466 }
|
|
|
467 }
|
|
|
468
|
|
|
469 package IMPL::SQL::Schema::Traits::mysql;
|
|
|
470 use parent qw(IMPL::SQL::Schema::Traits);
|
|
|
471 use IMPL::Class::Property;
|
|
|
472
|
|
|
473 BEGIN {
|
|
|
474 public _direct property PendingConstraints => prop_none;
|
|
|
475 }
|
|
|
476
|
|
|
477 our %CTOR = (
|
|
|
478 'IMPL::SQL::Schema::Traits' => sub {
|
|
|
479 my %args = @_;
|
|
|
480 $args{'Handler'} = new IMPL::SQL::Schema::Traits::mysql::Handler;
|
|
|
481 %args;
|
|
|
482 }
|
|
|
483 );
|
|
|
484
|
|
|
485 sub DropConstraint {
|
|
|
486 my ($this,$constraint) = @_;
|
|
|
487
|
|
|
488 if (UNIVERSAL::isa($constraint,'IMPL::SQL::Schema::Constraint::Index')) {
|
|
|
489 return 1 if not grep { $this->TableInfo->{$this->MapTableName($constraint->Table->Name)}->{'Columns'}->{$_->Name} != IMPL::SQL::Schema::Traits::STATE_REMOVED} $constraint->Columns;
|
|
|
490 my @constraints = grep {$_ != $constraint } $constraint->Table->GetColumnConstraints($constraint->Columns);
|
|
|
491 if (scalar @constraints == 1 and UNIVERSAL::isa($constraints[0],'IMPL::SQL::Schema::Constraint::ForeignKey')) {
|
|
|
492 my $fk = shift @constraints;
|
|
|
493 if ($this->TableInfo->{$this->MapTableName($fk->Table->Name)}->{'Constraints'}->{$fk->Name} != IMPL::SQL::Schema::Traits::STATE_REMOVED) {
|
|
|
494 push @{$this->PendingActions}, {Action => \&DropConstraint, Args => [$constraint]};
|
|
|
495 $this->{$PendingConstraints}->{$constraint->UniqName}->{'attempts'} ++;
|
|
|
496
|
|
|
497 die new IMPL::Exception('Can\'t drop the primary key becouse of the foreing key',$fk->UniqName) if $this->{$PendingConstraints}->{$constraint->UniqName}->{'attempts'} > 2;
|
|
|
498 return 2;
|
|
|
499 }
|
|
|
500 }
|
|
|
501 }
|
|
|
502 $this->SUPER::DropConstraint($constraint);
|
|
|
503 }
|
|
|
504
|
|
|
505 sub GetMetaTable {
|
|
|
506 my ($class,$dbh) = @_;
|
|
|
507
|
|
|
508 return IMPL::SQL::Schema::Traits::mysql::MetaTable->new( DBHandle => $dbh);
|
|
|
509 }
|
|
|
510
|
|
|
511 package IMPL::SQL::Schema::Traits::mysql::MetaTable;
|
|
|
512 use parent qw(IMPL::Object);
|
|
|
513 use IMPL::Class::Property;
|
|
|
514
|
|
|
515 BEGIN {
|
|
|
516 public _direct property DBHandle => prop_none;
|
|
|
517 }
|
|
|
518
|
|
|
519 sub ReadProperty {
|
|
|
520 my ($this,$name) = @_;
|
|
|
521
|
|
|
522 local $this->{$DBHandle}->{PrintError};
|
|
|
523 $this->{$DBHandle}->{PrintError} = 0;
|
|
|
524 my ($val) = $this->{$DBHandle}->selectrow_array("SELECT value FROM _Meta WHERE name like ?", undef, $name);
|
|
|
525 return $val;
|
|
|
526 }
|
|
|
527
|
|
|
528 sub SetProperty {
|
|
|
529 my ($this,$name,$val) = @_;
|
|
|
530
|
|
|
531 if ( $this->{$DBHandle}->selectrow_arrayref("SELECT TABLE_NAME FROM information_schema.`TABLES` T where TABLE_SCHEMA like DATABASE() and TABLE_NAME like '_Meta'")) {
|
|
|
532 if ($this->{$DBHandle}->selectrow_arrayref("SELECT name FROM _Meta WHERE name like ?", undef, $name)) {
|
|
|
533 $this->{$DBHandle}->do("UPDATE _Meta SET value = ? WHERE name like ?",undef,$val,$name);
|
|
|
534 } else {
|
|
|
535 $this->{$DBHandle}->do("INSERT INTO _Meta(name,value) VALUES ('$name',?)",undef,$val);
|
|
|
536 }
|
|
|
537 } else {
|
|
|
538 $this->{$DBHandle}->do(q{
|
|
|
539 CREATE TABLE `_Meta` (
|
|
|
540 `name` VARCHAR(255) NOT NULL,
|
|
|
541 `value` LONGTEXT NULL,
|
|
|
542 PRIMARY KEY(`name`)
|
|
|
543 );
|
|
|
544 }) or die new IMPL::Exception("Failed to create table","_Meta");
|
|
|
545
|
|
|
546 $this->{$DBHandle}->do("INSERT INTO _Meta(name,value) VALUES (?,?)",undef,$name,$val);
|
|
|
547 }
|
|
|
548 }
|
|
|
549
|
|
|
550 1;
|
