Mercurial > pub > Impl
view Lib/IMPL/SQL/Schema/Traits/mysql.pm @ 250:129e48bb5afb
DOM refactoring
ObjectToDOM methods are virtual
QueryToDOM uses inflators
Fixed transform for the complex values in the ObjectToDOM
QueryToDOM doesn't allow to use complex values (HASHes) as values for nodes (overpost problem)
author | sergey |
---|---|
date | Wed, 07 Nov 2012 04:17:53 +0400 |
parents | c8fe3f84feba |
children | 4ddb27ff4a0b |
line wrap: on
line source
package IMPL::SQL::Schema::Traits::mysql::Handler; use strict; use parent 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 { (" " x $level) . $_ } @sql; } sub formatDropTable { my ($tableName,$level) = @_; return " "x$level."DROP TABLE ".quote_names($tableName).";"; } sub formatTableTag { my ($tag,$level) = @_; return map { " "x$level . "$_ = ".$tag->{$_} } grep {/^(ENGINE)$/i} keys %{$tag}; } sub formatColumn { my ($column,$level) = @_; $level ||= 0; 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) : ''); } 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 " "x$level."PRIMARY KEY ($columns)"; } elsif ($constraint eq 'IMPL::SQL::Schema::Constraint::Unique') { return " "x$level."UNIQUE $name ($columns)"; } elsif ($constraint eq 'IMPL::SQL::Schema::Constraint::Index') { return " "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 ( " "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 " "x$level."ALTER TABLE ".quote_names($oldName)." RENAME TO ".quote_names($newName).";"; } sub formatAlterTableDropColumn { my ($tableName, $columnName,$level) = @_; return " "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 " "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 " "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 " "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 " "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 parent 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 parent 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;