lib/SQL/Translator/Parser/MySQL.pm

   1 package SQL::Translator::Parser::MySQL;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: MySQL.pm,v 1.5 2002-11-20 04:03:04 kycl4rk Exp $
   5 # -------------------------------------------------------------------
   6 # Copyright (C) 2002 Ken Y. Clark <kycl4rk@users.sourceforge.net>,
   7 #                    darren chamberlain <darren@cpan.org>
   8 #
   9 # This program is free software; you can redistribute it and/or
  10 # modify it under the terms of the GNU General Public License as
  11 # published by the Free Software Foundation; version 2.
  12 #
  13 # This program is distributed in the hope that it will be useful, but
  14 # WITHOUT ANY WARRANTY; without even the implied warranty of
  15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16 # General Public License for more details.
  17 #
  18 # You should have received a copy of the GNU General Public License
  19 # along with this program; if not, write to the Free Software
  20 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
  21 # 02111-1307  USA
  22 # -------------------------------------------------------------------
  23
  24 use strict;
  25 use vars qw($VERSION $GRAMMAR @EXPORT_OK);
  26 $VERSION = sprintf "%d.%02d", q$Revision: 1.5 $ =~ /(\d+)\.(\d+)/;
  27
  28 #use SQL::Translator::Parser;  # This is not necessary!
  29 use Parse::RecDescent;
  30 use Exporter;
  31 use base qw(Exporter);
  32
  33 @EXPORT_OK = qw(parse);
  34
  35 my $parser; # should we do this?  There's no programmic way to
  36             # change the grammar, so I think this is safe.
  37 sub parse {
  38     my ( $translator, $data ) = @_;
  39     $parser ||= Parse::RecDescent->new($GRAMMAR);
  40
  41     unless (defined $parser) {
  42         return $translator->error("Error instantiating Parse::RecDescent ".
  43             "instance: Bad grammer");
  44     }
  45
  46     # Is this right?  It was $parser->parse before, but that didn't
  47     # work; Parse::RecDescent appears to need the name of a rule
  48     # with which to begin, so I chose the first rule in the grammar.
  49     return $parser->file($data);
  50 }
  51
  52 $GRAMMAR =
  53     q!
  54         { our ( %tables ) }
  55
  56         file         : statement(s) { \%tables }
  57
  58         statement    : comment
  59                        | create
  60                        | <error>
  61
  62         create       : create_table table_name '(' line(s /,/) ')' table_type(?) ';'
  63                     {
  64                         my $i = 0;
  65                         for my $line ( @{ $item[4] } ) {
  66                             if ( $line->{'type'} eq 'field' ) {
  67                                 my $field_name = $line->{'name'};
  68                                 $tables{ $item{'table_name'} }
  69                                     {'fields'}{$field_name} =
  70                                     { %$line, order => $i };
  71                                 $i++;
  72
  73                                 if ( $line->{'is_primary_key'} ) {
  74                                     push
  75                                     @{ $tables{ $item{'table_name'} }{'indices'} },
  76                                     {
  77                                         type   => 'primary_key',
  78                                         fields => [ $field_name ],
  79                                     };
  80                                 }
  81                             }
  82                             else {
  83                                 push @{ $tables{ $item{'table_name'} }{'indices'} },
  84                                     $line;
  85                             }
  86                             $tables{ $item{'table_name'} }{'type'} =
  87                                 $item{'table_type'}[0];
  88                         }
  89                     }
  90                        | <error>
  91
  92         create       : create_index index_name /on/i table_name '(' field_name(s /,/) ')' ';'
  93 #        create       : create_index index_name keyword_on table_name '(' field_name ')' ';'
  94                        {
  95                           # do nothing just now
  96                           my $dummy = 0;
  97                        }
  98                         | <error>
  99
 100         keyword_on   : /on/i
 101
 102         line         : index
 103                        | field
 104                        | <error>
 105
 106         comment      : /^\s*[#-]+.*\n/
 107
 108         blank        : /\s*/
 109
 110
 111         field        : field_name data_type field_qualifier(s?)
 112                        {
 113                            my %qualifier_h =
 114                              map {%$_} @{$item{'field_qualifier'} || []};
 115                            my $null = defined $item{'not_null'}
 116                              ? $item{'not_null'} : 1 ;
 117                            delete $qualifier_h{'not_null'};
 118                            $return = {
 119                                 type           => 'field',
 120                                 name           => $item{'field_name'},
 121                                 data_type      => $item{'data_type'}{'type'},
 122                                 null           => $null,
 123                                 %qualifier_h,
 124                            }
 125                        }
 126                     | <error>
 127
 128         field_qualifier : not_null
 129             {
 130                 $return = {
 131                      null => $item{'not_null'},
 132                 }
 133             }
 134
 135         field_qualifier : default_val
 136             {
 137                 $return = {
 138                      default => $item{default_val},
 139                 }
 140             }
 141
 142         field_qualifier : auto_inc
 143             {
 144                 $return = {
 145                      is_auto_inc => $item{auto_inc},
 146                 }
 147             }
 148
 149         field_qualifier : primary_key
 150             {
 151                 $return = {
 152                      is_primary_key => $item{primary_key},
 153                 }
 154             }
 155
 156         field_qualifier : unsigned
 157             {
 158                 $return = {
 159                      is_unsigned => $item{unsigned},
 160                 }
 161             }
 162
 163         index        : primary_key_index
 164                        | unique_index
 165                        | normal_index
 166
 167         table_name   : WORD
 168
 169         field_name   : WORD
 170
 171         index_name   : WORD
 172
 173         data_type    : WORD field_size(?)
 174             {
 175                 $return = {
 176                     type => $item[1],
 177                     size => $item[2][0]
 178                 }
 179             }
 180
 181         field_type   : WORD
 182
 183         field_size   : '(' num_range ')' { $item{'num_range'} }
 184
 185         num_range    : DIGITS ',' DIGITS
 186             { $return = $item[1].','.$item[3] }
 187                        | DIGITS
 188             { $return = $item[1] }
 189
 190
 191         create_table : /create/i /table/i
 192
 193         create_index : /create/i /index/i
 194
 195         not_null     : /not/i /null/i { $return = 0 }
 196
 197         unsigned     : /unsigned/i { $return = 0 }
 198
 199         default_val  : /default/i /(?:')?[\w\d.-]*(?:')?/ { $item[2]=~s/'//g; $return=$item[2] }
 200
 201         auto_inc     : /auto_increment/i { 1 }
 202
 203         primary_key  : /primary/i /key/i { 1 }
 204
 205         primary_key_index : primary_key index_name(?) '(' field_name(s /,/) ')'
 206             {
 207                 $return = {
 208                     name   => $item{'index_name'}[0],
 209                     type   => 'primary_key',
 210                     fields => $item[4],
 211                 }
 212             }
 213
 214         normal_index      : key index_name(?) '(' field_name(s /,/) ')'
 215             {
 216                 $return = {
 217                     name   => $item{'index_name'}[0],
 218                     type   => 'normal',
 219                     fields => $item[4],
 220                 }
 221             }
 222
 223         unique_index      : /unique/i key(?) index_name(?) '(' field_name(s /,/) ')'
 224             {
 225                 $return = {
 226                     name   => $item{'index_name'}[0],
 227                     type   => 'unique',
 228                     fields => $item[5],
 229                 }
 230             }
 231
 232         key          : /key/i
 233                        | /index/i
 234
 235         table_type   : /TYPE=/i /\w+/ { $item[2] }
 236
 237         WORD         : /\w+/
 238
 239         DIGITS       : /\d+/
 240
 241         COMMA        : ','
 242
 243     !;
 244
 245 1;
 246
 247 #-----------------------------------------------------
 248 # Where man is not nature is barren.
 249 # William Blake
 250 #-----------------------------------------------------
 251
 252 =head1 NAME
 253
 254 SQL::Translator::Parser::MySQL - parser for MySQL
 255
 256 =head1 SYNOPSIS
 257
 258   use SQL::Translator;
 259   use SQL::Translator::Parser::MySQL;
 260
 261   my $translator = SQL::Translator->new;
 262   $translator->parser("SQL::Translator::Parser::MySQL");
 263
 264 =head1 DESCRIPTION
 265
 266 Blah blah blah.
 267
 268 =head1 AUTHOR
 269
 270 Ken Y. Clark, kclark@logsoft.com
 271
 272 =head1 SEE ALSO
 273
 274 perl(1).
 275
 276 =cut