| 
49
 | 
     1 package IMPL::SQL::Schema::Traits::mysql::Handler;
 | 
| 
 | 
     2 use strict;
 | 
| 
 | 
     3 use base qw(IMPL::Object);
 | 
| 
 | 
     4 use IMPL::Class::Property;
 | 
| 
 | 
     5 use IMPL::Class::Property::Direct;
 | 
| 
 | 
     6 
 | 
| 
 | 
     7 BEGIN {
 | 
| 
 | 
     8     public _direct property SqlBatch => prop_all;
 | 
| 
 | 
     9 }
 | 
| 
 | 
    10 
 | 
| 
 | 
    11 sub formatTypeNameInteger {
 | 
| 
 | 
    12     my ($type) = @_;
 | 
| 
 | 
    13     
 | 
| 
 | 
    14     return $type->Name.($type->MaxLength ? '('.$type->MaxLength.')' : '').($type->Unsigned ? ' UNSIGNED': '').($type->Zerofill ? ' ZEROFILL' : '');
 | 
| 
 | 
    15 }
 | 
| 
 | 
    16 
 | 
| 
 | 
    17 sub formatTypeNameReal {
 | 
| 
 | 
    18     my ($type) = @_;
 | 
| 
 | 
    19     
 | 
| 
 | 
    20     return $type->Name.($type->MaxLength ? '('.$type->MaxLength.', '.$type->Scale.')' : '').($type->Unsigned ? ' UNSIGNED': '').($type->Zerofill ? ' ZEROFILL' : '');
 | 
| 
 | 
    21 }
 | 
| 
 | 
    22 
 | 
| 
 | 
    23 sub formatTypeNameNumeric {
 | 
| 
 | 
    24     my ($type) = @_;
 | 
| 
 | 
    25     $type->MaxLength or die new IMPL::InvalidArgumentException('The length and precission must be specified',$type->Name);
 | 
| 
 | 
    26     return $type->Name.($type->MaxLength ? '('.$type->MaxLength.', '.$type->Scale.')' : '').($type->Unsigned ? ' UNSIGNED': '').($type->Zerofill ? ' ZEROFILL' : '');
 | 
| 
 | 
    27 }
 | 
| 
 | 
    28 
 | 
| 
 | 
    29 sub formatTypeName {
 | 
| 
 | 
    30     my ($type) = @_;
 | 
| 
 | 
    31     return $type->Name;
 | 
| 
 | 
    32 }
 | 
| 
 | 
    33 
 | 
| 
 | 
    34 sub formatTypeNameChar {
 | 
| 
 | 
    35     my ($type) = @_;
 | 
| 
 | 
    36     
 | 
| 
 | 
    37     return (
 | 
| 
 | 
    38         $type->Name.'('.$type->MaxLength.')'. (UNIVERSAL::isa($type,'IMPL::SQL::Schema::Type::mysql::CHAR') ? $type->Encoding : '')
 | 
| 
 | 
    39     );
 | 
| 
 | 
    40 }
 | 
| 
 | 
    41 
 | 
| 
 | 
    42 sub formatTypeNameVarChar {
 | 
| 
 | 
    43     my ($type) = @_;
 | 
| 
 | 
    44     
 | 
| 
 | 
    45     return (
 | 
| 
 | 
    46         $type->Name.'('.$type->MaxLength.')'. (UNIVERSAL::isa($type,'IMPL::SQL::Schema::Type::mysql::VARCHAR') ? $type->Encoding : '')
 | 
| 
 | 
    47     );
 | 
| 
 | 
    48 }
 | 
| 
 | 
    49 
 | 
| 
 | 
    50 sub formatTypeNameEnum {
 | 
| 
 | 
    51     my ($type) = @_;
 | 
| 
 | 
    52     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'));
 | 
| 
 | 
    53     return (
 | 
| 
 | 
    54         $type->Name.'('.join(',',map {quote($_)} $type->Values).')'
 | 
| 
 | 
    55     );
 | 
| 
 | 
    56 }
 | 
| 
 | 
    57 
 | 
| 
 | 
    58 sub quote{
 | 
| 
 | 
    59     if (wantarray) {
 | 
| 
 | 
    60         return map { my $str=$_; $str=~ s/'/''/g; "'$str'"; } @_;
 | 
| 
 | 
    61     } else {
 | 
| 
 | 
    62         return join '',map { my $str=$_; $str=~ s/'/''/g; "'$str'"; } @_;
 | 
| 
 | 
    63     }
 | 
| 
 | 
    64 }
 | 
| 
 | 
    65 
 | 
| 
 | 
    66 sub quote_names {
 | 
| 
 | 
    67     if (wantarray) {
 | 
| 
 | 
    68         return map { my $str=$_; $str=~ s/`/``/g; "`$str`"; } @_;
 | 
| 
 | 
    69     } else {
 | 
| 
 | 
    70         return join '',map { my $str=$_; $str=~ s/`/``/g; "`$str`"; } @_;
 | 
| 
 | 
    71     }
 | 
| 
 | 
    72 }
 | 
| 
 | 
    73 
 | 
| 
 | 
    74 sub formatStringValue {
 | 
| 
 | 
    75     my ($value) = @_;
 | 
| 
 | 
    76     
 | 
| 
 | 
    77     if (ref $value) {
 | 
| 
 | 
    78         if (UNIVERSAL::isa($value,'IMPL::SQL::Schema::mysql::Expression')) {
 | 
| 
 | 
    79             return $value->as_string;
 | 
| 
 | 
    80         } else {
 | 
| 
 | 
    81             die new Exception('Can\'t format the object as a value',ref $value);
 | 
| 
 | 
    82         }
 | 
| 
 | 
    83     } else {
 | 
| 
 | 
    84         return quote($value);
 | 
| 
 | 
    85     }
 | 
| 
 | 
    86 }
 | 
| 
 | 
    87 
 | 
| 
 | 
    88 
 | 
| 
 | 
    89 sub formatNumberValue {
 | 
| 
 | 
    90     my ($value) = @_;
 | 
| 
 | 
    91     
 | 
| 
 | 
    92     if (ref $value) {
 | 
| 
 | 
    93         if (UNIVERSAL::isa($value,'IMPL::SQL::Schema::mysql::Expression')) {
 | 
| 
 | 
    94             return $value->as_string;
 | 
| 
 | 
    95         } else {
 | 
| 
 | 
    96             die new Exception('Can\'t format the object as a value',ref $value);
 | 
| 
 | 
    97         }
 | 
| 
 | 
    98     } else {
 | 
| 
 | 
    99         $value =~ /^((\+|-)\s*)?\d+(\.\d+)?(e(\+|-)?\d+)?$/ or die new Exception('The specified value isn\'t a valid number',$value);
 | 
| 
 | 
   100         return $value;
 | 
| 
 | 
   101     }
 | 
| 
 | 
   102 }
 | 
| 
 | 
   103 
 | 
| 
 | 
   104 
 | 
| 
 | 
   105 my %TypesFormat = (
 | 
| 
 | 
   106     TINYINT => {
 | 
| 
 | 
   107         formatType => \&formatTypeNameInteger,
 | 
| 
 | 
   108         formatValue => \&formatNumberValue
 | 
| 
 | 
   109     },
 | 
| 
 | 
   110     SMALLINT => {
 | 
| 
 | 
   111         formatType => \&formatTypeNameInteger,
 | 
| 
 | 
   112         formatValue => \&formatNumberValue
 | 
| 
 | 
   113     },
 | 
| 
 | 
   114     MEDIUMINT => {
 | 
| 
 | 
   115         formatType => \&formatTypeNameInteger,
 | 
| 
 | 
   116         formatValue => \&formatNumberValue
 | 
| 
 | 
   117     },
 | 
| 
 | 
   118     INT => {
 | 
| 
 | 
   119         formatType => \&formatTypeNameInteger,
 | 
| 
 | 
   120         formatValue => \&formatNumberValue
 | 
| 
 | 
   121     },
 | 
| 
 | 
   122     INTEGER => {
 | 
| 
 | 
   123         formatType => \&formatTypeNameInteger,
 | 
| 
 | 
   124         formatValue => \&formatNumberValue
 | 
| 
 | 
   125     },
 | 
| 
 | 
   126     BIGINT => {
 | 
| 
 | 
   127         formatType => \&formatTypeNameInteger,
 | 
| 
 | 
   128         formatValue => \&formatNumberValue
 | 
| 
 | 
   129     },
 | 
| 
 | 
   130     REAL => {
 | 
| 
 | 
   131         formatType => \&formatTypeNameReal,
 | 
| 
 | 
   132         formatValue => \&formatNumberValue
 | 
| 
 | 
   133     },
 | 
| 
 | 
   134     DOUBLE => {
 | 
| 
 | 
   135         formatType => \&formatTypeNameReal,
 | 
| 
 | 
   136         formatValue => \&formatNumberValue
 | 
| 
 | 
   137     },
 | 
| 
 | 
   138     FLOAT => {
 | 
| 
 | 
   139         formatType => \&formatTypeNameReal,
 | 
| 
 | 
   140         formatValue => \&formatNumberValue
 | 
| 
 | 
   141     },
 | 
| 
 | 
   142     DECIMAL => {
 | 
| 
 | 
   143         formatType => \&formatTypeNameNumeric,
 | 
| 
 | 
   144         formatValue => \&formatNumberValue
 | 
| 
 | 
   145     },
 | 
| 
 | 
   146     NUMERIC => {
 | 
| 
 | 
   147         formatType => \&formatTypeNameNumeric,
 | 
| 
 | 
   148         formatValue => \&formatNumberValue
 | 
| 
 | 
   149     },
 | 
| 
 | 
   150     DATE => {
 | 
| 
 | 
   151         formatType => \&formatTypeName,
 | 
| 
 | 
   152         formatValue => \&formatStringValue
 | 
| 
 | 
   153     },
 | 
| 
 | 
   154     TIME => {
 | 
| 
 | 
   155         formatType => \&formatTypeName,
 | 
| 
 | 
   156         formatValue => \&formatStringValue
 | 
| 
 | 
   157     },
 | 
| 
 | 
   158     TIMESTAMP => {
 | 
| 
 | 
   159         formatType => \&formatTypeName,
 | 
| 
 | 
   160         formatValue => \&formatStringValue
 | 
| 
 | 
   161     },
 | 
| 
 | 
   162     DATETIME => {
 | 
| 
 | 
   163         formatType => \&formatTypeName,
 | 
| 
 | 
   164         formatValue => \&formatStringValue
 | 
| 
 | 
   165     },
 | 
| 
 | 
   166     CHAR => {
 | 
| 
 | 
   167         formatType => \&formatTypeNameChar,
 | 
| 
 | 
   168         formatValue => \&formatStringValue
 | 
| 
 | 
   169     },
 | 
| 
 | 
   170     VARCHAR => {
 | 
| 
 | 
   171         formatType => \&formatTypeNameVarChar,
 | 
| 
 | 
   172         formatValue => \&formatStringValue
 | 
| 
 | 
   173     },
 | 
| 
 | 
   174     TINYBLOB => {
 | 
| 
 | 
   175         formatType => \&formatTypeName,
 | 
| 
 | 
   176         formatValue => \&formatStringValue
 | 
| 
 | 
   177     },
 | 
| 
 | 
   178     BLOB => {
 | 
| 
 | 
   179         formatType => \&formatTypeName,
 | 
| 
 | 
   180         formatValue => \&formatStringValue
 | 
| 
 | 
   181     },
 | 
| 
 | 
   182     MEDIUMBLOB => {
 | 
| 
 | 
   183         formatType => \&formatTypeName,
 | 
| 
 | 
   184         formatValue => \&formatStringValue
 | 
| 
 | 
   185     },
 | 
| 
 | 
   186     LONGBLOB => {
 | 
| 
 | 
   187         formatType => \&formatTypeName,
 | 
| 
 | 
   188         formatValue => \&formatStringValue
 | 
| 
 | 
   189     },
 | 
| 
 | 
   190     TINYTEXT => {
 | 
| 
 | 
   191         formatType => \&formatTypeName,
 | 
| 
 | 
   192         formatValue => \&formatStringValue
 | 
| 
 | 
   193     },
 | 
| 
 | 
   194     TEXT => {
 | 
| 
 | 
   195         formatType => \&formatTypeName,
 | 
| 
 | 
   196         formatValue => \&formatStringValue
 | 
| 
 | 
   197     },
 | 
| 
 | 
   198     MEDIUMTEXT => {
 | 
| 
 | 
   199         formatType => \&formatTypeName,
 | 
| 
 | 
   200         formatValue => \&formatStringValue
 | 
| 
 | 
   201     },
 | 
| 
 | 
   202     LONGTEXT => {
 | 
| 
 | 
   203         formatType => \&formatTypeName,
 | 
| 
 | 
   204         formatValue => \&formatStringValue
 | 
| 
 | 
   205     },
 | 
| 
 | 
   206     ENUM => {
 | 
| 
 | 
   207         formatType => \&formatTypeNameEnum,
 | 
| 
 | 
   208         formatValue => \&formatStringValue
 | 
| 
 | 
   209     },
 | 
| 
 | 
   210     SET => {
 | 
| 
 | 
   211         formatType => \&formatTypeNameEnum,
 | 
| 
 | 
   212         formatValue => \&formatStringValue
 | 
| 
 | 
   213     }
 | 
| 
 | 
   214 );
 | 
| 
 | 
   215 
 | 
| 
 | 
   216 
 | 
| 
 | 
   217 =pod
 | 
| 
 | 
   218 CREATE TABLE 'test'.'New Table' (
 | 
| 
 | 
   219   'dd' INTEGER UNSIGNED NOT NULL AUTO_INCREMENT,
 | 
| 
 | 
   220   `ff` VARCHAR(45) NOT NULL,
 | 
| 
 | 
   221   `ffg` VARCHAR(45) NOT NULL DEFAULT 'aaa',
 | 
| 
 | 
   222   `ddf` INTEGER UNSIGNED NOT NULL,
 | 
| 
 | 
   223   PRIMARY KEY(`dd`),
 | 
| 
 | 
   224   UNIQUE `Index_2`(`ffg`),
 | 
| 
 | 
   225   CONSTRAINT `FK_New Table_1` FOREIGN KEY `FK_New Table_1` (`ddf`)
 | 
| 
 | 
   226     REFERENCES `user` (`id`)
 | 
| 
 | 
   227     ON DELETE RESTRICT
 | 
| 
 | 
   228     ON UPDATE RESTRICT
 | 
| 
 | 
   229 )
 | 
| 
 | 
   230 ENGINE = InnoDB;
 | 
| 
 | 
   231 =cut
 | 
| 
 | 
   232 sub formatCreateTable {
 | 
| 
 | 
   233     my ($table,$level,%options) = @_;
 | 
| 
 | 
   234     
 | 
| 
 | 
   235     my @sql;
 | 
| 
 | 
   236     
 | 
| 
 | 
   237     # table body
 | 
| 
 | 
   238     push @sql, map { formatColumn($_,$level+1) } @{$table->Columns} ;
 | 
| 
 | 
   239     if ($options{'skip_foreign_keys'}) {
 | 
| 
 | 
   240         push @sql, map { formatConstraint($_,$level+1) } grep {not UNIVERSAL::isa($_,'IMPL::SQL::Schema::Constraint::ForeignKey')} values %{$table->Constraints};
 | 
| 
 | 
   241     } else {
 | 
| 
 | 
   242         push @sql, map { formatConstraint($_,$level+1) } values %{$table->Constraints};
 | 
| 
 | 
   243     }
 | 
| 
 | 
   244     
 | 
| 
 | 
   245     for(my $i = 0 ; $i < @sql -1; $i++) {
 | 
| 
 | 
   246         $sql[$i] .= ',';
 | 
| 
 | 
   247     }
 | 
| 
 | 
   248     
 | 
| 
 | 
   249     unshift @sql, "CREATE TABLE ".quote_names($table->Name)."(";
 | 
| 
 | 
   250     
 | 
| 
 | 
   251     if ($table->Tag) {
 | 
| 
 | 
   252         push @sql, ")";
 | 
| 
 | 
   253         push @sql, formatTableTag($table->Tag,$level);
 | 
| 
 | 
   254         $sql[$#sql].=';';
 | 
| 
 | 
   255     } else {
 | 
| 
 | 
   256         push @sql, ');';
 | 
| 
 | 
   257     }
 | 
| 
 | 
   258     
 | 
| 
 | 
   259     return map { ("\t" x $level) . $_ } @sql;
 | 
| 
 | 
   260 }
 | 
| 
 | 
   261 
 | 
| 
 | 
   262 sub formatDropTable {
 | 
| 
 | 
   263     my ($tableName,$level) = @_;
 | 
| 
 | 
   264     
 | 
| 
 | 
   265     return "\t"x$level."DROP TABLE ".quote_names($tableName).";";
 | 
| 
 | 
   266 }
 | 
| 
 | 
   267 
 | 
| 
 | 
   268 sub formatTableTag {
 | 
| 
 | 
   269     my ($tag,$level) = @_;
 | 
| 
 | 
   270     return map { "\t"x$level . "$_ = ".$tag->{$_} } grep {/^(ENGINE)$/i} keys %{$tag};
 | 
| 
 | 
   271 }
 | 
| 
 | 
   272 
 | 
| 
 | 
   273 sub formatColumn {
 | 
| 
 | 
   274     my ($column,$level) = @_;
 | 
| 
 | 
   275     $level ||= 0;
 | 
| 
 | 
   276     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) : '');
 | 
| 
 | 
   277 }
 | 
| 
 | 
   278 
 | 
| 
 | 
   279 sub formatType {
 | 
| 
 | 
   280     my ($type) = @_;
 | 
| 
 | 
   281     my $format = $TypesFormat{uc $type->Name} or die new Exception('The unknown type name',$type->Name);
 | 
| 
 | 
   282     $format->{formatType}->($type);
 | 
| 
 | 
   283 }
 | 
| 
 | 
   284 
 | 
| 
 | 
   285 sub formatValueToType {
 | 
| 
 | 
   286     my ($value,$type) = @_;
 | 
| 
 | 
   287     
 | 
| 
 | 
   288     my $format = $TypesFormat{uc $type->Name} or die new Exception('The unknown type name',$type->Name);
 | 
| 
 | 
   289     $format->{formatValue}->($value);
 | 
| 
 | 
   290 }
 | 
| 
 | 
   291 
 | 
| 
 | 
   292 sub formatConstraint {
 | 
| 
 | 
   293     my ($constraint,$level) = @_;
 | 
| 
 | 
   294     
 | 
| 
 | 
   295     if (UNIVERSAL::isa($constraint,'IMPL::SQL::Schema::Constraint::ForeignKey')) {
 | 
| 
 | 
   296         return formatForeignKey($constraint,$level);
 | 
| 
 | 
   297     } else {
 | 
| 
 | 
   298         return formatIndex($constraint, $level);
 | 
| 
 | 
   299     }
 | 
| 
 | 
   300 }
 | 
| 
 | 
   301 
 | 
| 
 | 
   302 sub formatIndex {
 | 
| 
 | 
   303     my ($constraint,$level) = @_;
 | 
| 
 | 
   304     
 | 
| 
 | 
   305     my $name = quote_names($constraint->Name);
 | 
| 
 | 
   306     my $columns = join(',',map quote_names($_->Name),@{$constraint->Columns});
 | 
| 
 | 
   307     
 | 
| 
 | 
   308     if (ref $constraint eq 'IMPL::SQL::Schema::Constraint::PrimaryKey') {
 | 
| 
 | 
   309         return "\t"x$level."PRIMARY KEY ($columns)";
 | 
| 
 | 
   310     } elsif ($constraint eq 'IMPL::SQL::Schema::Constraint::Unique') {
 | 
| 
 | 
   311         return "\t"x$level."UNIQUE $name ($columns)";
 | 
| 
 | 
   312     } elsif ($constraint eq 'IMPL::SQL::Schema::Constraint::Index') {
 | 
| 
 | 
   313         return "\t"x$level."INDEX $name ($columns)";
 | 
| 
 | 
   314     } else {
 | 
| 
 | 
   315         die new IMPL::InvalidArgumentException('The unknown constraint', ref $constraint);
 | 
| 
 | 
   316     }
 | 
| 
 | 
   317     
 | 
| 
 | 
   318 }
 | 
| 
 | 
   319 
 | 
| 
 | 
   320 sub formatForeignKey {
 | 
| 
 | 
   321     my ($constraint,$level) = @_;
 | 
| 
 | 
   322     
 | 
| 
 | 
   323     my $name = quote_names($constraint->Name);
 | 
| 
 | 
   324     my $columns = join(',',map quote_names($_->Name),@{$constraint->Columns});
 | 
| 
 | 
   325     
 | 
| 
 | 
   326     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);
 | 
| 
 | 
   327     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);
 | 
| 
 | 
   328     
 | 
| 
 | 
   329     my $refname = quote_names($constraint->ReferencedPrimaryKey->Table->Name);
 | 
| 
 | 
   330     my $refcolumns = join(',',map quote_names($_->Name),@{$constraint->ReferencedPrimaryKey->Columns});
 | 
| 
 | 
   331     return (
 | 
| 
 | 
   332         "\t"x$level.
 | 
| 
 | 
   333         "CONSTRAINT $name FOREIGN KEY $name ($columns) REFERENCES $refname ($refcolumns)".
 | 
| 
 | 
   334         ($constraint->OnUpdate ? 'ON UPDATE'.$constraint->OnUpdate : '').
 | 
| 
 | 
   335         ($constraint->OnDelete ? 'ON DELETE'.$constraint->OnDelete : '')
 | 
| 
 | 
   336     );
 | 
| 
 | 
   337 }
 | 
| 
 | 
   338 
 | 
| 
 | 
   339 sub formatAlterTableRename {
 | 
| 
 | 
   340     my ($oldName,$newName,$level) = @_;
 | 
| 
 | 
   341     
 | 
| 
 | 
   342     return "\t"x$level."ALTER TABLE ".quote_names($oldName)." RENAME TO ".quote_names($newName).";";
 | 
| 
 | 
   343 }
 | 
| 
 | 
   344 
 | 
| 
 | 
   345 sub formatAlterTableDropColumn {
 | 
| 
 | 
   346     my ($tableName, $columnName,$level) = @_;
 | 
| 
 | 
   347     
 | 
| 
 | 
   348     return "\t"x$level."ALTER TABLE ".quote_names($tableName)." DROP COLUMN ".quote_names($columnName).";";
 | 
| 
 | 
   349 }
 | 
| 
 | 
   350 
 | 
| 
 | 
   351 =pod
 | 
| 
 | 
   352 ALTER TABLE `test`.`user` ADD COLUMN `my_col` VARCHAR(45) NOT NULL AFTER `name2`
 | 
| 
 | 
   353 =cut
 | 
| 
 | 
   354 sub formatAlterTableAddColumn {
 | 
| 
 | 
   355     my ($tableName, $column, $table, $pos, $level) = @_;
 | 
| 
 | 
   356     
 | 
| 
 | 
   357     my $posSpec = $pos == 0 ? 'FIRST' : 'AFTER '.quote_names($table->ColumnAt($pos-1)->Name);
 | 
| 
 | 
   358     
 | 
| 
 | 
   359     return "\t"x$level."ALTER TABLE ".quote_names($tableName)." ADD COLUMN ".formatColumn($column) .' '. $posSpec.";";
 | 
| 
 | 
   360 }
 | 
| 
 | 
   361 
 | 
| 
 | 
   362 =pod
 | 
| 
 | 
   363 ALTER TABLE `test`.`manager` MODIFY COLUMN `description` VARCHAR(256) NOT NULL DEFAULT NULL;
 | 
| 
 | 
   364 =cut
 | 
| 
 | 
   365 sub formatAlterTableChangeColumn {
 | 
| 
 | 
   366     my ($tableName,$column,$table,$pos,$level) = @_;
 | 
| 
 | 
   367     my $posSpec = $pos == 0 ? 'FIRST' : 'AFTER '.quote_names($table->ColumnAt($pos-1)->Name);
 | 
| 
 | 
   368     return "\t"x$level."ALTER TABLE ".quote_names($tableName)." MODIFY COLUMN ".formatColumn($column).' '. $posSpec.";";
 | 
| 
 | 
   369 }
 | 
| 
 | 
   370 
 | 
| 
 | 
   371 =pod
 | 
| 
 | 
   372 ALTER TABLE `test`.`manager` DROP INDEX `Index_2`;
 | 
| 
 | 
   373 =cut
 | 
| 
 | 
   374 sub formatAlterTableDropConstraint {
 | 
| 
 | 
   375     my ($tableName,$constraint,$level) = @_;
 | 
| 
 | 
   376     my $constraintName;
 | 
| 
 | 
   377     if (ref $constraint eq 'IMPL::SQL::Schema::Constraint::PrimaryKey') {
 | 
| 
 | 
   378         $constraintName = 'PRIMARY KEY';
 | 
| 
 | 
   379     } elsif (ref $constraint eq 'IMPL::SQL::Schema::Constraint::ForeignKey') {
 | 
| 
 | 
   380         $constraintName = 'FOREIGN KEY '.quote_names($constraint->Name);
 | 
| 
 | 
   381     } elsif (UNIVERSAL::isa($constraint,'IMPL::SQL::Schema::Constraint::Index')) {
 | 
| 
 | 
   382         $constraintName = 'INDEX '.quote_names($constraint->Name);
 | 
| 
 | 
   383     } else {
 | 
| 
 | 
   384         die new IMPL::Exception("The unknow type of the constraint",ref $constraint);
 | 
| 
 | 
   385     }
 | 
| 
 | 
   386     return "\t"x$level."ALTER TABLE ".quote_names($tableName)." DROP $constraintName;";
 | 
| 
 | 
   387 }
 | 
| 
 | 
   388 
 | 
| 
 | 
   389 =pod
 | 
| 
 | 
   390 ALTER TABLE `test`.`session` ADD INDEX `Index_2`(`id`, `name`);
 | 
| 
 | 
   391 =cut
 | 
| 
 | 
   392 sub formatAlterTableAddConstraint {
 | 
| 
 | 
   393     my ($tableName,$constraint,$level) = @_;
 | 
| 
 | 
   394     
 | 
| 
 | 
   395     return "\t"x$level."ALTER TABLE ".quote_names($tableName)." ADD ".formatConstraint($constraint,0).';';
 | 
| 
 | 
   396 }
 | 
| 
 | 
   397 
 | 
| 
 | 
   398 sub CreateTable {
 | 
| 
 | 
   399     my ($this,$tbl,%option) = @_;
 | 
| 
 | 
   400     
 | 
| 
 | 
   401     push @{$this->{$SqlBatch}},join("\n",formatCreateTable($tbl,0,%option));
 | 
| 
 | 
   402     
 | 
| 
 | 
   403     return 1;
 | 
| 
 | 
   404 }
 | 
| 
 | 
   405 
 | 
| 
 | 
   406 sub DropTable {
 | 
| 
 | 
   407     my ($this,$tbl) = @_;
 | 
| 
 | 
   408     
 | 
| 
 | 
   409     push @{$this->{$SqlBatch}},join("\n",formatDropTable($tbl,0));
 | 
| 
 | 
   410     
 | 
| 
 | 
   411     return 1;
 | 
| 
 | 
   412 }
 | 
| 
 | 
   413 
 | 
| 
 | 
   414 sub RenameTable {
 | 
| 
 | 
   415     my ($this,$oldName,$newName) = @_;
 | 
| 
 | 
   416     
 | 
| 
 | 
   417     push @{$this->{$SqlBatch}},join("\n",formatAlterTableRename($oldName,$newName,0));
 | 
| 
 | 
   418     
 | 
| 
 | 
   419     return 1;
 | 
| 
 | 
   420 }
 | 
| 
 | 
   421 
 | 
| 
 | 
   422 sub AlterTableAddColumn {
 | 
| 
 | 
   423     my ($this,$tblName,$column,$table,$pos) = @_;
 | 
| 
 | 
   424     
 | 
| 
 | 
   425     push @{$this->{$SqlBatch}},join("\n",formatAlterTableAddColumn($tblName,$column,$table,$pos,0));
 | 
| 
 | 
   426     
 | 
| 
 | 
   427     return 1;
 | 
| 
 | 
   428 }
 | 
| 
 | 
   429 sub AlterTableDropColumn {
 | 
| 
 | 
   430     my ($this,$tblName,$columnName) = @_;
 | 
| 
 | 
   431     
 | 
| 
 | 
   432     push @{$this->{$SqlBatch}},join("\n",formatAlterTableDropColumn($tblName,$columnName,0));
 | 
| 
 | 
   433     
 | 
| 
 | 
   434     return 1;
 | 
| 
 | 
   435 }
 | 
| 
 | 
   436 
 | 
| 
 | 
   437 sub AlterTableChangeColumn {
 | 
| 
 | 
   438     my ($this,$tblName,$column,$table,$pos) = @_;
 | 
| 
 | 
   439     
 | 
| 
 | 
   440     push @{$this->{$SqlBatch}},join("\n",formatAlterTableChangeColumn($tblName,$column,$table,$pos,0));
 | 
| 
 | 
   441     
 | 
| 
 | 
   442     return 1;
 | 
| 
 | 
   443 }
 | 
| 
 | 
   444 
 | 
| 
 | 
   445 sub AlterTableAddConstraint {
 | 
| 
 | 
   446     my ($this,$tblName,$constraint) = @_;
 | 
| 
 | 
   447     
 | 
| 
 | 
   448     push @{$this->{$SqlBatch}},join("\n",formatAlterTableAddConstraint($tblName,$constraint,0));
 | 
| 
 | 
   449     
 | 
| 
 | 
   450     return 1;
 | 
| 
 | 
   451 }
 | 
| 
 | 
   452 
 | 
| 
 | 
   453 sub AlterTableDropConstraint {
 | 
| 
 | 
   454     my ($this,$tblName,$constraint) = @_;
 | 
| 
 | 
   455     
 | 
| 
 | 
   456     push @{$this->{$SqlBatch}},join("\n",formatAlterTableDropConstraint($tblName,$constraint,0));
 | 
| 
 | 
   457     
 | 
| 
 | 
   458     return 1;
 | 
| 
 | 
   459 }
 | 
| 
 | 
   460 
 | 
| 
 | 
   461 sub Sql {
 | 
| 
 | 
   462     my ($this) = @_;
 | 
| 
 | 
   463     if (wantarray) {
 | 
| 
 | 
   464         @{$this->SqlBatch || []};
 | 
| 
 | 
   465     } else {
 | 
| 
 | 
   466         return join("\n",$this->SqlBatch);
 | 
| 
 | 
   467     }
 | 
| 
 | 
   468 }
 | 
| 
 | 
   469 
 | 
| 
 | 
   470 package IMPL::SQL::Schema::Traits::mysql;
 | 
| 
 | 
   471 use Common;
 | 
| 
 | 
   472 use base qw(IMPL::SQL::Schema::Traits);
 | 
| 
 | 
   473 use IMPL::Class::Property;
 | 
| 
 | 
   474 use IMPL::Class::Property::Direct;
 | 
| 
 | 
   475 
 | 
| 
 | 
   476 BEGIN {
 | 
| 
 | 
   477     public _direct property PendingConstraints => prop_none;
 | 
| 
 | 
   478 }
 | 
| 
 | 
   479 
 | 
| 
 | 
   480 our %CTOR = (
 | 
| 
 | 
   481     'IMPL::SQL::Schema::Traits' => sub {
 | 
| 
 | 
   482         my %args = @_;
 | 
| 
 | 
   483         $args{'Handler'} = new IMPL::SQL::Schema::Traits::mysql::Handler;
 | 
| 
 | 
   484         %args;
 | 
| 
 | 
   485     }
 | 
| 
 | 
   486 );
 | 
| 
 | 
   487 
 | 
| 
 | 
   488 sub DropConstraint {
 | 
| 
 | 
   489     my ($this,$constraint) = @_;
 | 
| 
 | 
   490     
 | 
| 
 | 
   491     if (UNIVERSAL::isa($constraint,'IMPL::SQL::Schema::Constraint::Index')) {
 | 
| 
 | 
   492         return 1 if not grep { $this->TableInfo->{$this->MapTableName($constraint->Table->Name)}->{'Columns'}->{$_->Name} != IMPL::SQL::Schema::Traits::STATE_REMOVED} $constraint->Columns;
 | 
| 
 | 
   493         my @constraints = grep {$_ != $constraint } $constraint->Table->GetColumnConstraints($constraint->Columns);
 | 
| 
 | 
   494         if (scalar @constraints == 1 and UNIVERSAL::isa($constraints[0],'IMPL::SQL::Schema::Constraint::ForeignKey')) {
 | 
| 
 | 
   495             my $fk = shift @constraints;
 | 
| 
 | 
   496             if ($this->TableInfo->{$this->MapTableName($fk->Table->Name)}->{'Constraints'}->{$fk->Name} != IMPL::SQL::Schema::Traits::STATE_REMOVED) {
 | 
| 
 | 
   497                 push @{$this->PendingActions}, {Action => \&DropConstraint, Args => [$constraint]};
 | 
| 
 | 
   498                 $this->{$PendingConstraints}->{$constraint->UniqName}->{'attempts'} ++;
 | 
| 
 | 
   499                 
 | 
| 
 | 
   500                 die new IMPL::Exception('Can\'t drop the primary key becouse of the foreing key',$fk->UniqName) if $this->{$PendingConstraints}->{$constraint->UniqName}->{'attempts'} > 2;
 | 
| 
 | 
   501                 return 2;
 | 
| 
 | 
   502             }
 | 
| 
 | 
   503         }
 | 
| 
 | 
   504     }
 | 
| 
 | 
   505     $this->SUPER::DropConstraint($constraint);
 | 
| 
 | 
   506 }
 | 
| 
 | 
   507 
 | 
| 
 | 
   508 sub GetMetaTable {
 | 
| 
 | 
   509     my ($class,$dbh) = @_;
 | 
| 
 | 
   510     
 | 
| 
 | 
   511     return IMPL::SQL::Schema::Traits::mysql::MetaTable->new( DBHandle => $dbh);
 | 
| 
 | 
   512 }
 | 
| 
 | 
   513 
 | 
| 
 | 
   514 package IMPL::SQL::Schema::Traits::mysql::MetaTable;
 | 
| 
 | 
   515 use Common;
 | 
| 
 | 
   516 use base qw(IMPL::Object);
 | 
| 
 | 
   517 use IMPL::Class::Property;
 | 
| 
 | 
   518 use IMPL::Class::Property::Direct;
 | 
| 
 | 
   519 
 | 
| 
 | 
   520 BEGIN {
 | 
| 
 | 
   521     public _direct property DBHandle => prop_none;
 | 
| 
 | 
   522 }
 | 
| 
 | 
   523 
 | 
| 
 | 
   524 sub ReadProperty {
 | 
| 
 | 
   525     my ($this,$name) = @_;
 | 
| 
 | 
   526     
 | 
| 
 | 
   527     local $this->{$DBHandle}->{PrintError};
 | 
| 
 | 
   528     $this->{$DBHandle}->{PrintError} = 0;
 | 
| 
 | 
   529     my ($val) = $this->{$DBHandle}->selectrow_array("SELECT value FROM _Meta WHERE name like ?", undef, $name);
 | 
| 
 | 
   530     return $val;
 | 
| 
 | 
   531 }
 | 
| 
 | 
   532 
 | 
| 
 | 
   533 sub SetProperty {
 | 
| 
 | 
   534     my ($this,$name,$val) = @_;
 | 
| 
 | 
   535     
 | 
| 
 | 
   536     if ( $this->{$DBHandle}->selectrow_arrayref("SELECT TABLE_NAME FROM information_schema.`TABLES` T where TABLE_SCHEMA like DATABASE() and TABLE_NAME like '_Meta'")) {
 | 
| 
 | 
   537         if ($this->{$DBHandle}->selectrow_arrayref("SELECT name FROM _Meta WHERE name like ?", undef, $name)) {
 | 
| 
 | 
   538             $this->{$DBHandle}->do("UPDATE _Meta SET value = ? WHERE name like ?",undef,$val,$name);
 | 
| 
 | 
   539         } else {
 | 
| 
 | 
   540             $this->{$DBHandle}->do("INSERT INTO _Meta(name,value) VALUES ('$name',?)",undef,$val);
 | 
| 
 | 
   541         }
 | 
| 
 | 
   542     } else {
 | 
| 
 | 
   543         $this->{$DBHandle}->do(q{
 | 
| 
 | 
   544             CREATE TABLE `_Meta` (
 | 
| 
 | 
   545                 `name` VARCHAR(255) NOT NULL,
 | 
| 
 | 
   546                 `value` LONGTEXT NULL,
 | 
| 
 | 
   547                 PRIMARY KEY(`name`)
 | 
| 
 | 
   548             );
 | 
| 
 | 
   549         }) or die new IMPL::Exception("Failed to create table","_Meta");
 | 
| 
 | 
   550         
 | 
| 
 | 
   551         $this->{$DBHandle}->do("INSERT INTO _Meta(name,value) VALUES (?,?)",undef,$name,$val);
 | 
| 
 | 
   552     }
 | 
| 
 | 
   553 }
 | 
| 
 | 
   554 
 | 
| 
 | 
   555 1;
 |