File Coverage

blib/lib/SQL/Translator/Parser/MySQL.pm
Criterion Covered Total %
statement 139 154 90.2
branch 75 102 73.5
condition 27 37 72.9
subroutine 10 10 100.0
pod 0 2 0.0
total 251 305 82.3


line stmt bran cond sub pod time code
1             package SQL::Translator::Parser::MySQL;
2              
3             =head1 NAME
4              
5             SQL::Translator::Parser::MySQL - parser for MySQL
6              
7             =head1 SYNOPSIS
8              
9             use SQL::Translator;
10             use SQL::Translator::Parser::MySQL;
11              
12             my $translator = SQL::Translator->new;
13             $translator->parser("SQL::Translator::Parser::MySQL");
14              
15             =head1 DESCRIPTION
16              
17             The grammar is influenced heavily by Tim Bunce's "mysql2ora" grammar.
18              
19             Here's the word from the MySQL site
20             (http://www.mysql.com/doc/en/CREATE_TABLE.html):
21              
22             CREATE [TEMPORARY] TABLE [IF NOT EXISTS] tbl_name [(create_definition,...)]
23             [table_options] [select_statement]
24              
25             or
26              
27             CREATE [TEMPORARY] TABLE [IF NOT EXISTS] tbl_name LIKE old_table_name;
28              
29             create_definition:
30             col_name type [NOT NULL | NULL] [DEFAULT default_value] [AUTO_INCREMENT]
31             [PRIMARY KEY] [reference_definition]
32             or PRIMARY KEY (index_col_name,...)
33             or KEY [index_name] (index_col_name,...)
34             or INDEX [index_name] (index_col_name,...)
35             or UNIQUE [INDEX] [index_name] (index_col_name,...)
36             or FULLTEXT [INDEX] [index_name] (index_col_name,...)
37             or [CONSTRAINT symbol] FOREIGN KEY [index_name] (index_col_name,...)
38             [reference_definition]
39             or CHECK (expr)
40              
41             type:
42             TINYINT[(length)] [UNSIGNED] [ZEROFILL]
43             or SMALLINT[(length)] [UNSIGNED] [ZEROFILL]
44             or MEDIUMINT[(length)] [UNSIGNED] [ZEROFILL]
45             or INT[(length)] [UNSIGNED] [ZEROFILL]
46             or INTEGER[(length)] [UNSIGNED] [ZEROFILL]
47             or BIGINT[(length)] [UNSIGNED] [ZEROFILL]
48             or REAL[(length,decimals)] [UNSIGNED] [ZEROFILL]
49             or DOUBLE[(length,decimals)] [UNSIGNED] [ZEROFILL]
50             or FLOAT[(length,decimals)] [UNSIGNED] [ZEROFILL]
51             or DECIMAL(length,decimals) [UNSIGNED] [ZEROFILL]
52             or NUMERIC(length,decimals) [UNSIGNED] [ZEROFILL]
53             or CHAR(length) [BINARY]
54             or VARCHAR(length) [BINARY]
55             or DATE
56             or TIME
57             or TIMESTAMP
58             or DATETIME
59             or TINYBLOB
60             or BLOB
61             or MEDIUMBLOB
62             or LONGBLOB
63             or TINYTEXT
64             or TEXT
65             or MEDIUMTEXT
66             or LONGTEXT
67             or ENUM(value1,value2,value3,...)
68             or SET(value1,value2,value3,...)
69              
70             index_col_name:
71             col_name [(length)]
72              
73             reference_definition:
74             REFERENCES tbl_name [(index_col_name,...)]
75             [MATCH FULL | MATCH PARTIAL]
76             [ON DELETE reference_option]
77             [ON UPDATE reference_option]
78              
79             reference_option:
80             RESTRICT | CASCADE | SET NULL | NO ACTION | SET DEFAULT
81              
82             table_options:
83             TYPE = {BDB | HEAP | ISAM | InnoDB | MERGE | MRG_MYISAM | MYISAM }
84             or ENGINE = {BDB | HEAP | ISAM | InnoDB | MERGE | MRG_MYISAM | MYISAM }
85             or AUTO_INCREMENT = #
86             or AVG_ROW_LENGTH = #
87             or [ DEFAULT ] CHARACTER SET charset_name
88             or CHECKSUM = {0 | 1}
89             or COLLATE collation_name
90             or COMMENT = "string"
91             or MAX_ROWS = #
92             or MIN_ROWS = #
93             or PACK_KEYS = {0 | 1 | DEFAULT}
94             or PASSWORD = "string"
95             or DELAY_KEY_WRITE = {0 | 1}
96             or ROW_FORMAT= { default | dynamic | fixed | compressed }
97             or RAID_TYPE= {1 | STRIPED | RAID0 } RAID_CHUNKS=# RAID_CHUNKSIZE=#
98             or UNION = (table_name,[table_name...])
99             or INSERT_METHOD= {NO | FIRST | LAST }
100             or DATA DIRECTORY="absolute path to directory"
101             or INDEX DIRECTORY="absolute path to directory"
102              
103              
104             A subset of the ALTER TABLE syntax that allows addition of foreign keys:
105              
106             ALTER [IGNORE] TABLE tbl_name alter_specification [, alter_specification] ...
107              
108             alter_specification:
109             ADD [CONSTRAINT [symbol]]
110             FOREIGN KEY [index_name] (index_col_name,...)
111             [reference_definition]
112              
113             A subset of INSERT that we ignore:
114              
115             INSERT anything
116              
117             =head1 ARGUMENTS
118              
119             This parser takes a single optional parser_arg C, which
120             provides the desired version for the target database. Any statement in the processed
121             dump file, that is commented with a version higher than the one supplied, will be stripped.
122              
123             The default C is set to the conservative value of 40000 (MySQL 4.0)
124              
125             Valid version specifiers for C are listed L
126              
127             More information about the MySQL comment-syntax: L
128              
129              
130             =cut
131              
132 16     16   2445 use strict;
  16         30  
  16         472  
133 16     16   89 use warnings;
  16         32  
  16         949  
134              
135             our $VERSION = '1.6_3';
136              
137             our $DEBUG;
138             $DEBUG = 0 unless defined $DEBUG;
139              
140 16     16   1096 use Data::Dumper;
  16         11355  
  16         855  
141 16     16   8010 use Storable qw(dclone);
  16         41259  
  16         906  
142 16     16   3872 use DBI qw(:sql_types);
  16         44002  
  16         4679  
143 16     16   962 use SQL::Translator::Utils qw/parse_mysql_version ddl_parser_instance/;
  16         38  
  16         929  
144              
145 16     16   140 use base qw(Exporter);
  16         38  
  16         1854  
146             our @EXPORT_OK = qw(parse);
147              
148             our %type_mapping = ();
149              
150 16     16   106 use constant DEFAULT_PARSER_VERSION => 40000;
  16         28  
  16         29957  
151              
152             our $GRAMMAR = << 'END_OF_GRAMMAR';
153              
154             {
155             my ( $database_name, %tables, $table_order, @table_comments, %views,
156             $view_order, %procedures, $proc_order );
157             my $delimiter = ';';
158             }
159              
160             #
161             # The "eofile" rule makes the parser fail if any "statement" rule
162             # fails. Otherwise, the first successful match by a "statement"
163             # won't cause the failure needed to know that the parse, as a whole,
164             # failed. -ky
165             #
166             startrule : statement(s) eofile {
167             {
168             database_name => $database_name,
169             tables => \%tables,
170             views => \%views,
171             procedures => \%procedures,
172             }
173             }
174              
175             eofile : /^\Z/
176              
177             statement : comment
178             | use
179             | set
180             | drop
181             | create
182             | alter
183             | insert
184             | delimiter
185             | empty_statement
186             |
187              
188             use : /use/i NAME "$delimiter"
189             {
190             $database_name = $item[2];
191             @table_comments = ();
192             }
193              
194             set : /set/i not_delimiter "$delimiter"
195             { @table_comments = () }
196              
197             drop : /drop/i TABLE not_delimiter "$delimiter"
198              
199             drop : /drop/i NAME(s) "$delimiter"
200             { @table_comments = () }
201              
202             bit:
203             /(b'[01]{1,64}')/ |
204             /(b"[01]{1,64}")/
205              
206             string :
207             # MySQL strings, unlike common SQL strings, can be double-quoted or
208             # single-quoted.
209              
210             SQSTRING | DQSTRING
211              
212             nonstring : /[^;\'"]+/
213              
214             statement_body : string | nonstring
215              
216             insert : /insert/i statement_body(s?) "$delimiter"
217              
218             delimiter : /delimiter/i /[\S]+/
219             { $delimiter = $item[2] }
220              
221             empty_statement : "$delimiter"
222              
223             alter : ALTER TABLE table_name alter_specification(s /,/) "$delimiter"
224             {
225             my $table_name = $item{'table_name'};
226             die "Cannot ALTER table '$table_name'; it does not exist"
227             unless $tables{ $table_name };
228             for my $definition ( @{ $item[4] } ) {
229             $definition->{'extra'}->{'alter'} = 1;
230             push @{ $tables{ $table_name }{'constraints'} }, $definition;
231             }
232             }
233              
234             alter_specification : ADD foreign_key_def
235             { $return = $item[2] }
236              
237             create : CREATE /database/i NAME "$delimiter"
238             { @table_comments = () }
239              
240             create : CREATE TEMPORARY(?) TABLE opt_if_not_exists(?) table_name '(' create_definition(s /,/) /(,\s*)?\)/ table_option(s?) "$delimiter"
241             {
242             my $table_name = $item{'table_name'};
243             die "There is more than one definition for $table_name"
244             if ($tables{$table_name});
245              
246             $tables{ $table_name }{'order'} = ++$table_order;
247             $tables{ $table_name }{'table_name'} = $table_name;
248              
249             if ( @table_comments ) {
250             $tables{ $table_name }{'comments'} = [ @table_comments ];
251             @table_comments = ();
252             }
253              
254             my $i = 1;
255             for my $definition ( @{ $item[7] } ) {
256             if ( $definition->{'supertype'} eq 'field' ) {
257             my $field_name = $definition->{'name'};
258             $tables{ $table_name }{'fields'}{ $field_name } =
259             { %$definition, order => $i };
260             $i++;
261              
262             if ( $definition->{'is_primary_key'} ) {
263             push @{ $tables{ $table_name }{'constraints'} },
264             {
265             type => 'primary_key',
266             fields => [ $field_name ],
267             }
268             ;
269             }
270             }
271             elsif ( $definition->{'supertype'} eq 'constraint' ) {
272             push @{ $tables{ $table_name }{'constraints'} }, $definition;
273             }
274             elsif ( $definition->{'supertype'} eq 'index' ) {
275             push @{ $tables{ $table_name }{'indices'} }, $definition;
276             }
277             }
278              
279             if ( my @options = @{ $item{'table_option(s?)'} } ) {
280             for my $option ( @options ) {
281             my ( $key, $value ) = each %$option;
282             if ( $key eq 'comment' ) {
283             push @{ $tables{ $table_name }{'comments'} }, $value;
284             }
285             else {
286             push @{ $tables{ $table_name }{'table_options'} }, $option;
287             }
288             }
289             }
290              
291             1;
292             }
293              
294             opt_if_not_exists : /if not exists/i
295              
296             create : CREATE UNIQUE(?) /(index|key)/i index_name /on/i table_name '(' field_name(s /,/) ')' "$delimiter"
297             {
298             @table_comments = ();
299             push @{ $tables{ $item{'table_name'} }{'indices'} },
300             {
301             name => $item[4],
302             type => $item[2][0] ? 'unique' : 'normal',
303             fields => $item[8],
304             }
305             ;
306             }
307              
308             create : CREATE /trigger/i NAME not_delimiter "$delimiter"
309             {
310             @table_comments = ();
311             }
312              
313             create : CREATE PROCEDURE NAME not_delimiter "$delimiter"
314             {
315             @table_comments = ();
316             my $func_name = $item[3];
317             my $owner = '';
318             my $sql = "$item[1] $item[2] $item[3] $item[4]";
319              
320             $procedures{ $func_name }{'order'} = ++$proc_order;
321             $procedures{ $func_name }{'name'} = $func_name;
322             $procedures{ $func_name }{'owner'} = $owner;
323             $procedures{ $func_name }{'sql'} = $sql;
324             }
325              
326             PROCEDURE : /procedure/i
327             | /function/i
328              
329             create : CREATE or_replace(?) create_view_option(s?) /view/i NAME /as/i view_select_statement "$delimiter"
330             {
331             @table_comments = ();
332             my $view_name = $item{'NAME'};
333             my $select_sql = $item{'view_select_statement'};
334             my $options = $item{'create_view_option(s?)'};
335              
336             my $sql = join(q{ },
337             grep { defined and length }
338             map { ref $_ eq 'ARRAY' ? @$_ : $_ }
339             $item{'CREATE'},
340             $item{'or_replace(?)'},
341             $options,
342             $view_name,
343             'as select',
344             join(', ',
345             map {
346             sprintf('%s%s',
347             $_->{'name'},
348             $_->{'alias'} ? ' as ' . $_->{'alias'} : ''
349             )
350             }
351             @{ $select_sql->{'columns'} || [] }
352             ),
353             ' from ',
354             join(', ',
355             map {
356             sprintf('%s%s',
357             $_->{'name'},
358             $_->{'alias'} ? ' as ' . $_->{'alias'} : ''
359             )
360             }
361             @{ $select_sql->{'from'}{'tables'} || [] }
362             ),
363             $select_sql->{'from'}{'where'}
364             ? 'where ' . $select_sql->{'from'}{'where'}
365             : ''
366             ,
367             );
368              
369             # Hack to strip database from function calls in SQL
370             $sql =~ s#`\w+`\.(`\w+`\()##g;
371              
372             $views{ $view_name }{'order'} = ++$view_order;
373             $views{ $view_name }{'name'} = $view_name;
374             $views{ $view_name }{'sql'} = $sql;
375             $views{ $view_name }{'options'} = $options;
376             $views{ $view_name }{'select'} = $item{'view_select_statement'};
377             }
378              
379             create_view_option : view_algorithm | view_sql_security | view_definer
380              
381             or_replace : /or replace/i
382              
383             view_algorithm : /algorithm/i /=/ WORD
384             {
385             $return = "$item[1]=$item[3]";
386             }
387              
388             view_definer : /definer=\S+/i
389              
390             view_sql_security : /sql \s+ security \s+ (definer|invoker)/ixs
391              
392             not_delimiter : /.*?(?=$delimiter)/is
393              
394             view_select_statement : /[(]?/ /select/i view_column_def /from/i view_table_def /[)]?/
395             {
396             $return = {
397             columns => $item{'view_column_def'},
398             from => $item{'view_table_def'},
399             };
400             }
401              
402             view_column_def : /(.*?)(?=\bfrom\b)/ixs
403             {
404             # split on commas not in parens,
405             # e.g., "concat_ws(\' \', first, last) as first_last"
406             my @tmp = $1 =~ /((?:[^(,]+|\(.*?\))+)/g;
407             my @cols;
408             for my $col ( @tmp ) {
409             my ( $name, $alias ) = map {
410             s/^\s+|\s+$//g;
411             s/[`]//g;
412             $_
413             } split /\s+as\s+/i, $col;
414              
415             push @cols, { name => $name, alias => $alias || '' };
416             }
417              
418             $return = \@cols;
419             }
420              
421             not_delimiter : /.*?(?=$delimiter)/is
422              
423             view_table_def : not_delimiter
424             {
425             my $clause = $item[1];
426             my $where = $1 if $clause =~ s/\bwhere \s+ (.*)//ixs;
427             $clause =~ s/[)]\s*$//;
428              
429             my @tables;
430             for my $tbl ( split( /\s*,\s*/, $clause ) ) {
431             my ( $name, $alias ) = split /\s+as\s+/i, $tbl;
432             push @tables, { name => $name, alias => $alias || '' };
433             }
434              
435             $return = {
436             tables => \@tables,
437             where => $where || '',
438             };
439             }
440              
441             view_column_alias : /as/i NAME
442             { $return = $item[2] }
443              
444             create_definition : constraint
445             | index
446             | field
447             | comment
448             |
449              
450             comment : /^\s*(?:#|-{2}).*\n/
451             {
452             my $comment = $item[1];
453             $comment =~ s/^\s*(#|--)\s*//;
454             $comment =~ s/\s*$//;
455             $return = $comment;
456             }
457              
458             comment : m{ / \* (?! \!) .*? \* / }xs
459             {
460             my $comment = $item[2];
461             $comment = substr($comment, 0, -2);
462             $comment =~ s/^\s*|\s*$//g;
463             $return = $comment;
464             }
465              
466             comment_like_command : m{/\*!(\d+)?}s
467              
468             comment_end : m{ \* / }xs
469              
470             field_comment : /^\s*(?:#|-{2}).*\n/
471             {
472             my $comment = $item[1];
473             $comment =~ s/^\s*(#|--)\s*//;
474             $comment =~ s/\s*$//;
475             $return = $comment;
476             }
477              
478              
479             blank : /\s*/
480              
481             field : field_comment(s?) field_name data_type field_qualifier(s?) reference_definition(?) on_update(?) field_comment(s?)
482             {
483             my %qualifiers = map { %$_ } @{ $item{'field_qualifier(s?)'} || [] };
484             if ( my @type_quals = @{ $item{'data_type'}{'qualifiers'} || [] } ) {
485             $qualifiers{ $_ } = 1 for @type_quals;
486             }
487              
488             my $null = defined $qualifiers{'not_null'}
489             ? $qualifiers{'not_null'} : 1;
490             delete $qualifiers{'not_null'};
491              
492             my @comments = ( @{ $item[1] }, (exists $qualifiers{comment} ? delete $qualifiers{comment} : ()) , @{ $item[7] } );
493              
494             $return = {
495             supertype => 'field',
496             name => $item{'field_name'},
497             data_type => $item{'data_type'}{'type'},
498             size => $item{'data_type'}{'size'},
499             list => $item{'data_type'}{'list'},
500             null => $null,
501             constraints => $item{'reference_definition(?)'},
502             comments => [ @comments ],
503             %qualifiers,
504             }
505             }
506             |
507              
508             field_qualifier : not_null
509             {
510             $return = {
511             null => $item{'not_null'},
512             }
513             }
514              
515             field_qualifier : default_val
516             {
517             $return = {
518             default => $item{'default_val'},
519             }
520             }
521              
522             field_qualifier : auto_inc
523             {
524             $return = {
525             is_auto_inc => $item{'auto_inc'},
526             }
527             }
528              
529             field_qualifier : primary_key
530             {
531             $return = {
532             is_primary_key => $item{'primary_key'},
533             }
534             }
535              
536             field_qualifier : unsigned
537             {
538             $return = {
539             is_unsigned => $item{'unsigned'},
540             }
541             }
542              
543             field_qualifier : /character set/i WORD
544             {
545             $return = {
546             'CHARACTER SET' => $item[2],
547             }
548             }
549              
550             field_qualifier : /collate/i WORD
551             {
552             $return = {
553             COLLATE => $item[2],
554             }
555             }
556              
557             field_qualifier : /on update/i CURRENT_TIMESTAMP
558             {
559             $return = {
560             'ON UPDATE' => $item[2],
561             }
562             }
563              
564             field_qualifier : /unique/i KEY(?)
565             {
566             $return = {
567             is_unique => 1,
568             }
569             }
570              
571             field_qualifier : KEY
572             {
573             $return = {
574             has_index => 1,
575             }
576             }
577              
578             field_qualifier : /comment/i string
579             {
580             $return = {
581             comment => $item[2],
582             }
583             }
584              
585             reference_definition : /references/i table_name parens_field_list(?) match_type(?) on_delete(?) on_update(?)
586             {
587             $return = {
588             type => 'foreign_key',
589             reference_table => $item[2],
590             reference_fields => $item[3][0],
591             match_type => $item[4][0],
592             on_delete => $item[5][0],
593             on_update => $item[6][0],
594             }
595             }
596              
597             match_type : /match full/i { 'full' }
598             |
599             /match partial/i { 'partial' }
600              
601             on_delete : /on delete/i reference_option
602             { $item[2] }
603              
604             on_update :
605             /on update/i CURRENT_TIMESTAMP
606             { $item[2] }
607             |
608             /on update/i reference_option
609             { $item[2] }
610              
611             reference_option: /restrict/i |
612             /cascade/i |
613             /set null/i |
614             /no action/i |
615             /set default/i
616             { $item[1] }
617              
618             index : normal_index
619             | fulltext_index
620             | spatial_index
621             |
622              
623             table_name : NAME
624              
625             field_name : NAME
626              
627             index_name : NAME
628              
629             data_type : WORD parens_value_list(s?) type_qualifier(s?)
630             {
631             my $type = $item[1];
632             my $size; # field size, applicable only to non-set fields
633             my $list; # set list, applicable only to sets (duh)
634              
635             if ( uc($type) =~ /^(SET|ENUM)$/ ) {
636             $size = undef;
637             $list = $item[2][0];
638             }
639             else {
640             $size = $item[2][0];
641             $list = [];
642             }
643              
644              
645             $return = {
646             type => $type,
647             size => $size,
648             list => $list,
649             qualifiers => $item[3],
650             }
651             }
652              
653             parens_field_list : '(' field_name(s /,/) ')'
654             { $item[2] }
655              
656             parens_value_list : '(' VALUE(s /,/) ')'
657             { $item[2] }
658              
659             type_qualifier : /(BINARY|UNSIGNED|ZEROFILL)/i
660             { lc $item[1] }
661              
662             field_type : WORD
663              
664             create_index : /create/i /index/i
665              
666             not_null : /not/i /null/i
667             { $return = 0 }
668             |
669             /null/i
670             { $return = 1 }
671              
672             unsigned : /unsigned/i { $return = 0 }
673              
674             default_val :
675             /default/i CURRENT_TIMESTAMP
676             {
677             $return = $item[2];
678             }
679             |
680             /default/i VALUE
681             {
682             $return = $item[2];
683             }
684             |
685             /default/i bit
686             {
687             $item[2] =~ s/b['"]([01]+)['"]/$1/g;
688             $return = $item[2];
689             }
690             |
691             /default/i /[\w\d:.-]+/
692             {
693             $return = $item[2];
694             }
695             |
696             /default/i NAME # column value, allowed in MariaDB
697             {
698             $return = $item[2];
699             }
700              
701             auto_inc : /auto_increment/i { 1 }
702              
703             primary_key : /primary/i /key/i { 1 }
704              
705             constraint : primary_key_def
706             | unique_key_def
707             | foreign_key_def
708             | check_def
709             |
710              
711             expr : /[^)]* \( [^)]+ \) [^)]*/x # parens, balanced one deep
712             | /[^)]+/
713              
714             check_def : check_def_begin '(' expr ')'
715             {
716             $return = {
717             supertype => 'constraint',
718             type => 'check',
719             name => $item[1],
720             expression => $item[3],
721             }
722             }
723              
724             check_def_begin : /constraint/i /check/i NAME
725             { $return = $item[3] }
726             |
727             /constraint/i NAME /check/i
728             { $return = $item[2] }
729             |
730             /constraint/i /check/i
731             { $return = '' }
732              
733             foreign_key_def : foreign_key_def_begin parens_field_list reference_definition
734             {
735             $return = {
736             supertype => 'constraint',
737             type => 'foreign_key',
738             name => $item[1],
739             fields => $item[2],
740             %{ $item{'reference_definition'} },
741             }
742             }
743              
744             foreign_key_def_begin : /constraint/i /foreign key/i NAME
745             { $return = $item[3] }
746             |
747             /constraint/i NAME /foreign key/i
748             { $return = $item[2] }
749             |
750             /constraint/i /foreign key/i
751             { $return = '' }
752             |
753             /foreign key/i NAME
754             { $return = $item[2] }
755             |
756             /foreign key/i
757             { $return = '' }
758              
759             primary_key_def : primary_key index_type(?) '(' name_with_opt_paren(s /,/) ')' index_type(?)
760             {
761             $return = {
762             supertype => 'constraint',
763             type => 'primary_key',
764             fields => $item[4],
765             options => $item[2][0] || $item[6][0],
766             };
767             }
768             # In theory, and according to the doc, names should not be allowed here, but
769             # MySQL accept (and ignores) them, so we are not going to be less :)
770             | primary_key index_name_not_using(?) '(' name_with_opt_paren(s /,/) ')' index_type(?)
771             {
772             $return = {
773             supertype => 'constraint',
774             type => 'primary_key',
775             fields => $item[4],
776             options => $item[6][0],
777             };
778             }
779              
780             unique_key_def : UNIQUE KEY(?) index_name_not_using(?) index_type(?) '(' name_with_opt_paren(s /,/) ')' index_type(?)
781             {
782             $return = {
783             supertype => 'constraint',
784             name => $item[3][0],
785             type => 'unique',
786             fields => $item[6],
787             options => $item[4][0] || $item[8][0],
788             }
789             }
790              
791             normal_index : KEY index_name_not_using(?) index_type(?) '(' name_with_opt_paren(s /,/) ')' index_type(?)
792             {
793             $return = {
794             supertype => 'index',
795             type => 'normal',
796             name => $item[2][0],
797             fields => $item[5],
798             options => $item[3][0] || $item[7][0],
799             }
800             }
801              
802             index_name_not_using : QUOTED_NAME
803             | /(\b(?!using)\w+\b)/ { $return = ($1 =~ /^using/i) ? undef : $1 }
804              
805             index_type : /using (btree|hash|rtree)/i { $return = uc $1 }
806              
807             fulltext_index : /fulltext/i KEY(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
808             {
809             $return = {
810             supertype => 'index',
811             type => 'fulltext',
812             name => $item{'index_name(?)'}[0],
813             fields => $item[5],
814             }
815             }
816              
817             spatial_index : /spatial/i KEY(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
818             {
819             $return = {
820             supertype => 'index',
821             type => 'spatial',
822             name => $item{'index_name(?)'}[0],
823             fields => $item[5],
824             }
825             }
826              
827             name_with_opt_paren : NAME parens_value_list(s?)
828             { $item[2][0] ? "$item[1]($item[2][0][0])" : $item[1] }
829              
830             UNIQUE : /unique/i
831              
832             KEY : /key/i | /index/i
833              
834             table_option : /comment/i /=/ string
835             {
836             $return = { comment => $item[3] };
837             }
838             | /(default )?(charset|character set)/i /\s*=?\s*/ NAME
839             {
840             $return = { 'CHARACTER SET' => $item[3] };
841             }
842             | /collate/i NAME
843             {
844             $return = { 'COLLATE' => $item[2] }
845             }
846             | /union/i /\s*=\s*/ '(' table_name(s /,/) ')'
847             {
848             $return = { $item[1] => $item[4] };
849             }
850             | WORD /\s*=\s*/ table_option_value
851             {
852             $return = { $item[1] => $item[3] };
853             }
854              
855             table_option_value : VALUE
856             | NAME
857              
858             default : /default/i
859              
860             ADD : /add/i
861              
862             ALTER : /alter/i
863              
864             CREATE : /create/i
865              
866             TEMPORARY : /temporary/i
867              
868             TABLE : /table/i
869              
870             WORD : /\w+/
871              
872             DIGITS : /\d+/
873              
874             COMMA : ','
875              
876             BACKTICK : '`'
877              
878             DOUBLE_QUOTE: '"'
879              
880             SINGLE_QUOTE: "'"
881              
882             QUOTED_NAME : BQSTRING
883             | SQSTRING
884             | DQSTRING
885              
886             # MySQL strings, unlike common SQL strings, can have the delmiters
887             # escaped either by doubling or by backslashing.
888             BQSTRING: BACKTICK /(?:[^\\`]|``|\\.)*/ BACKTICK
889             { ($return = $item[3]) =~ s/(\\[\\`]|``)/substr($1,1)/ge }
890              
891             DQSTRING: DOUBLE_QUOTE /(?:[^\\"]|""|\\.)*/ DOUBLE_QUOTE
892             { ($return = $item[3]) =~ s/(\\[\\"]|"")/substr($1,1)/ge }
893              
894             SQSTRING: SINGLE_QUOTE /(?:[^\\']|''|\\.)*/ SINGLE_QUOTE
895             { ($return = $item[3]) =~ s/(\\[\\']|'')/substr($1,1)/ge }
896              
897              
898             NAME: QUOTED_NAME
899             | /\w+/
900              
901             VALUE : /[-+]?\d*\.?\d+(?:[eE]\d+)?/
902             { $item[1] }
903             | SQSTRING
904             | DQSTRING
905             | /NULL/i
906             { 'NULL' }
907              
908             # always a scalar-ref, so that it is treated as a function and not quoted by consumers
909             CURRENT_TIMESTAMP :
910             /current_timestamp(\(\))?/i { \'CURRENT_TIMESTAMP' }
911             | /now\(\)/i { \'CURRENT_TIMESTAMP' }
912              
913             END_OF_GRAMMAR
914              
915             sub parse {
916 33     33 0 420 my ( $translator, $data ) = @_;
917              
918             # Enable warnings within the Parse::RecDescent module.
919             # Make sure the parser dies when it encounters an error
920 33 100       120 local $::RD_ERRORS = 1 unless defined $::RD_ERRORS;
921             # Enable warnings. This will warn on unused rules &c.
922 33 100       113 local $::RD_WARN = 1 unless defined $::RD_WARN;
923             # Give out hints to help fix problems.
924 33 100       126 local $::RD_HINT = 1 unless defined $::RD_HINT;
925 33 50       587 local $::RD_TRACE = $translator->trace ? 1 : undef;
926 33         351 local $DEBUG = $translator->debug;
927              
928 33         361 my $parser = ddl_parser_instance('MySQL');
929              
930             # Preprocess for MySQL-specific and not-before-version comments
931             # from mysqldump
932             my $parser_version = parse_mysql_version(
933 33   100     17469360 $translator->parser_args->{mysql_parser_version}, 'mysql'
934             ) || DEFAULT_PARSER_VERSION;
935              
936 33         229 while ( $data =~
937 18 100 100     169 s#/\*!(\d{5})?(.*?)\*/#($1 && $1 > $parser_version ? '' : $2)#es
938             ) {
939             # do nothing; is there a better way to write this? -- ky
940             }
941              
942 33         493 my $result = $parser->startrule($data);
943 33 100       6963792 return $translator->error( "Parse failed." ) unless defined $result;
944 32 50       141 warn "Parse result:".Dumper( $result ) if $DEBUG;
945              
946 32         813 my $schema = $translator->schema;
947 32 100       2537 $schema->name($result->{'database_name'}) if $result->{'database_name'};
948              
949             my @tables = sort {
950             $result->{'tables'}{ $a }{'order'}
951             <=>
952 131         330 $result->{'tables'}{ $b }{'order'}
953 32         94 } keys %{ $result->{'tables'} };
  32         284  
954              
955 32         115 for my $table_name ( @tables ) {
956 92         361 my $tdata = $result->{tables}{ $table_name };
957             my $table = $schema->add_table(
958 92 50       568 name => $tdata->{'table_name'},
959             ) or die $schema->error;
960              
961 92         3182 $table->comments( $tdata->{'comments'} );
962              
963             my @fields = sort {
964             $tdata->{'fields'}->{$a}->{'order'}
965             <=>
966 911         1761 $tdata->{'fields'}->{$b}->{'order'}
967 92         220 } keys %{ $tdata->{'fields'} };
  92         726  
968              
969 92         303 for my $fname ( @fields ) {
970 475         1130 my $fdata = $tdata->{'fields'}{ $fname };
971             my $field = $table->add_field(
972             name => $fdata->{'name'},
973             data_type => $fdata->{'data_type'},
974             size => $fdata->{'size'},
975             default_value => $fdata->{'default'},
976             is_auto_increment => $fdata->{'is_auto_inc'},
977             is_nullable => $fdata->{'null'},
978 475 50       2742 comments => $fdata->{'comments'},
979             ) or die $table->error;
980              
981 475 100       8778 $table->primary_key( $field->name ) if $fdata->{'is_primary_key'};
982              
983 475         1034 for my $qual ( qw[ binary unsigned zerofill list collate ],
984             'character set', 'on update' ) {
985 3325 100 100     10211 if ( my $val = $fdata->{ $qual } || $fdata->{ uc $qual } ) {
986 487 100 100     2688 next if ref $val eq 'ARRAY' && !@$val;
987 17         328 $field->extra( $qual, $val );
988             }
989             }
990              
991 475 100       1279 if ( $fdata->{'has_index'} ) {
992             $table->add_index(
993             name => '',
994             type => 'NORMAL',
995 1 50       6 fields => $fdata->{'name'},
996             ) or die $table->error;
997             }
998              
999 475 100       1096 if ( $fdata->{'is_unique'} ) {
1000             $table->add_constraint(
1001             name => '',
1002             type => 'UNIQUE',
1003 1 50       5 fields => $fdata->{'name'},
1004             ) or die $table->error;
1005             }
1006              
1007 475         667 for my $cdata ( @{ $fdata->{'constraints'} } ) {
  475         1465  
1008 1 50       5 next unless $cdata->{'type'} eq 'foreign_key';
1009 1   50     24 $cdata->{'fields'} ||= [ $field->name ];
1010 1         17 push @{ $tdata->{'constraints'} }, $cdata;
  1         5  
1011             }
1012              
1013             }
1014              
1015 92 100       223 for my $idata ( @{ $tdata->{'indices'} || [] } ) {
  92         537  
1016             my $index = $table->add_index(
1017             name => $idata->{'name'},
1018             type => uc $idata->{'type'},
1019 60 50       405 fields => $idata->{'fields'},
1020             ) or die $table->error;
1021             }
1022              
1023 92 100       263 if ( my @options = @{ $tdata->{'table_options'} || [] } ) {
  92 100       690  
1024 58         379 my @cleaned_options;
1025             my @ignore_opts = $translator->parser_args->{'ignore_opts'}
1026 58 50       1226 ? split( /,/, $translator->parser_args->{'ignore_opts'} )
1027             : ();
1028 58 50       180 if (@ignore_opts) {
1029 0         0 my $ignores = { map { $_ => 1 } @ignore_opts };
  0         0  
1030 0         0 foreach my $option (@options) {
1031             # make sure the option isn't in ignore list
1032 0         0 my ($option_key) = keys %$option;
1033 0 0       0 if ( !exists $ignores->{$option_key} ) {
1034 0         0 push @cleaned_options, $option;
1035             }
1036             }
1037             } else {
1038 58         152 @cleaned_options = @options;
1039             }
1040 58 50       1025 $table->options( \@cleaned_options ) or die $table->error;
1041             }
1042              
1043 92 100       202 for my $cdata ( @{ $tdata->{'constraints'} || [] } ) {
  92         449  
1044             my $constraint = $table->add_constraint(
1045             name => $cdata->{'name'},
1046             type => $cdata->{'type'},
1047             fields => $cdata->{'fields'},
1048             expression => $cdata->{'expression'},
1049             reference_table => $cdata->{'reference_table'},
1050             reference_fields => $cdata->{'reference_fields'},
1051             match_type => $cdata->{'match_type'} || '',
1052             on_delete => $cdata->{'on_delete'}
1053             || $cdata->{'on_delete_do'},
1054             on_update => $cdata->{'on_update'}
1055 130 50 100     1777 || $cdata->{'on_update_do'},
      66        
      66        
1056             ) or die $table->error;
1057             }
1058              
1059             # After the constrains and PK/idxs have been created,
1060             # we normalize fields
1061 92         366 normalize_field($_) for $table->get_fields;
1062             }
1063              
1064             my @procedures = sort {
1065             $result->{procedures}->{ $a }->{'order'}
1066             <=>
1067 1         8 $result->{procedures}->{ $b }->{'order'}
1068 32         97 } keys %{ $result->{procedures} };
  32         196  
1069              
1070 32         112 for my $proc_name ( @procedures ) {
1071             $schema->add_procedure(
1072             name => $proc_name,
1073             owner => $result->{procedures}->{$proc_name}->{owner},
1074             sql => $result->{procedures}->{$proc_name}->{sql},
1075 2         16 );
1076             }
1077              
1078             my @views = sort {
1079             $result->{views}->{ $a }->{'order'}
1080             <=>
1081 3         12 $result->{views}->{ $b }->{'order'}
1082 32         73 } keys %{ $result->{views} };
  32         152  
1083              
1084 32         97 for my $view_name ( @views ) {
1085 3         7 my $view = $result->{'views'}{ $view_name };
1086 42 50       130 my @flds = map { $_->{'alias'} || $_->{'name'} }
1087 3 50       6 @{ $view->{'select'}{'columns'} || [] };
  3         17  
1088 0 0       0 my @from = map { $_->{'alias'} || $_->{'name'} }
1089 3 50       8 @{ $view->{'from'}{'tables'} || [] };
  3         19  
1090              
1091             $schema->add_view(
1092             name => $view_name,
1093             sql => $view->{'sql'},
1094             order => $view->{'order'},
1095             fields => \@flds,
1096             tables => \@from,
1097 3         14 options => $view->{'options'}
1098             );
1099             }
1100              
1101 32         393 return 1;
1102             }
1103              
1104             # Takes a field, and returns
1105             sub normalize_field {
1106 475     475 0 839 my ($field) = @_;
1107 475         693 my ($size, $type, $list, $unsigned, $changed);
1108              
1109 475         7586 $size = $field->size;
1110 475         4131 $type = $field->data_type;
1111 475   100     7356 $list = $field->extra->{list} || [];
1112 475         7363 $unsigned = defined($field->extra->{unsigned});
1113              
1114 475 100 66     1798 if ( !ref $size && $size eq 0 ) {
1115 171 100       1532 if ( lc $type eq 'tinyint' ) {
    100          
    50          
    100          
    50          
    100          
1116 12         43 $changed = $size != 4 - $unsigned;
1117 12         25 $size = 4 - $unsigned;
1118             }
1119             elsif ( lc $type eq 'smallint' ) {
1120 1         3 $changed = $size != 6 - $unsigned;
1121 1         3 $size = 6 - $unsigned;
1122             }
1123             elsif ( lc $type eq 'mediumint' ) {
1124 0         0 $changed = $size != 9 - $unsigned;
1125 0         0 $size = 9 - $unsigned;
1126             }
1127             elsif ( $type =~ /^int(eger)?$/i ) {
1128 59   33     247 $changed = $size != 11 - $unsigned || $type ne 'int';
1129 59         106 $type = 'int';
1130 59         98 $size = 11 - $unsigned;
1131             }
1132             elsif ( lc $type eq 'bigint' ) {
1133 0         0 $changed = $size != 20;
1134 0         0 $size = 20;
1135             }
1136             elsif ( lc $type =~ /(float|double|decimal|numeric|real|fixed|dec)/ ) {
1137 2 50 50     11 my $old_size = (ref $size || '') eq 'ARRAY' ? $size : [];
1138 2   33     9 $changed = @$old_size != 2
1139             || $old_size->[0] != 8
1140             || $old_size->[1] != 2;
1141 2         6 $size = [8,2];
1142             }
1143             }
1144              
1145 475 100       1878 if ( $type =~ /^tiny(text|blob)$/i ) {
    100          
    50          
    50          
1146 13         28 $changed = $size != 255;
1147 13         19 $size = 255;
1148             }
1149             elsif ( $type =~ /^(blob|text)$/i ) {
1150 64         162 $changed = $size != 65_535;
1151 64         109 $size = 65_535;
1152             }
1153             elsif ( $type =~ /^medium(blob|text)$/i ) {
1154 0         0 $changed = $size != 16_777_215;
1155 0         0 $size = 16_777_215;
1156             }
1157             elsif ( $type =~ /^long(blob|text)$/i ) {
1158 0         0 $changed = $size != 4_294_967_295;
1159 0         0 $size = 4_294_967_295;
1160             }
1161              
1162 475 100 66     2111 if ( $field->data_type =~ /(set|enum)/i && !$field->size ) {
1163 5         113 my %extra = $field->extra;
1164 5         11 my $longest = 0;
1165 5 50       10 for my $len ( map { length } @{ $extra{'list'} || [] } ) {
  12         28  
  5         18  
1166 12 100       28 $longest = $len if $len > $longest;
1167             }
1168 5         14 $changed = 1;
1169 5 50       17 $size = $longest if $longest;
1170             }
1171              
1172              
1173 475 100       1513 if ( $changed ) {
1174             # We only want to clone the field, not *everything*
1175             {
1176 156         247 local $field->{table} = undef;
  156         439  
1177 156         11425 $field->parsed_field( dclone( $field ) );
1178 156         5291 $field->parsed_field->{table} = $field->table;
1179             }
1180 156         5514 $field->size( $size );
1181 156         1380 $field->data_type( $type );
1182             $field->sql_data_type( $type_mapping{ lc $type } )
1183 156 50       543 if exists $type_mapping{ lc $type };
1184 156 100       753 $field->extra->{list} = $list if @$list;
1185             }
1186             }
1187              
1188             1;
1189              
1190             # -------------------------------------------------------------------
1191             # Where man is not nature is barren.
1192             # William Blake
1193             # -------------------------------------------------------------------
1194              
1195             =pod
1196              
1197             =head1 AUTHOR
1198              
1199             Ken Youens-Clark Ekclark@cpan.orgE,
1200             Chris Mungall Ecjm@fruitfly.orgE.
1201              
1202             =head1 SEE ALSO
1203              
1204             Parse::RecDescent, SQL::Translator::Schema.
1205              
1206             =cut