1package Alzabo::RDBMSRules::MySQL; 2 3use strict; 4use vars qw($VERSION); 5 6use Alzabo::RDBMSRules; 7 8use base qw(Alzabo::RDBMSRules); 9 10$VERSION = 2.0; 11 12sub new 13{ 14 my $proto = shift; 15 my $class = ref $proto || $proto; 16 17 return bless {}, $class; 18} 19 20sub validate_schema_name 21{ 22 my $self = shift; 23 my $name = shift->name; 24 25 Alzabo::Exception::RDBMSRules->throw( error => "Schema name must be at least one character long" ) 26 unless length $name; 27 28 # These are characters that are illegal in a dir name. I'm trying 29 # to accomodate both Win32 and UNIX here. 30 foreach my $c ( qw( : \ / ) ) 31 { 32 Alzabo::Exception::RDBMSRules->throw( error => "Schema name contains an illegal character ($c)" ) 33 if index($name, $c) != -1; 34 } 35} 36 37# Note: These rules are valid for MySQL 3.22.x. MySQL 3.23.x is 38# actually less restrictive but this should be enough freedom. 39 40sub validate_table_name 41{ 42 my $self = shift; 43 my $name = shift->name; 44 45 Alzabo::Exception::RDBMSRules->throw( error => "Table name must be at least one character long" ) 46 unless length $name; 47 Alzabo::Exception::RDBMSRules->throw( error => "Table name is too long. Names must be 64 characters or less." ) 48 if length $name >= 64; 49 Alzabo::Exception::RDBMSRules->throw( error => "Table name must only contain alphanumerics or underscore(_)." ) 50 if $name =~ /\W/; 51} 52 53sub validate_column_name 54{ 55 my $self = shift; 56 my $name = shift->name; 57 58 Alzabo::Exception::RDBMSRules->throw( error => "Column name must be at least one character long" ) 59 unless length $name; 60 Alzabo::Exception::RDBMSRules->throw( error => 'Name is too long. Names must be 64 characters or less.' ) 61 if length $name >= 64; 62 Alzabo::Exception::RDBMSRules->throw( error => 63 'Name contains characters that are not alphanumeric or the dollar sign ($).' ) 64 if $name =~ /[^\w\$]/; 65 Alzabo::Exception::RDBMSRules->throw( error => 66 'Name contains only digits. Names must contain at least one alpha character.' ) 67 unless $name =~ /[^\W\d]/; 68} 69 70sub validate_column_type 71{ 72 my $self = shift; 73 my $type = shift; 74 75 $type = 'INTEGER' if uc $type eq 'INT'; 76 77 # Columns which take no modifiers. 78 my %simple_types = map {$_ => 1} ( qw( DATE 79 DATETIME 80 TIME 81 TINYBLOB 82 TINYTEXT 83 BLOB 84 TEXT 85 MEDIUMBLOB 86 MEDIUMTEXT 87 LONGBLOB 88 LONGTEXT 89 INTEGER 90 TINYINT 91 SMALLINT 92 MEDIUMINT 93 BIGINT 94 FLOAT 95 DOUBLE 96 REAL 97 DECIMAL 98 NUMERIC 99 TIMESTAMP 100 CHAR 101 VARCHAR 102 YEAR 103 ), 104 ); 105 106 return uc $type if $simple_types{uc $type}; 107 108 return 'DOUBLE' if $type =~ /DOUBLE\s+PRECISION/i; 109 110 return 'CHAR' if $type =~ /\A(?:NATIONAL\s+)?CHAR(?:ACTER)?/i; 111 return 'VARCHAR' if $type =~ /\A(?:NATIONAL\s+)?(?:VARCHAR|CHARACTER VARYING)/i; 112 113 my $t = $self->_capitalize_type($type); 114 return $t if $t; 115 116 Alzabo::Exception::RDBMSRules->throw( error => "Unrecognized type: $type" ); 117} 118 119sub _capitalize_type 120{ 121 my $self = shift; 122 my $type = shift; 123 124 if ( uc substr($type, 0, 4) eq 'ENUM' ) 125 { 126 return 'ENUM' . substr($type, 4); 127 } 128 elsif ( uc substr($type, 0, 3) eq 'SET' ) 129 { 130 return 'SET' . substr($type, 3); 131 } 132 else 133 { 134 return uc $type; 135 } 136} 137 138sub validate_column_length 139{ 140 my $self = shift; 141 my $column = shift; 142 143 # integer column 144 if ( $column->type =~ /\A(?:(?:(?:TINY|SMALL|MEDIUM|BIG)?INT)|INTEGER)/i ) 145 { 146 Alzabo::Exception::RDBMSRules->throw( error => "Max display value is too long. Maximum allowed value is 255." ) 147 if defined $column->length && $column->length > 255; 148 149 Alzabo::Exception::RDBMSRules->throw( error => $column->type . " columns cannot have a precision." ) 150 if defined $column->precision; 151 return; 152 } 153 154 if ( $column->type =~ /\A(?:FLOAT|DOUBLE(?:\s+PRECISION)?|REAL)/i ) 155 { 156 if (defined $column->length) 157 { 158 Alzabo::Exception::RDBMSRules->throw( error => "Max display value is too long. Maximum allowed value is 255." ) 159 if $column->length > 255; 160 161 Alzabo::Exception::RDBMSRules->throw( error => "Max display value specified without floating point precision." ) 162 unless defined $column->precision; 163 164 Alzabo::Exception::RDBMSRules->throw( error => 165 "Floating point precision is too high. The maximum value is " . 166 "30 or the maximum display size - 2, whichever is smaller." ) 167 if $column->precision > 30 || $column->precision > ($column->length - $column->precision); 168 } 169 170 return; 171 } 172 173 if ( $column->type =~ /\A(?:DECIMAL|NUMERIC)\z/i ) 174 { 175 Alzabo::Exception::RDBMSRules->throw( error => "Max display value is too long. Maximum allowed value is 255." ) 176 if defined $column->length && $column->length > 255; 177 Alzabo::Exception::RDBMSRules->throw( error => 178 "Floating point precision is too high. The maximum value is " . 179 "30 or the maximum display size - 2, whichever is smaller." ) 180 if defined $column->precision && ($column->precision > 30 || $column->precision > ($column->length - 2) ); 181 return; 182 } 183 184 if ( uc $column->type eq 'TIMESTAMP' ) 185 { 186 Alzabo::Exception::RDBMSRules->throw( error => "Max display value is too long. Maximum allowed value is 14." ) 187 if defined $column->length && $column->length > 14; 188 Alzabo::Exception::RDBMSRules->throw( error => $column->type . " columns cannot have a precision." ) 189 if defined $column->precision; 190 return; 191 } 192 193 if ( $column->type =~ /\A(?:(?:NATIONAL\s+)?VAR)?(?:CHAR|BINARY)/i ) 194 { 195 Alzabo::Exception::RDBMSRules->throw( error => "(VAR)CHAR and (VAR)BINARY columns must have a length provided." ) 196 unless defined $column->length && $column->length > 0; 197 Alzabo::Exception::RDBMSRules->throw( error => "Max display value is too long. Maximum allowed value is 255." ) 198 if $column->length > 255; 199 Alzabo::Exception::RDBMSRules->throw( error => $column->type . " columns cannot have a precision." ) 200 if defined $column->precision; 201 return; 202 } 203 204 if ( uc $column->type eq 'YEAR' ) 205 { 206 Alzabo::Exception::RDBMSRules->throw( error => "Valid values for the length specification are 2 or 4." ) 207 if defined $column->length && ($column->length != 2 && $column->length != 4); 208 return; 209 } 210 211 Alzabo::Exception::RDBMSRules->throw( error => $column->type . " columns cannot have a length or precision." ) 212 if defined $column->length || defined $column->precision; 213} 214 215# placeholder in case we decide to try to do something better later 216sub validate_table_attribute { 1 } 217 218sub validate_column_attribute 219{ 220 my $self = shift; 221 my %p = @_; 222 223 my $column = $p{column}; 224 my $a = uc $p{attribute}; 225 $a =~ s/\A\s//; 226 $a =~ s/\s\z//; 227 228 if ( $a eq 'UNSIGNED' || $a eq 'ZEROFILL' ) 229 { 230 Alzabo::Exception::RDBMSRules->throw( error => "$a attribute can only be applied to numeric columns" ) 231 unless $column->is_numeric; 232 return; 233 } 234 235 if ( $a eq 'AUTO_INCREMENT' ) 236 { 237 Alzabo::Exception::RDBMSRules->throw( error => "$a attribute can only be applied to integer columns" ) 238 unless $column->is_integer; 239 return; 240 } 241 242 if ($a eq 'BINARY') 243 { 244 Alzabo::Exception::RDBMSRules->throw( error => "$a attribute can only be applied to character columns" ) 245 unless $column->is_character; 246 return; 247 } 248 249 return if $a =~ /\A(?:REFERENCES|UNIQUE\z)/i; 250 251 Alzabo::Exception::RDBMSRules->throw( error => "Unrecognized attribute: $a" ); 252} 253 254sub validate_primary_key 255{ 256 my $self = shift; 257 my $col = shift; 258 259 Alzabo::Exception::RDBMSRules->throw( error => 'Blob columns cannot be part of a primary key' ) 260 if $col->type =~ /\A(?:TINY|MEDIUM|LONG)?(?:BLOB|TEXT)\z/i; 261} 262 263sub validate_sequenced_attribute 264{ 265 my $self = shift; 266 my $col = shift; 267 268 Alzabo::Exception::RDBMSRules->throw( error => 'Non-integer columns cannot be sequenced' ) 269 unless $col->is_integer; 270 271 Alzabo::Exception::RDBMSRules->throw( error => 'Only one sequenced column per table is allowed.' ) 272 if grep { $_ ne $col && $_->sequenced } $col->table->columns; 273} 274 275sub validate_index 276{ 277 my $self = shift; 278 my $index = shift; 279 280 foreach my $c ( $index->columns ) 281 { 282 my $prefix = $index->prefix($c); 283 if (defined $prefix) 284 { 285 Alzabo::Exception::RDBMSRules->throw( error => "Invalid prefix specification ('$prefix')" ) 286 unless $prefix =~ /\d+/ && $prefix > 0; 287 288 Alzabo::Exception::RDBMSRules->throw( error => 'Non-character/blob columns cannot have an index prefix' ) 289 unless $c->is_blob || $c->is_character || $c->type =~ /^(?:VAR)BINARY$/i; 290 } 291 292 if ( $c->is_blob ) 293 { 294 Alzabo::Exception::RDBMSRules->throw( error => 'Blob columns must have an index prefix' ) 295 unless $prefix || $index->fulltext; 296 } 297 298 if ( $index->fulltext ) 299 { 300 Alzabo::Exception::RDBMSRules->throw( error => 'A fulltext index can only include text or char columns' ) 301 unless $c->is_character; 302 } 303 } 304 305 Alzabo::Exception::RDBMSRules->throw( error => 'An fulltext index cannot be unique' ) 306 if $index->unique && $index->fulltext; 307 308 Alzabo::Exception::RDBMSRules->throw( error => 'MySQL does not support function indexes' ) 309 if defined $index->function; 310} 311 312sub type_is_integer 313{ 314 my $self = shift; 315 my $col = shift; 316 my $type = uc $col->type; 317 318 return 1 if $type =~ /\A(?:(?:TINY|SMALL|MEDIUM|BIG)?INT|INTEGER)\z/; 319} 320 321sub type_is_floating_point 322{ 323 my $self = shift; 324 my $col = shift; 325 my $type = uc $col->type; 326 327 return 1 if $type =~ /\A(?:DECIMAL|NUMERIC|FLOAT|DOUBLE|REAL)\z/; 328} 329 330sub type_is_char 331{ 332 my $self = shift; 333 my $col = shift; 334 my $type = uc $col->type; 335 336 return 1 if $type =~ /(?:CHAR|TEXT)\z/; 337} 338 339sub type_is_date 340{ 341 my $self = shift; 342 my $col = shift; 343 my $type = uc $col->type; 344 345 return 1 if $type =~ /\A(?:DATE|DATETIME|TIMESTAMP)\z/; 346} 347 348sub type_is_datetime 349{ 350 my $self = shift; 351 my $col = shift; 352 my $type = uc $col->type; 353 354 if ( $type eq 'TIMESTAMP' ) 355 { 356 # default length is 14 357 return 1 unless defined $col->length; 358 return $col->length > 8; 359 } 360 361 return 1 if $type eq 'DATETIME'; 362} 363 364sub type_is_time 365{ 366 my $self = shift; 367 my $col = shift; 368 my $type = uc $col->type; 369 370 if ( $type eq 'TIMESTAMP' ) 371 { 372 return $col->length > 8; 373 } 374 375 return 1 if $type =~ /\A(?:DATETIME|TIME)\z/; 376} 377 378sub type_is_time_interval { 0 } 379 380sub type_is_blob 381{ 382 my $self = shift; 383 my $col = shift; 384 my $type = uc $col->type; 385 386 return 1 if $type =~ /BLOB\z/; 387} 388 389sub blob_type { return 'BLOB' } 390 391sub column_types 392{ 393 return qw( TINYINT 394 SMALLINT 395 MEDIUMINT 396 INTEGER 397 BIGINT 398 399 FLOAT 400 DOUBLE 401 DECIMAL 402 NUMERIC 403 404 CHAR 405 VARCHAR 406 407 DATE 408 DATETIME 409 TIME 410 TIMESTAMP 411 YEAR 412 413 TINYTEXT 414 TEXT 415 MEDIUMTEXT 416 LONGTEXT 417 418 TINYBLOB 419 BLOB 420 MEDIUMBLOB 421 LONGBLOB 422 ); 423} 424 425my %features = map { $_ => 1 } qw ( extended_column_types 426 index_prefix 427 fulltext_index 428 allows_raw_default 429 ); 430sub feature 431{ 432 shift; 433 return $features{+shift}; 434} 435 436sub schema_sql 437{ 438 my $self = shift; 439 my $schema = shift; 440 441 my @sql; 442 443 foreach my $t ( map { $self->_clean_table_name($_) } $schema->tables ) 444 { 445 push @sql, $self->table_sql($t); 446 } 447 448 # This has to come at the end because we don't which tables 449 # reference other tables. 450 foreach my $t ( $schema->tables ) 451 { 452 foreach my $fk ( $t->all_foreign_keys ) 453 { 454 push @sql, $self->foreign_key_sql($fk); 455 } 456 } 457 458 return @sql; 459} 460 461sub _clean_table_name 462{ 463 if ( $_[1] =~ /(?:`\w+`\.)?`(\w+)`/ ) 464 { 465 return $1; 466 } 467 468 return $_[1]; 469} 470 471sub table_sql 472{ 473 my $self = shift; 474 my $table = shift; 475 476 my $sql = "CREATE TABLE " . $table->name . " (\n "; 477 478 $sql .= join ",\n ", map { $self->column_sql($_) } $table->columns; 479 480 if (my @pk = $table->primary_key) 481 { 482 $sql .= ",\n"; 483 $sql .= ' PRIMARY KEY ('; 484 $sql .= join ', ', map {$_->name} @pk; 485 $sql .= ")"; 486 487 $sql .= "\n"; 488 } 489 $sql .= ")"; 490 491 if (my @att = $table->attributes) 492 { 493 $sql .= ' '; 494 $sql .= join ' ', @att; 495 } 496 497 my @sql = ($sql); 498 foreach my $i ( $table->indexes ) 499 { 500 push @sql, $self->index_sql($i); 501 } 502 503 return @sql; 504} 505 506sub column_sql 507{ 508 my $self = shift; 509 my $col = shift; 510 my $p = shift; # for skip_name 511 512 # make sure each one only happens once 513 my %attr = map { uc $_ => $_ } ( $col->attributes, 514 ($col->nullable ? 'NULL' : 'NOT NULL'), 515 ($col->sequenced ? 'AUTO_INCREMENT' : () ) ); 516 517 # unsigned attribute has to come right after type declaration, 518 # same with binary. No column could have both. 519 my @unsigned = $attr{UNSIGNED} ? delete $attr{UNSIGNED} : (); 520 my @binary = $attr{BINARY} ? delete $attr{BINARY} : (); 521 522 my @default; 523 if ( defined $col->default ) 524 { 525 my $def = $self->_default_for_column($col); 526 527 @default = ( qq|DEFAULT $def| ); 528 } 529 530 my $type = $col->type; 531 my @length; 532 if ( defined $col->length ) 533 { 534 my $length = '(' . $col->length; 535 $length .= ', ' . $col->precision if defined $col->precision; 536 $length .= ')'; 537 $type .= $length; 538 } 539 540 my @name = $p->{skip_name} ? () : $col->name; 541 my $sql .= join ' ', ( @name, 542 $type, 543 @unsigned, 544 @binary, 545 @default, 546 sort values %attr ); 547 548 return $sql; 549} 550 551sub index_sql 552{ 553 my $self = shift; 554 my $index = shift; 555 556 return if $self->{state}{index_sql}{ $index->id }; 557 558 my $index_name = $self->_make_index_name( $index->id ); 559 560 my $sql = 'CREATE'; 561 $sql .= ' UNIQUE' if $index->unique; 562 $sql .= ' FULLTEXT' if $index->fulltext; 563 $sql .= " INDEX $index_name ON " . $index->table->name . ' ( '; 564 565 $sql .= join ', ', ( map { my $sql = $_->name; 566 $sql .= '(' . $index->prefix($_) . ')' if $index->prefix($_); 567 $sql; } $index->columns ); 568 569 $sql .= ' )'; 570 571 return $sql; 572} 573 574sub _default_for_column 575{ 576 my $self = shift; 577 my $col = shift; 578 579 return $col->default if $col->is_numeric || $col->default_is_raw; 580 581 my $d = $col->default; 582 $d =~ s/"/""/g; 583 return qq|"$d"|; 584} 585 586sub _make_index_name 587{ 588 shift; 589 return substr(shift, 0, 64); 590} 591 592sub foreign_key_sql 593{ 594 # Bah, no ON UPDATE SET DEFAULT 595 return; 596 597 my $self = shift; 598 my $fk = shift; 599 600 if ( grep { $_->is_primary_key } $fk->columns_from ) 601 { 602 return unless $fk->from_is_dependent; 603 } 604 605 my @indexes; 606 foreach my $part ( qw( from to ) ) 607 { 608 my $found_index; 609 610 my $col_meth = "columns_$part"; 611 my @cols = $fk->$col_meth(); 612 613 my $table_meth = "table_$part"; 614 615 INDEX: 616 foreach my $i ( $fk->$table_meth()->indexes ) 617 { 618 my @c = $i->columns; 619 620 next unless @c == @cols; 621 622 for ( 0..$#c ) 623 { 624 next INDEX unless $c[$_]->name eq $cols[$_]->name; 625 } 626 627 $found_index = 1; 628 last; 629 } 630 631 unless ($found_index) 632 { 633 push @indexes, $fk->$table_meth()->make_index( columns => [ @cols ] ); 634 } 635 } 636 637 my $sql = 'ALTER TABLE '; 638 $sql .= $fk->table_from->name; 639 $sql .= ' ADD FOREIGN KEY ( '; 640 $sql .= join ', ', map { $_->name } $fk->columns_from; 641 $sql .= ' ) REFERENCES `'; 642 $sql .= $fk->table_to->name; 643 $sql .= '`( '; 644 $sql .= join ', ', map { $_->name } $fk->columns_to; 645 $sql .= ' ) ON DELETE '; 646 647 if ( $fk->from_is_dependent ) 648 { 649 $sql .= 'CASCADE'; 650 } 651 else 652 { 653 my @to = $fk->columns_to; 654 unless ( ( grep { $_->nullable } @to ) == @to ) 655 { 656 $sql .= 'SET DEFAULT'; 657 } 658 else 659 { 660 $sql .= 'SET NULL'; 661 } 662 } 663 664 $sql .= ' ON UPDATE CASCADE'; 665 666 return ( map { $self->index_sql($_) } @indexes ), $sql; 667} 668 669sub drop_column_sql 670{ 671 my $self = shift; 672 my %p = @_; 673 674 return 'ALTER TABLE ' . $p{new_table}->name . ' DROP COLUMN ' . $p{old}->name; 675} 676 677sub drop_foreign_key_sql 678{ 679 return; 680} 681 682sub drop_index_sql 683{ 684 my $self = shift; 685 my $index = shift; 686 # table name may have changed. 687 my $table_name = shift; 688 689 return 'DROP INDEX ' . $self->_make_index_name( $index->id ) . " ON $table_name"; 690} 691 692sub column_sql_add 693{ 694 my $self = shift; 695 my $col = shift; 696 697 my $sequenced = 0; 698 if ( ($sequenced = $col->sequenced) ) 699 { 700 $col->set_sequenced(0); 701 } 702 703 my $new_sql = $self->column_sql($col); 704 705 if ($sequenced) 706 { 707 $col->set_sequenced(1); 708 } 709 710 return 'ALTER TABLE ' . $col->table->name . ' ADD COLUMN ' . $new_sql; 711} 712 713sub column_sql_diff 714{ 715 my $self = shift; 716 my %p = @_; 717 my $new = $p{new}; 718 my $old = $p{old}; 719 720 my $sequenced = 0; 721 if ( ( $sequenced = $new->sequenced ) && ! $old->sequenced ) 722 { 723 $new->set_sequenced(0); 724 } 725 726 my $new_default = $new->default; 727 $new->set_default(undef) 728 if $self->_can_ignore_default( uc $new->type, $new_default ); 729 730 my $new_sql = $self->column_sql( $new, { skip_name => 1 } ); 731 732 $new->set_sequenced(1) if $sequenced; 733 $new->set_default($new_default) if defined $new_default; 734 735 my $old_default = $old->default; 736 $old->set_default(undef) 737 if $self->_can_ignore_default( uc $old->type, $new_default ); 738 my $old_sql = $self->column_sql( $old, { skip_name => 1 } ); 739 $old->set_default($old_default) if defined $old_default; 740 741 my @sql; 742 if ( $new_sql ne $old_sql || 743 ( $new->sequenced && ! $old->sequenced ) ) 744 { 745 my $sql = 746 ( 'ALTER TABLE ' . $new->table->name . ' CHANGE COLUMN ' . 747 $new->name . ' ' . $new->name . ' ' . $new_sql 748 ); 749 750 # can't have more than 1 auto_increment column per table (dumb!) 751 if ( ( $new->sequenced && ! $old->sequenced ) && 752 ! grep { $_ ne $new && $_->sequenced } $new->table->columns ) 753 { 754 $sql .= ' AUTO_INCREMENT' if $new->sequenced && ! $old->sequenced; 755 } 756 757 push @sql, $sql; 758 } 759 760 return @sql; 761} 762 763sub alter_primary_key_sql 764{ 765 my $self = shift; 766 my %p = @_; 767 768 my $new = $p{new}; 769 my $old = $p{old}; 770 771 my @sql; 772 push @sql, 'ALTER TABLE ' . $new->name . ' DROP PRIMARY KEY' 773 if $old->primary_key; 774 775 if ( $new->primary_key ) 776 { 777 my $sql = 'ALTER TABLE ' . $new->name . ' ADD PRIMARY KEY ( '; 778 $sql .= join ', ', map {$_->name} $new->primary_key; 779 $sql .= ')'; 780 781 push @sql, $sql; 782 } 783 784 foreach ( $new->primary_key ) 785 { 786 if ( $_->sequenced && 787 ! ( $old->has_column( $_->name ) && 788 $old->column( $_->name )->is_primary_key ) ) 789 { 790 my $sql = $self->column_sql($_); 791 push @sql, 792 'ALTER TABLE ' . $new->name . ' CHANGE COLUMN ' . $_->name . ' ' . $sql; 793 } 794 } 795 796 return @sql; 797} 798 799sub alter_table_name_sql 800{ 801 my $self = shift; 802 my $table = shift; 803 804 return 'RENAME TABLE ' . $table->former_name . ' TO ' . $table->name; 805} 806 807sub alter_table_attributes_sql 808{ 809 my $self = shift; 810 my %p = @_; 811 812 # This doesn't work right if new table has no attributes 813 return; 814 815 return 'ALTER TABLE ' . $p{new}->name . ' ' . join ' ', $p{new}->attributes; 816} 817 818sub alter_column_name_sql 819{ 820 my $self = shift; 821 my $column = shift; 822 823 return 824 ( 'ALTER TABLE ' . $column->table->name . ' CHANGE COLUMN ' . 825 $column->former_name . ' ' . $self->column_sql($column) 826 ); 827} 828 829sub reverse_engineer 830{ 831 my $self = shift; 832 my $schema = shift; 833 834 my $driver = $schema->driver; 835 836 my $has_table_types = 837 $driver->one_row( sql => 'SHOW VARIABLES LIKE ?', 838 bind => 'table_type' ); 839 840 foreach my $table ( $driver->tables ) 841 { 842 my $table_name = $self->_clean_table_name($table); 843 844 my $t = $schema->make_table( name => $table_name ); 845 846 foreach my $row ( $driver->rows( sql => "DESCRIBE $table" ) ) 847 { 848 my ($type, @a); 849 if ( $row->[1] =~ /\A(?:ENUM|SET)/i ) 850 { 851 $type = $row->[1]; 852 } 853 else 854 { 855 ($type, @a) = split /\s+/, $row->[1]; 856 } 857 858 my $default = $row->[4] if defined $row->[4] && uc $row->[4] ne 'NULL'; 859 860 my $seq = 0; 861 foreach my $a ( split /\s+/, $row->[5] ) 862 { 863 if ( uc $a eq 'AUTO_INCREMENT' ) 864 { 865 $seq = 1; 866 } 867 else 868 { 869 push @a, $a; 870 } 871 } 872 873 my %p; 874 if ( $type !~ /ENUM|SET/i 875 && $type =~ /(\w+)\((\d+)(?:\s*,\s*(\d+))?\)$/ ) 876 { 877 $type = uc $1; 878 $type = 'INTEGER' if $type eq 'INT'; 879 880 # skip defaults 881 unless ( $type eq 'TINYINT' && ( $2 == 4 || $2 == 3 ) || 882 $type eq 'SMALLINT' && ( $2 == 6 || $2 == 5 ) || 883 $type eq 'MEDIUMINT' && ( $2 == 9 || $2 == 8 ) || 884 $type eq 'INTEGER' && ( $2 == 11 || $2 == 10 ) || 885 $type eq 'BIGINT' && ( $2 == 21 || $2 == 20 ) || 886 $type eq 'YEAR' && $2 == 4 || 887 $type eq 'TIMESTAMP' && $2 == 14 888 ) 889 { 890 $p{length} = $2; 891 $p{precision} = $3; 892 } 893 } 894 895 $type = $self->_capitalize_type($type); 896 897 $default = undef 898 if $self->_can_ignore_default( $type, $default ); 899 900 my $c = $t->make_column( name => $row->[0], 901 type => $type, 902 nullable => $row->[2] eq 'YES', 903 sequenced => $seq, 904 default => $default, 905 attributes => \@a, 906 primary_key => $row->[3] eq 'PRI', 907 %p, 908 ); 909 } 910 911 my %i; 912 foreach my $row ( $driver->rows( sql => "SHOW INDEX FROM $table" ) ) 913 { 914 next if $row->[2] eq 'PRIMARY'; 915 916 my $type_i = $driver->major_version >= 4 ? 10 : 9; 917 $i{ $row->[2] }{fulltext} = 918 $row->[$type_i] && $row->[$type_i] =~ /fulltext/i ? 1 : 0; 919 920 $i{ $row->[2] }{cols}[ $row->[3] - 1 ]{column} = $t->column( $row->[4] ); 921 if ( defined $row->[7] ) 922 { 923 # MySQL (at least 4.0.17) reports a sub_part of 1 for 924 # the second column of a fulltext index. 925 if ( ! $i{ $row->[2] }{fulltext} || $row->[7] > 1 ) 926 { 927 $i{ $row->[2] }{cols}[ $row->[3] - 1 ]{prefix} = $row->[7] 928 } 929 } 930 931 $i{ $row->[2] }{unique} = $row->[1] ? 0 : 1; 932 933 } 934 935 foreach my $index (keys %i) 936 { 937 $t->make_index( columns => $i{$index}{cols}, 938 unique => $i{$index}{unique}, 939 fulltext => $i{$index}{fulltext} ); 940 } 941 942 if ( $has_table_types ) 943 { 944 my $table_type = 945 ( $driver->one_row( sql => 'SHOW TABLE STATUS LIKE ?', 946 bind => $table_name ) )[1]; 947 948 $t->add_attribute( 'TYPE=' . uc $table_type ); 949 } 950 } 951} 952 953my %ignored_defaults = ( DATETIME => '0000-00-00 00:00:00', 954 DATE => '0000-00-00', 955 YEAR => '0000', 956 CHAR => '', 957 VARCHAR => '', 958 TINTYTEXT => '', 959 SMALLTEXT => '', 960 MEDIUMTEXT => '', 961 TEXT => '', 962 LONGTEXT => '', 963 ); 964 965sub _can_ignore_default 966{ 967 my $self = shift; 968 my $type = shift; 969 my $default = shift; 970 971 return 1 unless defined $default; 972 973 return 1 974 if exists $ignored_defaults{$type} && $default eq $ignored_defaults{$type}; 975 976 if ( $type eq 'DECIMAL' ) 977 { 978 return 1 if $default =~ /0\.0+/; 979 } 980 981 if ( $type =~ /INT/ ) 982 { 983 return 1 unless $default; 984 } 985 986 return 0; 987} 988 989sub rules_id 990{ 991 return 'MySQL'; 992} 993 9941; 995 996__END__ 997 998=head1 NAME 999 1000Alzabo::RDBMSRules::MySQL - MySQL specific database rules. 1001 1002=head1 SYNOPSIS 1003 1004 use Alzabo::RDBMSRules::MySQL; 1005 1006=head1 DESCRIPTION 1007 1008This module implements all the methods descibed in Alzabo::RDBMSRules 1009for the MySQL database. The syntax rules follow the more restrictive 1010rules of version 3.22. 1011 1012=head1 AUTHOR 1013 1014Dave Rolsky, <dave@urth.org> 1015 1016=cut 1017