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