--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/SQL/Schema/MySQL/Formatter.pm	Mon Jan 28 02:43:14 2013 +0400
@@ -0,0 +1,559 @@
+package IMPL::SQL::Schema::MySQL::Formatter;
+use strict;
+
+use IMPL::lang qw(is);
+use IMPL::require {
+    Exception         => 'IMPL::Exception',
+    OpException       => '-IMPL::InvalidOperationException',
+    ArgException      => '-IMPL::InvalidArgumentException',
+    PrimaryKey        => '-IMPL::SQL::Schema::Constraint::PrimaryKey',
+    UniqueIndex       => '-IMPL::SQL::Schema::Constraint::Unique',
+    Index             => '-IMPL::SQL::Schema::Constraint::Index',
+    ForeignKey        => '-IMPL::SQL::Schema::Constraint::ForeignKey',
+    CharType          => '-IMPL::SQL::Schema::MySQL::CharType',
+    EnumType          => '-IMPL::SQL::Schema::MySQL::EnumType',
+    TraitsDropTable   => '-IMPL::SQL::Schema::Traits::DropTable',
+    TraitsCreateTable => '-IMPL::SQL::Schema::Traits::CreateTable',
+    TraitsAlterTableDropConstraint => '-IMPL::SQL::Schema::Traits::AlterTableDropConstraint',
+    TraitsAlterTableAddConstraint  => '-IMPL::SQL::Schema::Traits::AlterTableAddConstraint',
+    TraitsAlterTableDropColumn     => '-IMPL::SQL::Schema::Traits::AlterTableDropColumn',
+    TraitsAlterTableAddColumn      => '-IMPL::SQL::Schema::Traits::AlterTableAddColumn',
+    TraitsAlterTableChangeColumn   => '-IMPL::SQL::Schema::Traits::AlterTableChangeColumn'
+};
+
+our %TRAITS_FORMATS = (
+    TraitsDropTable,                'FormatDropTable',
+    TraitsCreateTable,              'FormatCreateTable',
+    TraitsAlterTableDropConstraint, 'FormatAlterTableDropConstraint',
+    TraitsAlterTableAddConstraint,  'FormatAlterTableAddConstraint',
+    TraitsAlterTableDropColumn,     'FormatAlterTableDropColumn',
+    TraitsAlterTableAddColumn,      'FormatAlterTableAddColumn',
+    TraitsAlterTableChangeColumn,   'FormatAlterTableChangeColumn'
+);
+
+sub quote {
+    my $self = shift;
+
+    if (wantarray) {
+        return map { my $str = $_; $str =~ s/'/''/g; "'$str'"; } @_;
+    }
+    else {
+        return join '', map { my $str = $_; $str =~ s/'/''/g; "'$str'"; } @_;
+    }
+}
+
+sub quote_names {
+    my $self = shift;
+
+    if (wantarray) {
+        return map { my $str = $_; $str =~ s/`/``/g; "`$str`"; } @_;
+    }
+    else {
+        return join '', map { my $str = $_; $str =~ s/`/``/g; "`$str`"; } @_;
+    }
+}
+
+sub formatTypeNameInteger {
+    my ( $self, $type ) = @_;
+
+    return
+        $type->name
+      . ( $type->maxLength ? '(' . $type->maxLength . ')' : '' )
+      . ( $type->unsigned  ? ' UNSIGNED'                  : '' )
+      . ( $type->zerofill  ? ' ZEROFILL'                  : '' );
+}
+
+sub formatTypeNameReal {
+    my ( $self, $type ) = @_;
+
+    return $type->name
+      . ( $type->maxLength
+        ? '(' . $type->maxLength . ', ' . $type->scale . ')'
+        : '' )
+      . ( $type->unsigned ? ' UNSIGNED' : '' )
+      . ( $type->zerofill ? ' ZEROFILL' : '' );
+}
+
+sub formatTypeNameNumeric {
+    my ( $self, $type ) = @_;
+    $type->maxLength
+      or die ArgException->new(
+        type => '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 ( $self, $type ) = @_;
+    return $type->name;
+}
+
+sub formatTypeNameChar {
+    my ( $self, $type ) = @_;
+
+    return ($type->name . '('
+          . $type->MaxLength . ')'
+          . ( is( $type, CharType ) ? $type->encoding : '' ) );
+}
+
+sub formatTypeNameVarChar {
+    my ( $self, $type ) = @_;
+
+    return ($type->name . '('
+          . $type->maxLength . ')'
+          . ( is( $type, CharType ) ? $type->encoding : '' ) );
+}
+
+sub formatTypeNameEnum {
+    my ( $self, $type ) = @_;
+
+    die ArgException->new( type => 'Invalid enum type' )
+      unless is( $type, EnumType );
+    return ($type->name . '('
+          . join( ',', map { $self->quote($_) } $type->enumValues )
+          . ')' );
+}
+
+sub formatStringValue {
+    my ( $self, $value ) = @_;
+
+    if ( ref $value eq 'SCALAR' ) {
+        return $$value;
+    }
+    else {
+        return $self->quote($value);
+    }
+}
+
+sub formatNumberValue {
+    my ( $self, $value ) = @_;
+
+    if ( ref $value eq 'SCALAR' ) {
+        return $$value;
+    }
+    else {
+        $value =~ /^((\+|-)\s*)?\d+(\.\d+)?(e(\+|-)?\d+)?$/
+          or die ArgException->new(
+            value => 'The specified value isn\'t a valid number',
+            $value
+          );
+        return $value;
+    }
+}
+
+our %TYPES_FORMATS = (
+    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
+    }
+);
+
+sub FormatTypeName {
+    my ( $self, $type ) = @_;
+
+    my $fn = $TYPES_FORMATS{ $type->name }{formatType}
+      or die ArgException->new( type => "The specified type is unknown",
+        $type->name );
+
+    return $self->$fn($type);
+}
+
+sub FormatValue {
+    my ( $self, $value, $type ) = @_;
+
+    my $fn = $TYPES_FORMATS{ $type->name }{formatValue}
+      or die ArgException->new( type => "The specified type is unknown",
+        $type->name );
+
+    return $self->$fn( $value, $type );
+}
+
+sub FormatColumn {
+    my ( $self, $column ) = @_;
+
+    my @parts = (
+        $self->quote_names( $column->{name} ),
+        $self->FormatTypeName( $column->{type} ),
+        $column->{isNullable} ? 'NULL' : 'NOT NULL'
+    );
+
+    push @parts, $self->FormatValue( $column->{defaultValue}, $column->{type} )
+      if $column->{defaultValue};
+
+    push @parts, 'AUTO_INCREMENT'
+      if $column->{tag} and $column->{tag}->{auto_increment};
+
+    return join ' ', @parts;
+}
+
+sub FormatCreateTable {
+    my ( $self, $op ) = @_;
+
+    my $table = $op->table;
+
+    my @lines;
+    my @body;
+
+    push @lines, "CREATE TABLE " . $self->quote_names($table->{name}) . "(";
+
+    push @body, map { "  " . $self->FormatColumn($_) } @{ $table->{columns} }
+        if $table->{columns};
+      
+    push @body, map { "  " . $self->FormatConstraint($_) } @{ $table->{constraints} }
+        if $table->{constraints};
+        
+    push @lines, join(",\n", @body);
+
+    push @lines, ");";
+
+    return join "\n", @lines;
+}
+
+sub FormatDropTable {
+    my ( $self, $op ) = @_;
+
+    return join ' ', 'DROP TABLE', $self->quote_names( $op->tableName ), ';';
+}
+
+sub FormatRenameTable {
+    my ( $self, $op ) = @_;
+
+    return join ' ',
+      'ALTER TABLE',
+      $self->quote_names( $op->tableName ),
+      'RENAME TO',
+      $self->quote_names( $op->tableNewName ),
+      ';';
+}
+
+sub FormatAlterTableAddColumn {
+    my ( $self, $op, $schema ) = @_;
+
+    my @parts = (
+        'ALTER TABLE',$self->quote_names($op->tableName), 'ADD COLUMN',
+        $self->FormatColumn( $op->column )
+    );
+
+    if ( defined $op->position ) {
+
+        # mysql supports column reordering
+        # the new location is specified relative to the previous column
+        # to determine the name of the previous column we need to ask the schema
+
+        my $table = $schema->GetTable( $op->tableName );
+
+        if ( $op->position == 0 ) {
+            push @parts, 'FIRST';
+        }
+        else {
+            push @parts, 'AFTER';
+
+            my $prevColumn = $table->GetColumnAt( $op->position - 1 );
+            push @parts, $self->quote_names( $prevColumn->{name} );
+        }
+    }
+
+    push @parts, ';';
+
+    return join ' ', @parts;
+}
+
+sub FormatAlterTableDropColumn {
+    my ( $self, $op ) = @_;
+
+    return join ' ',
+      'ALTER TABLE',
+      $self->quote_names( $op->tableName ),
+      'DROP COLUMN',
+      $self->quote_names( $op->columnName ),
+      ';';
+}
+
+sub FormatAlterTableChangeColumn {
+    my ( $self, $op, $schema ) = @_;
+
+    my $table  = $schema->GetTable( $op->tableName );
+    my $column = $table->GetColumn( $op->columnName );
+
+    my @parts = (
+        'ALTER TABLE',
+        $self->quote_names( $op->tableName ),
+        'MODIFY COLUMN',
+        $self->quote_names( $op->columnName ),
+        $self->FormatColumn( $self->_Column2Traits($column) )
+    );
+
+    if ( defined $op->position ) {
+
+        # mysql supports column reordering
+        # the new location is specified relative to the previous column
+        # to determine the name of the previous column we need to ask the schema
+
+        if ( $op->position == 0 ) {
+            push @parts, 'FIRST';
+        }
+        else {
+            push @parts, 'AFTER';
+
+            my $prevColumn = $table->GetColumnAt( $op->position - 1 );
+            push @parts, $self->quote_names( $prevColumn->{name} );
+        }
+    }
+
+    push @parts, ';';
+    return join ' ', @parts;
+}
+
+sub FormatConstraint {
+    my ($self,$constraint) = @_;
+    
+    my @fkRules =
+      ( 'RESTRICT', 'CASCADE', 'SET NULL', 'SET DEFAULT', 'NO ACTION' );
+      
+    my @parts;
+
+    if ( $constraint->constraintClass eq ForeignKey ) {
+        push @parts,
+          'CONSTRAINT',
+          $self->quote_names( $constraint->{name} ),
+          'FOREIGN KEY',
+          $self->quote_names( $constraint->{name} ),
+          '(',
+          join( ', ', $self->quote_names( @{ $constraint->{columns} || [] } ) ),
+          ')',
+          'REFERENCES', $self->quote_names( $constraint->{foreignTable} ), '(',
+          join( ', ',
+            $self->quote_names( @{ $constraint->{foreignColumns} || [] } ) ),
+          ')';
+
+        if ( my $rule = uc( $constraint->{onDelete} ) ) {
+            grep $_ eq $rule, @fkRules
+              or die Exception->new( "Invalid onDelete rule specified",
+                $constraint->{name}, $rule );
+
+            push @parts, 'ON DELETE', $rule;
+        }
+
+        if ( my $rule = uc( $constraint->{onUpdate} ) ) {
+            grep $_ eq $rule, @fkRules
+              or die Exception->new( "Invalid onUpdate rule specified",
+                $constraint->{name}, $rule );
+
+            push @parts, 'ON UPDATE', $rule;
+        }
+
+    }
+    else {
+        if ( $constraint->constraintClass eq PrimaryKey ) {
+            push @parts, 'PRIMARY KEY';
+
+        }
+        elsif ( $constraint->constraintClass eq UniqueIndex ) {
+            push @parts, 'UNIQUE', $self->quote_names( $constraint->{name} );
+        }
+        elsif ( $constraint->constraintClass eq Index ) {
+            push @parts, 'INDEX', $self->quote_names( $constraint->{name} );
+        }
+        else {
+            die Exception->new( 'Invalid constraint type',
+                $constraint->constraintClass );
+        }
+
+        push @parts,
+          '(',
+          join( ', ', $self->quote_names( @{ $constraint->{columns} || [] } ) ),
+          ')';
+    }
+    
+    
+    return join ' ', @parts;
+}
+
+sub FormatAlterTableAddConstraint {
+    my ( $self, $op ) = @_;
+
+    return join(' ', 
+        'ALTER TABLE',
+        $self->quote_names( $op->tableName ),
+        'ADD',
+        $self->FormatConstraint($op->constraint),
+        ';'
+    );
+}
+
+sub FormatAlterTableDropConstraint {
+    my ( $self, $op, $constraintType ) = @_;
+
+    my @parts = ( 'ALTER TABLE', $self->quote_names( $op->tableName ), 'DROP' );
+
+    if ( $constraintType eq PrimaryKey ) {
+        push @parts, 'PRIMARY KEY';
+    }
+    elsif ( $constraintType eq ForeignKey ) {
+        push @parts, 'FOREIGN KEY', $self->quote_names( $op->constraintName );
+    }
+    elsif ( $constraintType eq UniqueIndex or $constraintType eq Index ) {
+        push @parts, 'INDEX', $self->quote_names( $op->constraintName );
+    }
+    else {
+        die Exception->new(
+            'Invalid constraint type', $op->tableName,
+            $op->constraintName,       $constraintType
+        );
+    }
+    
+    push @parts, ';';
+    
+    return join ' ', @parts;
+}
+
+sub Format {
+    my $self = shift;
+    my ($op) = @_;
+    
+    my $formatter = $TRAITS_FORMATS{ref $op}
+        or die OpException->new("Don't know how to format the specified operation", $op);
+        
+    $self->$formatter(@_);
+}
+
+sub _Column2Traits {
+    my ( $self, $column, %options ) = @_;
+
+    return new IMPL::SQL::Schema::Traits::Column(
+        $column->name,
+        $column->type,
+        isNullable   => $column->isNullable,
+        defaultValue => $column->defaultValue,
+        tag          => $column->tag,
+        %options
+    );
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+C<IMPL::SQL::Traits::MysqlFormatter> - преобразует операции над схемой в C<SQL>
+выражения.
+
+=head1 DESCRIPTION
+
+Используется для форматирования операций изменения схемы БД. Осуществляет
+правильное экранирование имен, форматирование значений, имен типов данных.
+
+=cut