aliasing ugly tablename_fieldname ref methods where possible (ie create them
[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Parser / MySQL.pm
1 package SQL::Translator::Parser::MySQL;
2
3 # -------------------------------------------------------------------
4 # $Id: MySQL.pm,v 1.25 2003-06-11 03:59:49 kycl4rk Exp $
5 # -------------------------------------------------------------------
6 # Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>,
7 #                    darren chamberlain <darren@cpan.org>,
8 #                    Chris Mungall <cjm@fruitfly.org>
9 #
10 # This program is free software; you can redistribute it and/or
11 # modify it under the terms of the GNU General Public License as
12 # published by the Free Software Foundation; version 2.
13 #
14 # This program is distributed in the hope that it will be useful, but
15 # WITHOUT ANY WARRANTY; without even the implied warranty of
16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
17 # General Public License for more details.
18 #
19 # You should have received a copy of the GNU General Public License
20 # along with this program; if not, write to the Free Software
21 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
22 # 02111-1307  USA
23 # -------------------------------------------------------------------
24
25 =head1 NAME
26
27 SQL::Translator::Parser::MySQL - parser for MySQL
28
29 =head1 SYNOPSIS
30
31   use SQL::Translator;
32   use SQL::Translator::Parser::MySQL;
33
34   my $translator = SQL::Translator->new;
35   $translator->parser("SQL::Translator::Parser::MySQL");
36
37 =head1 DESCRIPTION
38
39 The grammar is influenced heavily by Tim Bunce's "mysql2ora" grammar.
40
41 Here's the word from the MySQL site
42 (http://www.mysql.com/doc/en/CREATE_TABLE.html):
43
44   CREATE [TEMPORARY] TABLE [IF NOT EXISTS] tbl_name [(create_definition,...)]
45   [table_options] [select_statement]
46   
47   or
48   
49   CREATE [TEMPORARY] TABLE [IF NOT EXISTS] tbl_name LIKE old_table_name;
50   
51   create_definition:
52     col_name type [NOT NULL | NULL] [DEFAULT default_value] [AUTO_INCREMENT]
53               [PRIMARY KEY] [reference_definition]
54     or    PRIMARY KEY (index_col_name,...)
55     or    KEY [index_name] (index_col_name,...)
56     or    INDEX [index_name] (index_col_name,...)
57     or    UNIQUE [INDEX] [index_name] (index_col_name,...)
58     or    FULLTEXT [INDEX] [index_name] (index_col_name,...)
59     or    [CONSTRAINT symbol] FOREIGN KEY [index_name] (index_col_name,...)
60               [reference_definition]
61     or    CHECK (expr)
62   
63   type:
64           TINYINT[(length)] [UNSIGNED] [ZEROFILL]
65     or    SMALLINT[(length)] [UNSIGNED] [ZEROFILL]
66     or    MEDIUMINT[(length)] [UNSIGNED] [ZEROFILL]
67     or    INT[(length)] [UNSIGNED] [ZEROFILL]
68     or    INTEGER[(length)] [UNSIGNED] [ZEROFILL]
69     or    BIGINT[(length)] [UNSIGNED] [ZEROFILL]
70     or    REAL[(length,decimals)] [UNSIGNED] [ZEROFILL]
71     or    DOUBLE[(length,decimals)] [UNSIGNED] [ZEROFILL]
72     or    FLOAT[(length,decimals)] [UNSIGNED] [ZEROFILL]
73     or    DECIMAL(length,decimals) [UNSIGNED] [ZEROFILL]
74     or    NUMERIC(length,decimals) [UNSIGNED] [ZEROFILL]
75     or    CHAR(length) [BINARY]
76     or    VARCHAR(length) [BINARY]
77     or    DATE
78     or    TIME
79     or    TIMESTAMP
80     or    DATETIME
81     or    TINYBLOB
82     or    BLOB
83     or    MEDIUMBLOB
84     or    LONGBLOB
85     or    TINYTEXT
86     or    TEXT
87     or    MEDIUMTEXT
88     or    LONGTEXT
89     or    ENUM(value1,value2,value3,...)
90     or    SET(value1,value2,value3,...)
91   
92   index_col_name:
93           col_name [(length)]
94   
95   reference_definition:
96           REFERENCES tbl_name [(index_col_name,...)]
97                      [MATCH FULL | MATCH PARTIAL]
98                      [ON DELETE reference_option]
99                      [ON UPDATE reference_option]
100   
101   reference_option:
102           RESTRICT | CASCADE | SET NULL | NO ACTION | SET DEFAULT
103   
104   table_options:
105           TYPE = {BDB | HEAP | ISAM | InnoDB | MERGE | MRG_MYISAM | MYISAM }
106   or      AUTO_INCREMENT = #
107   or      AVG_ROW_LENGTH = #
108   or      CHECKSUM = {0 | 1}
109   or      COMMENT = "string"
110   or      MAX_ROWS = #
111   or      MIN_ROWS = #
112   or      PACK_KEYS = {0 | 1 | DEFAULT}
113   or      PASSWORD = "string"
114   or      DELAY_KEY_WRITE = {0 | 1}
115   or      ROW_FORMAT= { default | dynamic | fixed | compressed }
116   or      RAID_TYPE= {1 | STRIPED | RAID0 } RAID_CHUNKS=#  RAID_CHUNKSIZE=#
117   or      UNION = (table_name,[table_name...])
118   or      INSERT_METHOD= {NO | FIRST | LAST }
119   or      DATA DIRECTORY="absolute path to directory"
120   or      INDEX DIRECTORY="absolute path to directory"
121
122 =cut
123
124 use strict;
125 use vars qw[ $DEBUG $VERSION $GRAMMAR @EXPORT_OK ];
126 $VERSION = sprintf "%d.%02d", q$Revision: 1.25 $ =~ /(\d+)\.(\d+)/;
127 $DEBUG   = 0 unless defined $DEBUG;
128
129 use Data::Dumper;
130 use Parse::RecDescent;
131 use Exporter;
132 use base qw(Exporter);
133
134 @EXPORT_OK = qw(parse);
135
136 # Enable warnings within the Parse::RecDescent module.
137 $::RD_ERRORS = 1; # Make sure the parser dies when it encounters an error
138 $::RD_WARN   = 1; # Enable warnings. This will warn on unused rules &c.
139 $::RD_HINT   = 1; # Give out hints to help fix problems.
140
141 $GRAMMAR = q!
142
143
144     our ( %tables, $table_order );
145 }
146
147 #
148 # The "eofile" rule makes the parser fail if any "statement" rule
149 # fails.  Otherwise, the first successful match by a "statement" 
150 # won't cause the failure needed to know that the parse, as a whole,
151 # failed. -ky
152 #
153 startrule : statement(s) eofile { \%tables }
154
155 eofile : /^\Z/
156
157 statement : comment
158     | use
159     | drop
160     | create
161     | <error>
162
163 use : /use/i WORD ';'
164
165 drop : /drop/i WORD(s) ';'
166
167 create : CREATE /database/i WORD ';'
168
169 create : CREATE TEMPORARY(?) TABLE opt_if_not_exists(?) table_name '(' create_definition(s /,/) ')' table_option(s?) ';'
170     { 
171         my $table_name                       = $item{'table_name'};
172         $tables{ $table_name }{'order'}      = ++$table_order;
173         $tables{ $table_name }{'table_name'} = $table_name;
174
175         my $i = 1;
176         for my $definition ( @{ $item[7] } ) {
177             if ( $definition->{'supertype'} eq 'field' ) {
178
179                 my $field_name = $definition->{'name'};
180                 $tables{ $table_name }{'fields'}{ $field_name } = 
181                     { %$definition, order => $i };
182                 $i++;
183         
184                 if ( $definition->{'is_primary_key'} ) {
185                     push @{ $tables{ $table_name }{'constraints'} },
186                         {
187                             type   => 'primary_key',
188                             fields => [ $field_name ],
189                         }
190                     ;
191                 }
192             }
193             elsif ( $definition->{'supertype'} eq 'constraint' ) {
194                 # prob get rid of this?
195 #                for my $field ( @{ $definition->{'fields'} } ) {
196 #                    push @{ 
197 #                        $tables{$table_name}{'fields'}{$field}{'constraints'}
198 #                    },
199 #                    $definition; 
200 #                }
201
202                 # this should be the only one needed
203                 push @{ $tables{ $table_name }{'constraints'} }, $definition;
204             }
205             elsif ( $definition->{'supertype'} eq 'index' ) {
206                 push @{ $tables{ $table_name }{'indices'} },
207                     $definition;
208             }
209         }
210
211         for my $opt ( @{ $item{'table_option(s?)'} } ) {
212             if ( my ( $key, $val ) = each %$opt ) {
213                 $tables{ $table_name }{'table_options'}{ $key } = $val;
214             }
215         }
216
217         1;
218     }
219
220 opt_if_not_exists : /if not exists/i
221
222 create : CREATE UNIQUE(?) /(index|key)/i index_name /on/i table_name '(' field_name(s /,/) ')' ';'
223     {
224         push @{ $tables{ $item{'table_name'} }{'indices'} },
225             {
226                 name   => $item[4],
227                 type   => $item[2] ? 'unique' : 'normal',
228                 fields => $item[8],
229             }
230         ;
231     }
232
233 create_definition : constraint 
234     | index
235     | field
236     | <error>
237
238 comment : /^\s*(?:#|-{2}).*\n/
239
240 blank : /\s*/
241
242 field : field_name data_type field_qualifier(s?) reference_definition(?)
243     { 
244         my %qualifiers = map { %$_ } @{ $item{'field_qualifier(s?)'} || [] };
245         my $null = defined $item{'not_null'} ? $item{'not_null'} : 1;
246         delete $qualifiers{'not_null'};
247         if ( my @type_quals = @{ $item{'data_type'}{'qualifiers'} || [] } ) {
248             $qualifiers{ $_ } = 1 for @type_quals;
249         }
250
251         $return = { 
252             supertype   => 'field',
253             name        => $item{'field_name'}, 
254             data_type   => $item{'data_type'}{'type'},
255             size        => $item{'data_type'}{'size'},
256             list        => $item{'data_type'}{'list'},
257             null        => $null,
258             constraints => $item{'reference_definition(?)'},
259             %qualifiers,
260         } 
261     }
262     | <error>
263
264 field_qualifier : not_null
265     { 
266         $return = { 
267              null => $item{'not_null'},
268         } 
269     }
270
271 field_qualifier : default_val
272     { 
273         $return = { 
274              default => $item{'default_val'},
275         } 
276     }
277
278 field_qualifier : auto_inc
279     { 
280         $return = { 
281              is_auto_inc => $item{'auto_inc'},
282         } 
283     }
284
285 field_qualifier : primary_key
286     { 
287         $return = { 
288              is_primary_key => $item{'primary_key'},
289         } 
290     }
291
292 field_qualifier : unsigned
293     { 
294         $return = { 
295              is_unsigned => $item{'unsigned'},
296         } 
297     }
298
299 reference_definition : /references/i table_name parens_field_list(?) match_type(?) on_delete_do(?) on_update_do(?)
300     {
301         $return = {
302             type             => 'foreign_key',
303             reference_table  => $item[2],
304             reference_fields => $item[3][0],
305             match_type       => $item[4][0],
306             on_delete_do     => $item[5][0],
307             on_update_do     => $item[6][0],
308         }
309     }
310
311 match_type : /match full/i { 'match_full' }
312     |
313     /match partial/i { 'match_partial' }
314
315 on_delete_do : /on delete/i reference_option
316     { $item[2] }
317
318 on_update_do : /on update/i reference_option
319     { $item[2] }
320
321 reference_option: /restrict/i | 
322     /cascade/i   | 
323     /set null/i  | 
324     /no action/i | 
325     /set default/i
326     { $item[1] }  
327
328 index : normal_index
329     | fulltext_index
330     | <error>
331
332 table_name   : WORD
333
334 field_name   : WORD
335
336 index_name   : WORD
337
338 data_type    : WORD parens_value_list(s?) type_qualifier(s?)
339     { 
340         my $type = $item[1];
341         my $size; # field size, applicable only to non-set fields
342         my $list; # set list, applicable only to sets (duh)
343
344         if ( uc($type) =~ /^(SET|ENUM)$/ ) {
345             $size = undef;
346             $list = $item[2][0];
347         }
348         else {
349             $size = $item[2][0];
350             $list = [];
351         }
352
353         unless ( @{ $size || [] } ) {
354             if ( lc $type eq 'tinyint' ) {
355                 $size = [4];
356             }
357             elsif ( lc $type eq 'smallint' ) {
358                 $size = [6];
359             }
360             elsif ( lc $type eq 'mediumint' ) {
361                 $size = [9];
362             }
363             elsif ( $type =~ /^int(eger)?$/ ) {
364                 $type = 'int';
365                 $size = [11];
366             }
367             elsif ( lc $type eq 'bigint' ) {
368                 $size = [20];
369             }
370             elsif ( lc $type =~ /(float|double|decimal|numeric|real)/ ) {
371                 $size = [8,2];
372             }
373         }
374
375         $return        = { 
376             type       => $type,
377             size       => $size,
378             list       => $list,
379             qualifiers => $item[3],
380         } 
381     }
382
383 parens_field_list : '(' field_name(s /,/) ')'
384     { $item[2] }
385
386 parens_value_list : '(' VALUE(s /,/) ')'
387     { $item[2] }
388
389 type_qualifier : /(BINARY|UNSIGNED|ZEROFILL)/i
390     { lc $item[1] }
391
392 field_type   : WORD
393
394 create_index : /create/i /index/i
395
396 not_null     : /not/i /null/i { $return = 0 }
397
398 unsigned     : /unsigned/i { $return = 0 }
399
400 default_val  : /default/i /(?:')?[\w\d:.-]*(?:')?/ 
401     { 
402         $item[2] =~ s/'//g; 
403         $return  =  $item[2];
404     }
405
406 auto_inc : /auto_increment/i { 1 }
407
408 primary_key : /primary/i /key/i { 1 }
409
410 constraint : primary_key_def
411     | unique_key_def
412     | foreign_key_def
413     | <error>
414
415 foreign_key_def : opt_constraint(?) /foreign key/i WORD(?) parens_field_list reference_definition
416     {
417         $return              =  {
418             supertype        => 'constraint',
419             type             => 'foreign_key',
420             name             => $item[3][0],
421             fields           => $item[4],
422             %{ $item{'reference_definition'} },
423         }
424     }
425
426 opt_constraint : /constraint/i WORD
427
428 primary_key_def : primary_key index_name(?) '(' field_name(s /,/) ')'
429     { 
430         $return       = { 
431             supertype => 'constraint',
432             name      => $item{'index_name(?)'}[0],
433             type      => 'primary_key',
434             fields    => $item[4],
435         };
436     }
437
438 unique_key_def : UNIQUE KEY(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
439     { 
440         $return       = { 
441             supertype => 'constraint',
442             name      => $item{'index_name(?)'}[0],
443             type      => 'unique',
444             fields    => $item[5],
445         } 
446     }
447
448 normal_index : KEY index_name(?) '(' name_with_opt_paren(s /,/) ')'
449     { 
450         $return       = { 
451             supertype => 'index',
452             type      => 'normal',
453             name      => $item{'index_name(?)'}[0],
454             fields    => $item[4],
455         } 
456     }
457
458 fulltext_index : /fulltext/i KEY(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
459     { 
460         $return       = { 
461             supertype => 'index',
462             type      => 'fulltext',
463             name      => $item{'index_name(?)'}[0],
464             fields    => $item[5],
465         } 
466     }
467
468 name_with_opt_paren : NAME parens_value_list(s?)
469     { $item[2][0] ? "$item[1]($item[2][0][0])" : $item[1] }
470
471 UNIQUE : /unique/i { 1 }
472
473 KEY : /key/i | /index/i
474
475 table_option : /[^\s;]*/ 
476     { 
477         $return = { split /=/, $item[1] }
478     }
479
480 CREATE : /create/i
481
482 TEMPORARY : /temporary/i
483
484 TABLE : /table/i
485
486 WORD : /\w+/
487
488 DIGITS : /\d+/
489
490 COMMA : ','
491
492 NAME    : "`" /\w+/ "`"
493     { $item[2] }
494     | /\w+/
495     { $item[1] }
496
497 VALUE   : /[-+]?\.?\d+(?:[eE]\d+)?/
498     { $item[1] }
499     | /'.*?'/   
500     { 
501         # remove leading/trailing quotes 
502         my $val = $item[1];
503         $val    =~ s/^['"]|['"]$//g;
504         $return = $val;
505     }
506     | /NULL/
507     { 'NULL' }
508
509 !;
510
511 # -------------------------------------------------------------------
512 sub parse {
513     my ( $translator, $data ) = @_;
514     my $parser = Parse::RecDescent->new($GRAMMAR);
515
516     local $::RD_TRACE  = $translator->trace ? 1 : undef;
517     local $DEBUG       = $translator->debug;
518
519     unless (defined $parser) {
520         return $translator->error("Error instantiating Parse::RecDescent ".
521             "instance: Bad grammer");
522     }
523
524     my $result = $parser->startrule($data);
525     return $translator->error( "Parse failed." ) unless defined $result;
526     warn Dumper( $result ) if $DEBUG;
527
528     my $schema = $translator->schema;
529     my @tables = sort { 
530         $result->{ $a }->{'order'} <=> $result->{ $b }->{'order'}
531     } keys %{ $result };
532
533     for my $table_name ( @tables ) {
534         my $tdata =  $result->{ $table_name };
535         my $table =  $schema->add_table( 
536             name  => $tdata->{'table_name'},
537         ) or die $schema->error;
538
539 #        for my $opt ( @{ $tdata->{'table_options'} } ) {
540 #            if ( my ( $key, $val ) = each %$opt ) {
541 #                $tables->options( 
542 #            }
543 #        }
544
545         my @fields = sort { 
546             $tdata->{'fields'}->{$a}->{'order'} 
547             <=>
548             $tdata->{'fields'}->{$b}->{'order'}
549         } keys %{ $tdata->{'fields'} };
550
551         for my $fname ( @fields ) {
552             my $fdata = $tdata->{'fields'}{ $fname };
553             my $field = $table->add_field(
554                 name              => $fdata->{'name'},
555                 data_type         => $fdata->{'data_type'},
556                 size              => $fdata->{'size'},
557                 default_value     => $fdata->{'default'},
558                 is_auto_increment => $fdata->{'is_auto_inc'},
559                 is_nullable       => $fdata->{'null'},
560             ) or die $table->error;
561
562             $table->primary_key( $field->name ) if $fdata->{'is_primary_key'};
563
564             for my $qual ( qw[ binary unsigned zerofill list ] ) {
565                 if ( my $val = $fdata->{ $qual } || $fdata->{ uc $qual } ) {
566                     next if ref $val eq 'ARRAY' && !@$val;
567                     $field->extra( $qual, $val );
568                 }
569             }
570
571             if ( $field->data_type =~ /(set|enum)/i && !$field->size ) {
572                 my %extra = $field->extra;
573                 my $longest;
574                 for my $len ( map { length } @{ $extra{'list'} || [] } ) {
575                     $longest = $len if $len > $longest;
576                 }
577                 $field->size( $longest ) if $longest;
578             }
579
580             for my $cdata ( @{ $fdata->{'constraints'} } ) {
581                 next unless $cdata->{'type'} eq 'foreign_key';
582                 $cdata->{'fields'} ||= [ $field->name ];
583                 push @{ $tdata->{'constraints'} }, $cdata;
584             }
585         }
586
587         for my $idata ( @{ $tdata->{'indices'} || [] } ) {
588             my $index  =  $table->add_index(
589                 name   => $idata->{'name'},
590                 type   => uc $idata->{'type'},
591                 fields => $idata->{'fields'},
592             ) or die $table->error;
593         }
594
595         for my $cdata ( @{ $tdata->{'constraints'} || [] } ) {
596             my $constraint       =  $table->add_constraint(
597                 name             => $cdata->{'name'},
598                 type             => $cdata->{'type'},
599                 fields           => $cdata->{'fields'},
600                 reference_table  => $cdata->{'reference_table'},
601                 reference_fields => $cdata->{'reference_fields'},
602                 match_type       => $cdata->{'match_type'} || '',
603                 on_delete        => $cdata->{'on_delete_do'},
604                 on_update        => $cdata->{'on_update_do'},
605             ) or die $table->error;
606         }
607     }
608
609     return 1;
610 }
611
612 1;
613
614 # -------------------------------------------------------------------
615 # Where man is not nature is barren.
616 # William Blake
617 # -------------------------------------------------------------------
618
619 =pod
620
621 =head1 AUTHOR
622
623 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>,
624 Chris Mungall E<lt>cjm@fruitfly.orgE<gt>.
625
626 =head1 SEE ALSO
627
628 perl(1), Parse::RecDescent, SQL::Translator::Schema.
629
630 =cut