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;