Mercurial > pub > Impl
diff Lib/IMPL/SQL/Schema/Traits/mysql.pm @ 49:16ada169ca75
migrating to the Eclipse IDE
author | wizard@linux-odin.local |
---|---|
date | Fri, 26 Feb 2010 10:49:21 +0300 |
parents | 32d2350fccf9 |
children | 76515373dac0 |
line wrap: on
line diff
--- a/Lib/IMPL/SQL/Schema/Traits/mysql.pm Fri Feb 26 01:43:42 2010 +0300 +++ b/Lib/IMPL/SQL/Schema/Traits/mysql.pm Fri Feb 26 10:49:21 2010 +0300 @@ -1,555 +1,555 @@ -package IMPL::SQL::Schema::Traits::mysql::Handler; -use strict; -use base qw(IMPL::Object); -use IMPL::Class::Property; -use IMPL::Class::Property::Direct; - -BEGIN { - public _direct property SqlBatch => prop_all; -} - -sub formatTypeNameInteger { - my ($type) = @_; - - return $type->Name.($type->MaxLength ? '('.$type->MaxLength.')' : '').($type->Unsigned ? ' UNSIGNED': '').($type->Zerofill ? ' ZEROFILL' : ''); -} - -sub formatTypeNameReal { - my ($type) = @_; - - return $type->Name.($type->MaxLength ? '('.$type->MaxLength.', '.$type->Scale.')' : '').($type->Unsigned ? ' UNSIGNED': '').($type->Zerofill ? ' ZEROFILL' : ''); -} - -sub formatTypeNameNumeric { - my ($type) = @_; - $type->MaxLength or die new IMPL::InvalidArgumentException('The length and precission must be specified',$type->Name); - return $type->Name.($type->MaxLength ? '('.$type->MaxLength.', '.$type->Scale.')' : '').($type->Unsigned ? ' UNSIGNED': '').($type->Zerofill ? ' ZEROFILL' : ''); -} - -sub formatTypeName { - my ($type) = @_; - return $type->Name; -} - -sub formatTypeNameChar { - my ($type) = @_; - - return ( - $type->Name.'('.$type->MaxLength.')'. (UNIVERSAL::isa($type,'IMPL::SQL::Schema::Type::mysql::CHAR') ? $type->Encoding : '') - ); -} - -sub formatTypeNameVarChar { - my ($type) = @_; - - return ( - $type->Name.'('.$type->MaxLength.')'. (UNIVERSAL::isa($type,'IMPL::SQL::Schema::Type::mysql::VARCHAR') ? $type->Encoding : '') - ); -} - -sub formatTypeNameEnum { - my ($type) = @_; - 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')); - return ( - $type->Name.'('.join(',',map {quote($_)} $type->Values).')' - ); -} - -sub quote{ - if (wantarray) { - return map { my $str=$_; $str=~ s/'/''/g; "'$str'"; } @_; - } else { - return join '',map { my $str=$_; $str=~ s/'/''/g; "'$str'"; } @_; - } -} - -sub quote_names { - if (wantarray) { - return map { my $str=$_; $str=~ s/`/``/g; "`$str`"; } @_; - } else { - return join '',map { my $str=$_; $str=~ s/`/``/g; "`$str`"; } @_; - } -} - -sub formatStringValue { - my ($value) = @_; - - if (ref $value) { - if (UNIVERSAL::isa($value,'IMPL::SQL::Schema::mysql::Expression')) { - return $value->as_string; - } else { - die new Exception('Can\'t format the object as a value',ref $value); - } - } else { - return quote($value); - } -} - - -sub formatNumberValue { - my ($value) = @_; - - if (ref $value) { - if (UNIVERSAL::isa($value,'IMPL::SQL::Schema::mysql::Expression')) { - return $value->as_string; - } else { - die new Exception('Can\'t format the object as a value',ref $value); - } - } else { - $value =~ /^((\+|-)\s*)?\d+(\.\d+)?(e(\+|-)?\d+)?$/ or die new Exception('The specified value isn\'t a valid number',$value); - return $value; - } -} - - -my %TypesFormat = ( - TINYINT => { - formatType => \&formatTypeNameInteger, - formatValue => \&formatNumberValue - }, - SMALLINT => { - formatType => \&formatTypeNameInteger, - formatValue => \&formatNumberValue - }, - MEDIUMINT => { - formatType => \&formatTypeNameInteger, - formatValue => \&formatNumberValue - }, - INT => { - formatType => \&formatTypeNameInteger, - formatValue => \&formatNumberValue - }, - INTEGER => { - formatType => \&formatTypeNameInteger, - formatValue => \&formatNumberValue - }, - BIGINT => { - formatType => \&formatTypeNameInteger, - formatValue => \&formatNumberValue - }, - REAL => { - formatType => \&formatTypeNameReal, - formatValue => \&formatNumberValue - }, - DOUBLE => { - formatType => \&formatTypeNameReal, - formatValue => \&formatNumberValue - }, - FLOAT => { - formatType => \&formatTypeNameReal, - formatValue => \&formatNumberValue - }, - DECIMAL => { - formatType => \&formatTypeNameNumeric, - formatValue => \&formatNumberValue - }, - NUMERIC => { - formatType => \&formatTypeNameNumeric, - formatValue => \&formatNumberValue - }, - DATE => { - formatType => \&formatTypeName, - formatValue => \&formatStringValue - }, - TIME => { - formatType => \&formatTypeName, - formatValue => \&formatStringValue - }, - TIMESTAMP => { - formatType => \&formatTypeName, - formatValue => \&formatStringValue - }, - DATETIME => { - formatType => \&formatTypeName, - formatValue => \&formatStringValue - }, - CHAR => { - formatType => \&formatTypeNameChar, - formatValue => \&formatStringValue - }, - VARCHAR => { - formatType => \&formatTypeNameVarChar, - formatValue => \&formatStringValue - }, - TINYBLOB => { - formatType => \&formatTypeName, - formatValue => \&formatStringValue - }, - BLOB => { - formatType => \&formatTypeName, - formatValue => \&formatStringValue - }, - MEDIUMBLOB => { - formatType => \&formatTypeName, - formatValue => \&formatStringValue - }, - LONGBLOB => { - formatType => \&formatTypeName, - formatValue => \&formatStringValue - }, - TINYTEXT => { - formatType => \&formatTypeName, - formatValue => \&formatStringValue - }, - TEXT => { - formatType => \&formatTypeName, - formatValue => \&formatStringValue - }, - MEDIUMTEXT => { - formatType => \&formatTypeName, - formatValue => \&formatStringValue - }, - LONGTEXT => { - formatType => \&formatTypeName, - formatValue => \&formatStringValue - }, - ENUM => { - formatType => \&formatTypeNameEnum, - formatValue => \&formatStringValue - }, - SET => { - formatType => \&formatTypeNameEnum, - formatValue => \&formatStringValue - } -); - - -=pod -CREATE TABLE 'test'.'New Table' ( - 'dd' INTEGER UNSIGNED NOT NULL AUTO_INCREMENT, - `ff` VARCHAR(45) NOT NULL, - `ffg` VARCHAR(45) NOT NULL DEFAULT 'aaa', - `ddf` INTEGER UNSIGNED NOT NULL, - PRIMARY KEY(`dd`), - UNIQUE `Index_2`(`ffg`), - CONSTRAINT `FK_New Table_1` FOREIGN KEY `FK_New Table_1` (`ddf`) - REFERENCES `user` (`id`) - ON DELETE RESTRICT - ON UPDATE RESTRICT -) -ENGINE = InnoDB; -=cut -sub formatCreateTable { - my ($table,$level,%options) = @_; - - my @sql; - - # table body - push @sql, map { formatColumn($_,$level+1) } @{$table->Columns} ; - if ($options{'skip_foreign_keys'}) { - push @sql, map { formatConstraint($_,$level+1) } grep {not UNIVERSAL::isa($_,'IMPL::SQL::Schema::Constraint::ForeignKey')} values %{$table->Constraints}; - } else { - push @sql, map { formatConstraint($_,$level+1) } values %{$table->Constraints}; - } - - for(my $i = 0 ; $i < @sql -1; $i++) { - $sql[$i] .= ','; - } - - unshift @sql, "CREATE TABLE ".quote_names($table->Name)."("; - - if ($table->Tag) { - push @sql, ")"; - push @sql, formatTableTag($table->Tag,$level); - $sql[$#sql].=';'; - } else { - push @sql, ');'; - } - - return map { ("\t" x $level) . $_ } @sql; -} - -sub formatDropTable { - my ($tableName,$level) = @_; - - return "\t"x$level."DROP TABLE ".quote_names($tableName).";"; -} - -sub formatTableTag { - my ($tag,$level) = @_; - return map { "\t"x$level . "$_ = ".$tag->{$_} } grep {/^(ENGINE)$/i} keys %{$tag}; -} - -sub formatColumn { - my ($column,$level) = @_; - $level ||= 0; - 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) : ''); -} - -sub formatType { - my ($type) = @_; - my $format = $TypesFormat{uc $type->Name} or die new Exception('The unknown type name',$type->Name); - $format->{formatType}->($type); -} - -sub formatValueToType { - my ($value,$type) = @_; - - my $format = $TypesFormat{uc $type->Name} or die new Exception('The unknown type name',$type->Name); - $format->{formatValue}->($value); -} - -sub formatConstraint { - my ($constraint,$level) = @_; - - if (UNIVERSAL::isa($constraint,'IMPL::SQL::Schema::Constraint::ForeignKey')) { - return formatForeignKey($constraint,$level); - } else { - return formatIndex($constraint, $level); - } -} - -sub formatIndex { - my ($constraint,$level) = @_; - - my $name = quote_names($constraint->Name); - my $columns = join(',',map quote_names($_->Name),@{$constraint->Columns}); - - if (ref $constraint eq 'IMPL::SQL::Schema::Constraint::PrimaryKey') { - return "\t"x$level."PRIMARY KEY ($columns)"; - } elsif ($constraint eq 'IMPL::SQL::Schema::Constraint::Unique') { - return "\t"x$level."UNIQUE $name ($columns)"; - } elsif ($constraint eq 'IMPL::SQL::Schema::Constraint::Index') { - return "\t"x$level."INDEX $name ($columns)"; - } else { - die new IMPL::InvalidArgumentException('The unknown constraint', ref $constraint); - } - -} - -sub formatForeignKey { - my ($constraint,$level) = @_; - - my $name = quote_names($constraint->Name); - my $columns = join(',',map quote_names($_->Name),@{$constraint->Columns}); - - 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); - 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); - - my $refname = quote_names($constraint->ReferencedPrimaryKey->Table->Name); - my $refcolumns = join(',',map quote_names($_->Name),@{$constraint->ReferencedPrimaryKey->Columns}); - return ( - "\t"x$level. - "CONSTRAINT $name FOREIGN KEY $name ($columns) REFERENCES $refname ($refcolumns)". - ($constraint->OnUpdate ? 'ON UPDATE'.$constraint->OnUpdate : ''). - ($constraint->OnDelete ? 'ON DELETE'.$constraint->OnDelete : '') - ); -} - -sub formatAlterTableRename { - my ($oldName,$newName,$level) = @_; - - return "\t"x$level."ALTER TABLE ".quote_names($oldName)." RENAME TO ".quote_names($newName).";"; -} - -sub formatAlterTableDropColumn { - my ($tableName, $columnName,$level) = @_; - - return "\t"x$level."ALTER TABLE ".quote_names($tableName)." DROP COLUMN ".quote_names($columnName).";"; -} - -=pod -ALTER TABLE `test`.`user` ADD COLUMN `my_col` VARCHAR(45) NOT NULL AFTER `name2` -=cut -sub formatAlterTableAddColumn { - my ($tableName, $column, $table, $pos, $level) = @_; - - my $posSpec = $pos == 0 ? 'FIRST' : 'AFTER '.quote_names($table->ColumnAt($pos-1)->Name); - - return "\t"x$level."ALTER TABLE ".quote_names($tableName)." ADD COLUMN ".formatColumn($column) .' '. $posSpec.";"; -} - -=pod -ALTER TABLE `test`.`manager` MODIFY COLUMN `description` VARCHAR(256) NOT NULL DEFAULT NULL; -=cut -sub formatAlterTableChangeColumn { - my ($tableName,$column,$table,$pos,$level) = @_; - my $posSpec = $pos == 0 ? 'FIRST' : 'AFTER '.quote_names($table->ColumnAt($pos-1)->Name); - return "\t"x$level."ALTER TABLE ".quote_names($tableName)." MODIFY COLUMN ".formatColumn($column).' '. $posSpec.";"; -} - -=pod -ALTER TABLE `test`.`manager` DROP INDEX `Index_2`; -=cut -sub formatAlterTableDropConstraint { - my ($tableName,$constraint,$level) = @_; - my $constraintName; - if (ref $constraint eq 'IMPL::SQL::Schema::Constraint::PrimaryKey') { - $constraintName = 'PRIMARY KEY'; - } elsif (ref $constraint eq 'IMPL::SQL::Schema::Constraint::ForeignKey') { - $constraintName = 'FOREIGN KEY '.quote_names($constraint->Name); - } elsif (UNIVERSAL::isa($constraint,'IMPL::SQL::Schema::Constraint::Index')) { - $constraintName = 'INDEX '.quote_names($constraint->Name); - } else { - die new IMPL::Exception("The unknow type of the constraint",ref $constraint); - } - return "\t"x$level."ALTER TABLE ".quote_names($tableName)." DROP $constraintName;"; -} - -=pod -ALTER TABLE `test`.`session` ADD INDEX `Index_2`(`id`, `name`); -=cut -sub formatAlterTableAddConstraint { - my ($tableName,$constraint,$level) = @_; - - return "\t"x$level."ALTER TABLE ".quote_names($tableName)." ADD ".formatConstraint($constraint,0).';'; -} - -sub CreateTable { - my ($this,$tbl,%option) = @_; - - push @{$this->{$SqlBatch}},join("\n",formatCreateTable($tbl,0,%option)); - - return 1; -} - -sub DropTable { - my ($this,$tbl) = @_; - - push @{$this->{$SqlBatch}},join("\n",formatDropTable($tbl,0)); - - return 1; -} - -sub RenameTable { - my ($this,$oldName,$newName) = @_; - - push @{$this->{$SqlBatch}},join("\n",formatAlterTableRename($oldName,$newName,0)); - - return 1; -} - -sub AlterTableAddColumn { - my ($this,$tblName,$column,$table,$pos) = @_; - - push @{$this->{$SqlBatch}},join("\n",formatAlterTableAddColumn($tblName,$column,$table,$pos,0)); - - return 1; -} -sub AlterTableDropColumn { - my ($this,$tblName,$columnName) = @_; - - push @{$this->{$SqlBatch}},join("\n",formatAlterTableDropColumn($tblName,$columnName,0)); - - return 1; -} - -sub AlterTableChangeColumn { - my ($this,$tblName,$column,$table,$pos) = @_; - - push @{$this->{$SqlBatch}},join("\n",formatAlterTableChangeColumn($tblName,$column,$table,$pos,0)); - - return 1; -} - -sub AlterTableAddConstraint { - my ($this,$tblName,$constraint) = @_; - - push @{$this->{$SqlBatch}},join("\n",formatAlterTableAddConstraint($tblName,$constraint,0)); - - return 1; -} - -sub AlterTableDropConstraint { - my ($this,$tblName,$constraint) = @_; - - push @{$this->{$SqlBatch}},join("\n",formatAlterTableDropConstraint($tblName,$constraint,0)); - - return 1; -} - -sub Sql { - my ($this) = @_; - if (wantarray) { - @{$this->SqlBatch || []}; - } else { - return join("\n",$this->SqlBatch); - } -} - -package IMPL::SQL::Schema::Traits::mysql; -use Common; -use base qw(IMPL::SQL::Schema::Traits); -use IMPL::Class::Property; -use IMPL::Class::Property::Direct; - -BEGIN { - public _direct property PendingConstraints => prop_none; -} - -our %CTOR = ( - 'IMPL::SQL::Schema::Traits' => sub { - my %args = @_; - $args{'Handler'} = new IMPL::SQL::Schema::Traits::mysql::Handler; - %args; - } -); - -sub DropConstraint { - my ($this,$constraint) = @_; - - if (UNIVERSAL::isa($constraint,'IMPL::SQL::Schema::Constraint::Index')) { - return 1 if not grep { $this->TableInfo->{$this->MapTableName($constraint->Table->Name)}->{'Columns'}->{$_->Name} != IMPL::SQL::Schema::Traits::STATE_REMOVED} $constraint->Columns; - my @constraints = grep {$_ != $constraint } $constraint->Table->GetColumnConstraints($constraint->Columns); - if (scalar @constraints == 1 and UNIVERSAL::isa($constraints[0],'IMPL::SQL::Schema::Constraint::ForeignKey')) { - my $fk = shift @constraints; - if ($this->TableInfo->{$this->MapTableName($fk->Table->Name)}->{'Constraints'}->{$fk->Name} != IMPL::SQL::Schema::Traits::STATE_REMOVED) { - push @{$this->PendingActions}, {Action => \&DropConstraint, Args => [$constraint]}; - $this->{$PendingConstraints}->{$constraint->UniqName}->{'attempts'} ++; - - die new IMPL::Exception('Can\'t drop the primary key becouse of the foreing key',$fk->UniqName) if $this->{$PendingConstraints}->{$constraint->UniqName}->{'attempts'} > 2; - return 2; - } - } - } - $this->SUPER::DropConstraint($constraint); -} - -sub GetMetaTable { - my ($class,$dbh) = @_; - - return IMPL::SQL::Schema::Traits::mysql::MetaTable->new( DBHandle => $dbh); -} - -package IMPL::SQL::Schema::Traits::mysql::MetaTable; -use Common; -use base qw(IMPL::Object); -use IMPL::Class::Property; -use IMPL::Class::Property::Direct; - -BEGIN { - public _direct property DBHandle => prop_none; -} - -sub ReadProperty { - my ($this,$name) = @_; - - local $this->{$DBHandle}->{PrintError}; - $this->{$DBHandle}->{PrintError} = 0; - my ($val) = $this->{$DBHandle}->selectrow_array("SELECT value FROM _Meta WHERE name like ?", undef, $name); - return $val; -} - -sub SetProperty { - my ($this,$name,$val) = @_; - - if ( $this->{$DBHandle}->selectrow_arrayref("SELECT TABLE_NAME FROM information_schema.`TABLES` T where TABLE_SCHEMA like DATABASE() and TABLE_NAME like '_Meta'")) { - if ($this->{$DBHandle}->selectrow_arrayref("SELECT name FROM _Meta WHERE name like ?", undef, $name)) { - $this->{$DBHandle}->do("UPDATE _Meta SET value = ? WHERE name like ?",undef,$val,$name); - } else { - $this->{$DBHandle}->do("INSERT INTO _Meta(name,value) VALUES ('$name',?)",undef,$val); - } - } else { - $this->{$DBHandle}->do(q{ - CREATE TABLE `_Meta` ( - `name` VARCHAR(255) NOT NULL, - `value` LONGTEXT NULL, - PRIMARY KEY(`name`) - ); - }) or die new IMPL::Exception("Failed to create table","_Meta"); - - $this->{$DBHandle}->do("INSERT INTO _Meta(name,value) VALUES (?,?)",undef,$name,$val); - } -} - -1; +package IMPL::SQL::Schema::Traits::mysql::Handler; +use strict; +use base qw(IMPL::Object); +use IMPL::Class::Property; +use IMPL::Class::Property::Direct; + +BEGIN { + public _direct property SqlBatch => prop_all; +} + +sub formatTypeNameInteger { + my ($type) = @_; + + return $type->Name.($type->MaxLength ? '('.$type->MaxLength.')' : '').($type->Unsigned ? ' UNSIGNED': '').($type->Zerofill ? ' ZEROFILL' : ''); +} + +sub formatTypeNameReal { + my ($type) = @_; + + return $type->Name.($type->MaxLength ? '('.$type->MaxLength.', '.$type->Scale.')' : '').($type->Unsigned ? ' UNSIGNED': '').($type->Zerofill ? ' ZEROFILL' : ''); +} + +sub formatTypeNameNumeric { + my ($type) = @_; + $type->MaxLength or die new IMPL::InvalidArgumentException('The length and precission must be specified',$type->Name); + return $type->Name.($type->MaxLength ? '('.$type->MaxLength.', '.$type->Scale.')' : '').($type->Unsigned ? ' UNSIGNED': '').($type->Zerofill ? ' ZEROFILL' : ''); +} + +sub formatTypeName { + my ($type) = @_; + return $type->Name; +} + +sub formatTypeNameChar { + my ($type) = @_; + + return ( + $type->Name.'('.$type->MaxLength.')'. (UNIVERSAL::isa($type,'IMPL::SQL::Schema::Type::mysql::CHAR') ? $type->Encoding : '') + ); +} + +sub formatTypeNameVarChar { + my ($type) = @_; + + return ( + $type->Name.'('.$type->MaxLength.')'. (UNIVERSAL::isa($type,'IMPL::SQL::Schema::Type::mysql::VARCHAR') ? $type->Encoding : '') + ); +} + +sub formatTypeNameEnum { + my ($type) = @_; + 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')); + return ( + $type->Name.'('.join(',',map {quote($_)} $type->Values).')' + ); +} + +sub quote{ + if (wantarray) { + return map { my $str=$_; $str=~ s/'/''/g; "'$str'"; } @_; + } else { + return join '',map { my $str=$_; $str=~ s/'/''/g; "'$str'"; } @_; + } +} + +sub quote_names { + if (wantarray) { + return map { my $str=$_; $str=~ s/`/``/g; "`$str`"; } @_; + } else { + return join '',map { my $str=$_; $str=~ s/`/``/g; "`$str`"; } @_; + } +} + +sub formatStringValue { + my ($value) = @_; + + if (ref $value) { + if (UNIVERSAL::isa($value,'IMPL::SQL::Schema::mysql::Expression')) { + return $value->as_string; + } else { + die new Exception('Can\'t format the object as a value',ref $value); + } + } else { + return quote($value); + } +} + + +sub formatNumberValue { + my ($value) = @_; + + if (ref $value) { + if (UNIVERSAL::isa($value,'IMPL::SQL::Schema::mysql::Expression')) { + return $value->as_string; + } else { + die new Exception('Can\'t format the object as a value',ref $value); + } + } else { + $value =~ /^((\+|-)\s*)?\d+(\.\d+)?(e(\+|-)?\d+)?$/ or die new Exception('The specified value isn\'t a valid number',$value); + return $value; + } +} + + +my %TypesFormat = ( + TINYINT => { + formatType => \&formatTypeNameInteger, + formatValue => \&formatNumberValue + }, + SMALLINT => { + formatType => \&formatTypeNameInteger, + formatValue => \&formatNumberValue + }, + MEDIUMINT => { + formatType => \&formatTypeNameInteger, + formatValue => \&formatNumberValue + }, + INT => { + formatType => \&formatTypeNameInteger, + formatValue => \&formatNumberValue + }, + INTEGER => { + formatType => \&formatTypeNameInteger, + formatValue => \&formatNumberValue + }, + BIGINT => { + formatType => \&formatTypeNameInteger, + formatValue => \&formatNumberValue + }, + REAL => { + formatType => \&formatTypeNameReal, + formatValue => \&formatNumberValue + }, + DOUBLE => { + formatType => \&formatTypeNameReal, + formatValue => \&formatNumberValue + }, + FLOAT => { + formatType => \&formatTypeNameReal, + formatValue => \&formatNumberValue + }, + DECIMAL => { + formatType => \&formatTypeNameNumeric, + formatValue => \&formatNumberValue + }, + NUMERIC => { + formatType => \&formatTypeNameNumeric, + formatValue => \&formatNumberValue + }, + DATE => { + formatType => \&formatTypeName, + formatValue => \&formatStringValue + }, + TIME => { + formatType => \&formatTypeName, + formatValue => \&formatStringValue + }, + TIMESTAMP => { + formatType => \&formatTypeName, + formatValue => \&formatStringValue + }, + DATETIME => { + formatType => \&formatTypeName, + formatValue => \&formatStringValue + }, + CHAR => { + formatType => \&formatTypeNameChar, + formatValue => \&formatStringValue + }, + VARCHAR => { + formatType => \&formatTypeNameVarChar, + formatValue => \&formatStringValue + }, + TINYBLOB => { + formatType => \&formatTypeName, + formatValue => \&formatStringValue + }, + BLOB => { + formatType => \&formatTypeName, + formatValue => \&formatStringValue + }, + MEDIUMBLOB => { + formatType => \&formatTypeName, + formatValue => \&formatStringValue + }, + LONGBLOB => { + formatType => \&formatTypeName, + formatValue => \&formatStringValue + }, + TINYTEXT => { + formatType => \&formatTypeName, + formatValue => \&formatStringValue + }, + TEXT => { + formatType => \&formatTypeName, + formatValue => \&formatStringValue + }, + MEDIUMTEXT => { + formatType => \&formatTypeName, + formatValue => \&formatStringValue + }, + LONGTEXT => { + formatType => \&formatTypeName, + formatValue => \&formatStringValue + }, + ENUM => { + formatType => \&formatTypeNameEnum, + formatValue => \&formatStringValue + }, + SET => { + formatType => \&formatTypeNameEnum, + formatValue => \&formatStringValue + } +); + + +=pod +CREATE TABLE 'test'.'New Table' ( + 'dd' INTEGER UNSIGNED NOT NULL AUTO_INCREMENT, + `ff` VARCHAR(45) NOT NULL, + `ffg` VARCHAR(45) NOT NULL DEFAULT 'aaa', + `ddf` INTEGER UNSIGNED NOT NULL, + PRIMARY KEY(`dd`), + UNIQUE `Index_2`(`ffg`), + CONSTRAINT `FK_New Table_1` FOREIGN KEY `FK_New Table_1` (`ddf`) + REFERENCES `user` (`id`) + ON DELETE RESTRICT + ON UPDATE RESTRICT +) +ENGINE = InnoDB; +=cut +sub formatCreateTable { + my ($table,$level,%options) = @_; + + my @sql; + + # table body + push @sql, map { formatColumn($_,$level+1) } @{$table->Columns} ; + if ($options{'skip_foreign_keys'}) { + push @sql, map { formatConstraint($_,$level+1) } grep {not UNIVERSAL::isa($_,'IMPL::SQL::Schema::Constraint::ForeignKey')} values %{$table->Constraints}; + } else { + push @sql, map { formatConstraint($_,$level+1) } values %{$table->Constraints}; + } + + for(my $i = 0 ; $i < @sql -1; $i++) { + $sql[$i] .= ','; + } + + unshift @sql, "CREATE TABLE ".quote_names($table->Name)."("; + + if ($table->Tag) { + push @sql, ")"; + push @sql, formatTableTag($table->Tag,$level); + $sql[$#sql].=';'; + } else { + push @sql, ');'; + } + + return map { ("\t" x $level) . $_ } @sql; +} + +sub formatDropTable { + my ($tableName,$level) = @_; + + return "\t"x$level."DROP TABLE ".quote_names($tableName).";"; +} + +sub formatTableTag { + my ($tag,$level) = @_; + return map { "\t"x$level . "$_ = ".$tag->{$_} } grep {/^(ENGINE)$/i} keys %{$tag}; +} + +sub formatColumn { + my ($column,$level) = @_; + $level ||= 0; + 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) : ''); +} + +sub formatType { + my ($type) = @_; + my $format = $TypesFormat{uc $type->Name} or die new Exception('The unknown type name',$type->Name); + $format->{formatType}->($type); +} + +sub formatValueToType { + my ($value,$type) = @_; + + my $format = $TypesFormat{uc $type->Name} or die new Exception('The unknown type name',$type->Name); + $format->{formatValue}->($value); +} + +sub formatConstraint { + my ($constraint,$level) = @_; + + if (UNIVERSAL::isa($constraint,'IMPL::SQL::Schema::Constraint::ForeignKey')) { + return formatForeignKey($constraint,$level); + } else { + return formatIndex($constraint, $level); + } +} + +sub formatIndex { + my ($constraint,$level) = @_; + + my $name = quote_names($constraint->Name); + my $columns = join(',',map quote_names($_->Name),@{$constraint->Columns}); + + if (ref $constraint eq 'IMPL::SQL::Schema::Constraint::PrimaryKey') { + return "\t"x$level."PRIMARY KEY ($columns)"; + } elsif ($constraint eq 'IMPL::SQL::Schema::Constraint::Unique') { + return "\t"x$level."UNIQUE $name ($columns)"; + } elsif ($constraint eq 'IMPL::SQL::Schema::Constraint::Index') { + return "\t"x$level."INDEX $name ($columns)"; + } else { + die new IMPL::InvalidArgumentException('The unknown constraint', ref $constraint); + } + +} + +sub formatForeignKey { + my ($constraint,$level) = @_; + + my $name = quote_names($constraint->Name); + my $columns = join(',',map quote_names($_->Name),@{$constraint->Columns}); + + 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); + 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); + + my $refname = quote_names($constraint->ReferencedPrimaryKey->Table->Name); + my $refcolumns = join(',',map quote_names($_->Name),@{$constraint->ReferencedPrimaryKey->Columns}); + return ( + "\t"x$level. + "CONSTRAINT $name FOREIGN KEY $name ($columns) REFERENCES $refname ($refcolumns)". + ($constraint->OnUpdate ? 'ON UPDATE'.$constraint->OnUpdate : ''). + ($constraint->OnDelete ? 'ON DELETE'.$constraint->OnDelete : '') + ); +} + +sub formatAlterTableRename { + my ($oldName,$newName,$level) = @_; + + return "\t"x$level."ALTER TABLE ".quote_names($oldName)." RENAME TO ".quote_names($newName).";"; +} + +sub formatAlterTableDropColumn { + my ($tableName, $columnName,$level) = @_; + + return "\t"x$level."ALTER TABLE ".quote_names($tableName)." DROP COLUMN ".quote_names($columnName).";"; +} + +=pod +ALTER TABLE `test`.`user` ADD COLUMN `my_col` VARCHAR(45) NOT NULL AFTER `name2` +=cut +sub formatAlterTableAddColumn { + my ($tableName, $column, $table, $pos, $level) = @_; + + my $posSpec = $pos == 0 ? 'FIRST' : 'AFTER '.quote_names($table->ColumnAt($pos-1)->Name); + + return "\t"x$level."ALTER TABLE ".quote_names($tableName)." ADD COLUMN ".formatColumn($column) .' '. $posSpec.";"; +} + +=pod +ALTER TABLE `test`.`manager` MODIFY COLUMN `description` VARCHAR(256) NOT NULL DEFAULT NULL; +=cut +sub formatAlterTableChangeColumn { + my ($tableName,$column,$table,$pos,$level) = @_; + my $posSpec = $pos == 0 ? 'FIRST' : 'AFTER '.quote_names($table->ColumnAt($pos-1)->Name); + return "\t"x$level."ALTER TABLE ".quote_names($tableName)." MODIFY COLUMN ".formatColumn($column).' '. $posSpec.";"; +} + +=pod +ALTER TABLE `test`.`manager` DROP INDEX `Index_2`; +=cut +sub formatAlterTableDropConstraint { + my ($tableName,$constraint,$level) = @_; + my $constraintName; + if (ref $constraint eq 'IMPL::SQL::Schema::Constraint::PrimaryKey') { + $constraintName = 'PRIMARY KEY'; + } elsif (ref $constraint eq 'IMPL::SQL::Schema::Constraint::ForeignKey') { + $constraintName = 'FOREIGN KEY '.quote_names($constraint->Name); + } elsif (UNIVERSAL::isa($constraint,'IMPL::SQL::Schema::Constraint::Index')) { + $constraintName = 'INDEX '.quote_names($constraint->Name); + } else { + die new IMPL::Exception("The unknow type of the constraint",ref $constraint); + } + return "\t"x$level."ALTER TABLE ".quote_names($tableName)." DROP $constraintName;"; +} + +=pod +ALTER TABLE `test`.`session` ADD INDEX `Index_2`(`id`, `name`); +=cut +sub formatAlterTableAddConstraint { + my ($tableName,$constraint,$level) = @_; + + return "\t"x$level."ALTER TABLE ".quote_names($tableName)." ADD ".formatConstraint($constraint,0).';'; +} + +sub CreateTable { + my ($this,$tbl,%option) = @_; + + push @{$this->{$SqlBatch}},join("\n",formatCreateTable($tbl,0,%option)); + + return 1; +} + +sub DropTable { + my ($this,$tbl) = @_; + + push @{$this->{$SqlBatch}},join("\n",formatDropTable($tbl,0)); + + return 1; +} + +sub RenameTable { + my ($this,$oldName,$newName) = @_; + + push @{$this->{$SqlBatch}},join("\n",formatAlterTableRename($oldName,$newName,0)); + + return 1; +} + +sub AlterTableAddColumn { + my ($this,$tblName,$column,$table,$pos) = @_; + + push @{$this->{$SqlBatch}},join("\n",formatAlterTableAddColumn($tblName,$column,$table,$pos,0)); + + return 1; +} +sub AlterTableDropColumn { + my ($this,$tblName,$columnName) = @_; + + push @{$this->{$SqlBatch}},join("\n",formatAlterTableDropColumn($tblName,$columnName,0)); + + return 1; +} + +sub AlterTableChangeColumn { + my ($this,$tblName,$column,$table,$pos) = @_; + + push @{$this->{$SqlBatch}},join("\n",formatAlterTableChangeColumn($tblName,$column,$table,$pos,0)); + + return 1; +} + +sub AlterTableAddConstraint { + my ($this,$tblName,$constraint) = @_; + + push @{$this->{$SqlBatch}},join("\n",formatAlterTableAddConstraint($tblName,$constraint,0)); + + return 1; +} + +sub AlterTableDropConstraint { + my ($this,$tblName,$constraint) = @_; + + push @{$this->{$SqlBatch}},join("\n",formatAlterTableDropConstraint($tblName,$constraint,0)); + + return 1; +} + +sub Sql { + my ($this) = @_; + if (wantarray) { + @{$this->SqlBatch || []}; + } else { + return join("\n",$this->SqlBatch); + } +} + +package IMPL::SQL::Schema::Traits::mysql; +use Common; +use base qw(IMPL::SQL::Schema::Traits); +use IMPL::Class::Property; +use IMPL::Class::Property::Direct; + +BEGIN { + public _direct property PendingConstraints => prop_none; +} + +our %CTOR = ( + 'IMPL::SQL::Schema::Traits' => sub { + my %args = @_; + $args{'Handler'} = new IMPL::SQL::Schema::Traits::mysql::Handler; + %args; + } +); + +sub DropConstraint { + my ($this,$constraint) = @_; + + if (UNIVERSAL::isa($constraint,'IMPL::SQL::Schema::Constraint::Index')) { + return 1 if not grep { $this->TableInfo->{$this->MapTableName($constraint->Table->Name)}->{'Columns'}->{$_->Name} != IMPL::SQL::Schema::Traits::STATE_REMOVED} $constraint->Columns; + my @constraints = grep {$_ != $constraint } $constraint->Table->GetColumnConstraints($constraint->Columns); + if (scalar @constraints == 1 and UNIVERSAL::isa($constraints[0],'IMPL::SQL::Schema::Constraint::ForeignKey')) { + my $fk = shift @constraints; + if ($this->TableInfo->{$this->MapTableName($fk->Table->Name)}->{'Constraints'}->{$fk->Name} != IMPL::SQL::Schema::Traits::STATE_REMOVED) { + push @{$this->PendingActions}, {Action => \&DropConstraint, Args => [$constraint]}; + $this->{$PendingConstraints}->{$constraint->UniqName}->{'attempts'} ++; + + die new IMPL::Exception('Can\'t drop the primary key becouse of the foreing key',$fk->UniqName) if $this->{$PendingConstraints}->{$constraint->UniqName}->{'attempts'} > 2; + return 2; + } + } + } + $this->SUPER::DropConstraint($constraint); +} + +sub GetMetaTable { + my ($class,$dbh) = @_; + + return IMPL::SQL::Schema::Traits::mysql::MetaTable->new( DBHandle => $dbh); +} + +package IMPL::SQL::Schema::Traits::mysql::MetaTable; +use Common; +use base qw(IMPL::Object); +use IMPL::Class::Property; +use IMPL::Class::Property::Direct; + +BEGIN { + public _direct property DBHandle => prop_none; +} + +sub ReadProperty { + my ($this,$name) = @_; + + local $this->{$DBHandle}->{PrintError}; + $this->{$DBHandle}->{PrintError} = 0; + my ($val) = $this->{$DBHandle}->selectrow_array("SELECT value FROM _Meta WHERE name like ?", undef, $name); + return $val; +} + +sub SetProperty { + my ($this,$name,$val) = @_; + + if ( $this->{$DBHandle}->selectrow_arrayref("SELECT TABLE_NAME FROM information_schema.`TABLES` T where TABLE_SCHEMA like DATABASE() and TABLE_NAME like '_Meta'")) { + if ($this->{$DBHandle}->selectrow_arrayref("SELECT name FROM _Meta WHERE name like ?", undef, $name)) { + $this->{$DBHandle}->do("UPDATE _Meta SET value = ? WHERE name like ?",undef,$val,$name); + } else { + $this->{$DBHandle}->do("INSERT INTO _Meta(name,value) VALUES ('$name',?)",undef,$val); + } + } else { + $this->{$DBHandle}->do(q{ + CREATE TABLE `_Meta` ( + `name` VARCHAR(255) NOT NULL, + `value` LONGTEXT NULL, + PRIMARY KEY(`name`) + ); + }) or die new IMPL::Exception("Failed to create table","_Meta"); + + $this->{$DBHandle}->do("INSERT INTO _Meta(name,value) VALUES (?,?)",undef,$name,$val); + } +} + +1;