lib/SQL/Translator/Parser/MySQL.pm

   1 package SQL::Translator::Parser::MySQL;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: MySQL.pm,v 1.12 2003-02-25 14:55:35 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.12 $ =~ /(\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 my $parser; # should we do this?  There's no programmic way to
 142             # change the grammar, so I think this is safe.
 143
 144 $GRAMMAR = q!
 145
 146 { our ( %tables, $table_order ) }
 147
 148 #
 149 # The "eofile" rule makes the parser fail if any "statement" rule
 150 # fails.  Otherwise, the first successful match by a "statement"
 151 # won't cause the failure needed to know that the parse, as a whole,
 152 # failed. -ky
 153 #
 154 startrule : statement(s) eofile { \%tables }
 155
 156 eofile : /^\Z/
 157
 158 statement : comment
 159     | drop
 160     | create
 161     | <error>
 162
 163 drop : /drop/i WORD(s) ';'
 164
 165 create : create_table table_name '(' create_definition(s /,/) ')' table_option(s?) ';'
 166     {
 167         my $table_name                       = $item{'table_name'};
 168         $tables{ $table_name }{'order'}      = ++$table_order;
 169         $tables{ $table_name }{'table_name'} = $table_name;
 170
 171         my $i = 1;
 172         for my $definition ( @{ $item[4] } ) {
 173             if ( $definition->{'type'} eq 'field' ) {
 174                 my $field_name = $definition->{'name'};
 175                 $tables{ $table_name }{'fields'}{ $field_name } =
 176                     { %$definition, order => $i };
 177                 $i++;
 178
 179                 if ( $definition->{'is_primary_key'} ) {
 180                     push @{ $tables{ $table_name }{'indices'} },
 181                         {
 182                             type   => 'primary_key',
 183                             fields => [ $field_name ],
 184                         }
 185                     ;
 186                 }
 187             }
 188             else {
 189                 push @{ $tables{ $table_name }{'indices'} },
 190                     $definition;
 191             }
 192         }
 193
 194         for my $opt ( @{ $item{'table_option'} } ) {
 195             if ( my ( $key, $val ) = each %$opt ) {
 196                 $tables{ $table_name }{'table_options'}{ $key } = $val;
 197             }
 198         }
 199     }
 200
 201 create : /CREATE/i unique(?) /(INDEX|KEY)/i index_name /on/i table_name '(' field_name(s /,/) ')' ';'
 202     {
 203         push @{ $tables{ $item{'table_name'} }{'indices'} },
 204             {
 205                 name   => $item[4],
 206                 type   => $item[2] ? 'unique' : 'normal',
 207                 fields => $item[8],
 208             }
 209         ;
 210     }
 211
 212 create_definition : index
 213     | field
 214     | <error>
 215
 216 comment : /^\s*(?:#|-{2}).*\n/
 217
 218 blank : /\s*/
 219
 220 field : field_name data_type field_qualifier(s?)
 221     {
 222         my %qualifiers = map { %$_ } @{ $item{'field_qualifier'} || [] };
 223         my $null = defined $item{'not_null'} ? $item{'not_null'} : 1;
 224         delete $qualifiers{'not_null'};
 225         if ( my @type_quals = @{ $item{'data_type'}{'qualifiers'} || [] } ) {
 226             $qualifiers{ $_ } = 1 for @type_quals;
 227         }
 228
 229         $return = {
 230             type           => 'field',
 231             name           => $item{'field_name'},
 232             data_type      => $item{'data_type'}{'type'},
 233             size           => $item{'data_type'}{'size'},
 234             list           => $item{'data_type'}{'list'},
 235             null           => $null,
 236             %qualifiers,
 237         }
 238     }
 239     | <error>
 240
 241 field_qualifier : not_null
 242     {
 243         $return = {
 244              null => $item{'not_null'},
 245         }
 246     }
 247
 248 field_qualifier : default_val
 249     {
 250         $return = {
 251              default => $item{'default_val'},
 252         }
 253     }
 254
 255 field_qualifier : auto_inc
 256     {
 257         $return = {
 258              is_auto_inc => $item{'auto_inc'},
 259         }
 260     }
 261
 262 field_qualifier : primary_key
 263     {
 264         $return = {
 265              is_primary_key => $item{'primary_key'},
 266         }
 267     }
 268
 269 field_qualifier : unsigned
 270     {
 271         $return = {
 272              is_unsigned => $item{'unsigned'},
 273         }
 274     }
 275
 276 index : primary_key_index
 277     | unique_index
 278     | fulltext_index
 279     | normal_index
 280
 281 table_name   : WORD
 282
 283 field_name   : WORD
 284
 285 index_name   : WORD
 286
 287 data_type    : WORD parens_value_list(s?) type_qualifier(s?)
 288     {
 289         my $type = $item[1];
 290         my $size; # field size, applicable only to non-set fields
 291         my $list; # set list, applicable only to sets (duh)
 292
 293         if ( uc($type) =~ /^(SET|ENUM)$/ ) {
 294             $size = undef;
 295             $list = $item[2][0];
 296         }
 297         else {
 298             $size = $item[2][0];
 299             $list = [];
 300         }
 301
 302         $return        = {
 303             type       => $type,
 304             size       => $size,
 305             list       => $list,
 306             qualifiers => $item[3],
 307         }
 308     }
 309
 310 parens_value_list : '(' VALUE(s /,/) ')'
 311     { $item[2] }
 312
 313 type_qualifier : /(BINARY|UNSIGNED|ZEROFILL)/i
 314     { lc $item[1] }
 315
 316 field_type   : WORD
 317
 318 field_size   : '(' num_range ')' { $item{'num_range'} }
 319
 320 num_range    : DIGITS ',' DIGITS
 321     { $return = $item[1].','.$item[3] }
 322     | DIGITS
 323     { $return = $item[1] }
 324
 325 create_table : /create/i /table/i
 326
 327 create_index : /create/i /index/i
 328
 329 not_null     : /not/i /null/i { $return = 0 }
 330
 331 unsigned     : /unsigned/i { $return = 0 }
 332
 333 default_val  : /default/i /(?:')?[\w\d.-]*(?:')?/
 334     {
 335         $item[2] =~ s/'//g;
 336         $return  =  $item[2];
 337     }
 338
 339 auto_inc : /auto_increment/i { 1 }
 340
 341 primary_key : /primary/i /key/i { 1 }
 342
 343 primary_key_index : primary_key index_name(?) '(' field_name(s /,/) ')'
 344     {
 345         $return    = {
 346             name   => $item{'index_name'}[0],
 347             type   => 'primary_key',
 348             fields => $item[4],
 349         }
 350     }
 351
 352 normal_index : key index_name(?) '(' name_with_opt_paren(s /,/) ')'
 353     {
 354         $return    = {
 355             name   => $item{'index_name'}[0],
 356             type   => 'normal',
 357             fields => $item[4],
 358         }
 359     }
 360
 361 unique_index : unique key(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
 362     {
 363         $return    = {
 364             name   => $item{'index_name'}[0],
 365             type   => 'unique',
 366             fields => $item[5],
 367         }
 368     }
 369
 370 fulltext_index : fulltext key(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
 371     {
 372         $return    = {
 373             name   => $item{'index_name'}[0],
 374             type   => 'fulltext',
 375             fields => $item[5],
 376         }
 377     }
 378
 379 name_with_opt_paren : NAME parens_value_list(s?)
 380     { $item[2][0] ? "$item[1]($item[2][0][0])" : $item[1] }
 381
 382 fulltext : /fulltext/i { 1 }
 383
 384 unique : /unique/i { 1 }
 385
 386 key : /key/i | /index/i
 387
 388 table_option : /[^\s;]*/
 389     {
 390         $return = { split /=/, $item[1] }
 391     }
 392
 393 WORD : /\w+/
 394
 395 DIGITS : /\d+/
 396
 397 COMMA : ','
 398
 399 NAME    : "`" /\w+/ "`"
 400     { $item[2] }
 401     | /\w+/
 402     { $item[1] }
 403
 404 VALUE   : /[-+]?\.?\d+(?:[eE]\d+)?/
 405     { $item[1] }
 406     | /'.*?'/   # XXX doesn't handle embedded quotes
 407     { $item[1] }
 408     | /NULL/
 409     { 'NULL' }
 410
 411 !;
 412
 413 # -------------------------------------------------------------------
 414 sub parse {
 415     my ( $translator, $data ) = @_;
 416     $parser ||= Parse::RecDescent->new($GRAMMAR);
 417
 418     $::RD_TRACE  = $translator->trace ? 1 : undef;
 419     $DEBUG       = $translator->debug;
 420
 421     unless (defined $parser) {
 422         return $translator->error("Error instantiating Parse::RecDescent ".
 423             "instance: Bad grammer");
 424     }
 425
 426     my $result = $parser->startrule($data);
 427     die "Parse failed.\n" unless defined $result;
 428     warn Dumper($result) if $DEBUG;
 429     return $result;
 430 }
 431
 432 1;
 433
 434 #-----------------------------------------------------
 435 # Where man is not nature is barren.
 436 # William Blake
 437 #-----------------------------------------------------
 438
 439 =pod
 440
 441 =head1 AUTHOR
 442
 443 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>,
 444 Chris Mungall
 445
 446 =head1 SEE ALSO
 447
 448 perl(1), Parse::RecDescent.
 449
 450 =cut