49
+ − 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_all;
+ − 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 our %CTOR = (
+ − 481 'IMPL::SQL::Schema::Traits' => sub {
+ − 482 my %args = @_;
+ − 483 $args{'Handler'} = new IMPL::SQL::Schema::Traits::mysql::Handler;
+ − 484 %args;
+ − 485 }
+ − 486 );
+ − 487
+ − 488 sub DropConstraint {
+ − 489 my ($this,$constraint) = @_;
+ − 490
+ − 491 if (UNIVERSAL::isa($constraint,'IMPL::SQL::Schema::Constraint::Index')) {
+ − 492 return 1 if not grep { $this->TableInfo->{$this->MapTableName($constraint->Table->Name)}->{'Columns'}->{$_->Name} != IMPL::SQL::Schema::Traits::STATE_REMOVED} $constraint->Columns;
+ − 493 my @constraints = grep {$_ != $constraint } $constraint->Table->GetColumnConstraints($constraint->Columns);
+ − 494 if (scalar @constraints == 1 and UNIVERSAL::isa($constraints[0],'IMPL::SQL::Schema::Constraint::ForeignKey')) {
+ − 495 my $fk = shift @constraints;
+ − 496 if ($this->TableInfo->{$this->MapTableName($fk->Table->Name)}->{'Constraints'}->{$fk->Name} != IMPL::SQL::Schema::Traits::STATE_REMOVED) {
+ − 497 push @{$this->PendingActions}, {Action => \&DropConstraint, Args => [$constraint]};
+ − 498 $this->{$PendingConstraints}->{$constraint->UniqName}->{'attempts'} ++;
+ − 499
+ − 500 die new IMPL::Exception('Can\'t drop the primary key becouse of the foreing key',$fk->UniqName) if $this->{$PendingConstraints}->{$constraint->UniqName}->{'attempts'} > 2;
+ − 501 return 2;
+ − 502 }
+ − 503 }
+ − 504 }
+ − 505 $this->SUPER::DropConstraint($constraint);
+ − 506 }
+ − 507
+ − 508 sub GetMetaTable {
+ − 509 my ($class,$dbh) = @_;
+ − 510
+ − 511 return IMPL::SQL::Schema::Traits::mysql::MetaTable->new( DBHandle => $dbh);
+ − 512 }
+ − 513
+ − 514 package IMPL::SQL::Schema::Traits::mysql::MetaTable;
+ − 515 use Common;
+ − 516 use base qw(IMPL::Object);
+ − 517 use IMPL::Class::Property;
+ − 518 use IMPL::Class::Property::Direct;
+ − 519
+ − 520 BEGIN {
+ − 521 public _direct property DBHandle => prop_none;
+ − 522 }
+ − 523
+ − 524 sub ReadProperty {
+ − 525 my ($this,$name) = @_;
+ − 526
+ − 527 local $this->{$DBHandle}->{PrintError};
+ − 528 $this->{$DBHandle}->{PrintError} = 0;
+ − 529 my ($val) = $this->{$DBHandle}->selectrow_array("SELECT value FROM _Meta WHERE name like ?", undef, $name);
+ − 530 return $val;
+ − 531 }
+ − 532
+ − 533 sub SetProperty {
+ − 534 my ($this,$name,$val) = @_;
+ − 535
+ − 536 if ( $this->{$DBHandle}->selectrow_arrayref("SELECT TABLE_NAME FROM information_schema.`TABLES` T where TABLE_SCHEMA like DATABASE() and TABLE_NAME like '_Meta'")) {
+ − 537 if ($this->{$DBHandle}->selectrow_arrayref("SELECT name FROM _Meta WHERE name like ?", undef, $name)) {
+ − 538 $this->{$DBHandle}->do("UPDATE _Meta SET value = ? WHERE name like ?",undef,$val,$name);
+ − 539 } else {
+ − 540 $this->{$DBHandle}->do("INSERT INTO _Meta(name,value) VALUES ('$name',?)",undef,$val);
+ − 541 }
+ − 542 } else {
+ − 543 $this->{$DBHandle}->do(q{
+ − 544 CREATE TABLE `_Meta` (
+ − 545 `name` VARCHAR(255) NOT NULL,
+ − 546 `value` LONGTEXT NULL,
+ − 547 PRIMARY KEY(`name`)
+ − 548 );
+ − 549 }) or die new IMPL::Exception("Failed to create table","_Meta");
+ − 550
+ − 551 $this->{$DBHandle}->do("INSERT INTO _Meta(name,value) VALUES (?,?)",undef,$name,$val);
+ − 552 }
+ − 553 }
+ − 554
+ − 555 1;