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;