Mercurial > pub > Impl

comparison Lib/IMPL/SQL/Schema/Traits/mysql.pm @ 32:56cef8e3cda6

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