--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/SQL/Schema/Traits/mysql.pm	Mon Nov 09 01:39:31 2009 +0300
@@ -0,0 +1,554 @@
+package IMPL::SQL::Schema::Traits::mysql::Handler;
+use strict;
+use base qw(IMPL::Object);
+use IMPL::Class::Property;
+use IMPL::Class::Property::Direct;
+
+BEGIN {
+    public _direct property SqlBatch => prop_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 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 { ("\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,'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 "\t"x$level."PRIMARY KEY ($columns)";
+    } elsif ($constraint eq 'IMPL::SQL::Schema::Constraint::Unique') {
+        return "\t"x$level."UNIQUE $name ($columns)";
+    } elsif ($constraint eq 'IMPL::SQL::Schema::Constraint::Index') {
+        return "\t"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 (
+        "\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 '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 "\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 IMPL::SQL::Schema::Traits::mysql;
+use Common;
+use base qw(IMPL::SQL::Schema::Traits);
+use IMPL::Class::Property;
+use IMPL::Class::Property::Direct;
+
+BEGIN {
+    public _direct property PendingConstraints => prop_none;
+}
+
+sub CTOR {
+    my ($this,%args) = @_;
+    
+    $args{'Handler'} = new IMPL::SQL::Schema::Traits::mysql::Handler;
+    $this->SUPER::CTOR(%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 base 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;