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;