Mercurial > pub > Impl

comparison lib/IMPL/SQL/Schema/Traits/mysql.pm @ 407:c6e90e02dd17 ref20150831

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
renamed Lib->lib
author cin
date Fri, 04 Sep 2015 19:40:23 +0300
parents
children
comparison
equal deleted inserted replaced
406:f23fcb19d3c1 407:c6e90e02dd17
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;