Mercurial > pub > Impl
view Lib/IMPL/SQL/Schema/Traits/mysql.pm @ 229:47f77e6409f7
heavily reworked the resource model of the web application:
*some ResourcesContraact functionality moved to Resource
+Added CustomResource
*Corrected action handlers
author | sergey |
---|---|
date | Sat, 29 Sep 2012 02:34:47 +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;