view Lib/Schema/DB/Traits/mysql.pm @ 31:d59526f6310e

Small fixes to Test framework (correct handlinf of the compilation errors in the test units) Imported and refactored SQL DB schema from the old project
author Sergey
date Mon, 09 Nov 2009 01:39:16 +0300
parents 03e58a454b20
children 16ada169ca75
line wrap: on
line source

package Schema::DB::Traits::mysql::Handler;
use strict;
use Common;
our @ISA=qw(Object);

BEGIN {
    DeclareProperty SqlBatch => ACCESS_NONE;
}

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 Exception('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,'Schema::DB::Type::mysql::CHAR') ? $type->Encoding : '')
    );
}

sub formatTypeNameVarChar {
    my ($type) = @_;
    
    return (
        $type->Name.'('.$type->MaxLength.')'. (UNIVERSAL::isa($type,'Schema::DB::Type::mysql::VARCHAR') ? $type->Encoding : '')
    );
}

sub formatTypeNameEnum {
    my ($type) = @_;
    die new Exception('Enum must be a type of either Schema::DB::Type::mysql::ENUM or Schema::DB::Type::mysql::SET') if not (UNIVERSAL::isa($type,'Schema::DB::Type::mysql::ENUM') or UNIVERSAL::isa($type,'Schema::DB::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,'Schema::DB::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,'Schema::DB::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($_,'Schema::DB::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,'Schema::DB::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 'Schema::DB::Constraint::PrimaryKey') {
        return "\t"x$level."PRIMARY KEY ($columns)";
    } elsif ($constraint eq 'Schema::DB::Constraint::Unique') {
        return "\t"x$level."UNIQUE $name ($columns)";
    } elsif ($constraint eq 'Schema::DB::Constraint::Index') {
        return "\t"x$level."INDEX $name ($columns)";
    } else {
        die new Exception('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 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 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 'Schema::DB::Constraint::PrimaryKey') {
        $constraintName = 'PRIMARY KEY';
    } elsif (ref $constraint eq 'Schema::DB::Constraint::ForeignKey') {
        $constraintName = 'FOREIGN KEY '.quote_names($constraint->Name);
    } elsif (UNIVERSAL::isa($constraint,'Schema::DB::Constraint::Index')) {
        $constraintName = 'INDEX '.quote_names($constraint->Name);
    } else {
        die new 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 Schema::DB::Traits::mysql;
use Common;
use base qw(Schema::DB::Traits);

BEGIN {
    DeclareProperty PendingConstraints => ACCESS_NONE;
}

sub CTOR {
    my ($this,%args) = @_;
    
    $args{'Handler'} = new Schema::DB::Traits::mysql::Handler;
    $this->SUPER::CTOR(%args);
}

sub DropConstraint {
    my ($this,$constraint) = @_;
    
    if (UNIVERSAL::isa($constraint,'Schema::DB::Constraint::Index')) {
        return 1 if not grep { $this->TableInfo->{$this->MapTableName($constraint->Table->Name)}->{'Columns'}->{$_->Name} != Schema::DB::Traits::STATE_REMOVED} $constraint->Columns;
        my @constraints = grep {$_ != $constraint } $constraint->Table->GetColumnConstraints($constraint->Columns);
        if (scalar @constraints == 1 and UNIVERSAL::isa($constraints[0],'Schema::DB::Constraint::ForeignKey')) {
            my $fk = shift @constraints;
            if ($this->TableInfo->{$this->MapTableName($fk->Table->Name)}->{'Constraints'}->{$fk->Name} != Schema::DB::Traits::STATE_REMOVED) {
                push @{$this->PendingActions}, {Action => \&DropConstraint, Args => [$constraint]};
                $this->{$PendingConstraints}->{$constraint->UniqName}->{'attempts'} ++;
                
                die new 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 Schema::DB::Traits::mysql::MetaTable->new( DBHandle => $dbh);
}

package Schema::DB::Traits::mysql::MetaTable;
use Common;
our @ISA=qw(Object);

BEGIN {
    DeclareProperty DBHandle => ACCESS_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 Exception("Failed to create table","_Meta");
        
        $this->{$DBHandle}->do("INSERT INTO _Meta(name,value) VALUES (?,?)",undef,$name,$val);
    }
}

1;