lib/SQL/Translator/Parser/MySQL.pm

   1 package SQL::Translator::Parser::MySQL;
   2
   3 #-----------------------------------------------------
   4 # $Id: MySQL.pm,v 1.2 2002-03-21 18:50:53 dlc 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.2 $ =~ /(\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         $translator->error_out("Error instantiating Parse::RecDescent ".
  43             "instance: Bad grammer");
  44         return;
  45     }
  46
  47     # Is this right?  It was $parser->parse before, but that didn't
  48     # work; Parse::RecDescent appears to need the name of a rule
  49     # with which to begin, so I chose the first rule in the grammar.
  50     return $parser->file($data);
  51 }
  52
  53 $GRAMMAR =
  54     q!
  55         { our ( %tables ) }
  56
  57         file         : statement(s) { \%tables }
  58
  59         statement    : comment
  60                        | create
  61                        | <error>
  62
  63         create       : create_table table_name '(' line(s /,/) ')' table_type(?) ';'
  64                     {
  65                         my $i = 0;
  66                         for my $line ( @{ $item[4] } ) {
  67                             if ( $line->{'type'} eq 'field' ) {
  68                                 my $field_name = $line->{'name'};
  69                                 $tables{ $item{'table_name'} }
  70                                     {'fields'}{$field_name} =
  71                                     { %$line, order => $i };
  72                                 $i++;
  73
  74                                 if ( $line->{'is_primary_key'} ) {
  75                                     push
  76                                     @{ $tables{ $item{'table_name'} }{'indeces'} },
  77                                     {
  78                                         type   => 'primary_key',
  79                                         fields => [ $field_name ],
  80                                     };
  81                                 }
  82                             }
  83                             else {
  84                                 push @{ $tables{ $item{'table_name'} }{'indeces'} },
  85                                     $line;
  86                             }
  87                             $tables{ $item{'table_name'} }{'type'} =
  88                                 $item{'table_type'}[0];
  89                         }
  90                     }
  91                        | <error>
  92
  93         line         : index
  94                        | field
  95                        | <error>
  96
  97         comment      : /^\s*#.*\n/
  98
  99         blank        : /\s*/
 100
 101         field        : field_name data_type not_null(?) default_val(?) auto_inc(?) primary_key(?)
 102                        {
 103                             my $null = defined $item{'not_null'}[0]
 104                                        ? $item{'not_null'}[0] : 1 ;
 105                             $return = {
 106                                 type           => 'field',
 107                                 name           => $item{'field_name'},
 108                                 data_type      => $item{'data_type'}{'type'},
 109                                 size           => $item{'data_type'}{'size'},
 110                                 null           => $null,
 111                                 default        => $item{'default_val'}[0],
 112                                 is_auto_inc    => $item{'auto_inc'}[0],
 113                                 is_primary_key => $item{'primary_key'}[0],
 114                            }
 115                        }
 116                     | <error>
 117
 118         index        : primary_key_index
 119                        | unique_index
 120                        | normal_index
 121
 122         table_name   : WORD
 123
 124         field_name   : WORD
 125
 126         index_name   : WORD
 127
 128         data_type    : WORD field_size(?)
 129             {
 130                 $return = {
 131                     type => $item[1],
 132                     size => $item[2][0]
 133                 }
 134             }
 135
 136         field_type   : WORD
 137
 138         field_size   : '(' num_range ')' { $item{'num_range'} }
 139
 140         num_range    : DIGITS ',' DIGITS
 141             { $return = $item[1].','.$item[3] }
 142                        | DIGITS
 143             { $return = $item[1] }
 144
 145
 146         create_table : /create/i /table/i
 147
 148         not_null     : /not/i /null/i { $return = 0 }
 149
 150         default_val  : /default/i /(?:')?[\w\d.-]*(?:')?/ { $item[2]=~s/'//g; $return=$item[2] }
 151
 152         auto_inc     : /auto_increment/i { 1 }
 153
 154         primary_key  : /primary/i /key/i { 1 }
 155
 156         primary_key_index : primary_key index_name(?) '(' field_name(s /,/) ')'
 157             {
 158                 $return = {
 159                     name   => $item{'index_name'}[0],
 160                     type   => 'primary_key',
 161                     fields => $item[4],
 162                 }
 163             }
 164
 165         normal_index      : key index_name(?) '(' field_name(s /,/) ')'
 166             {
 167                 $return = {
 168                     name   => $item{'index_name'}[0],
 169                     type   => 'normal',
 170                     fields => $item[4],
 171                 }
 172             }
 173
 174         unique_index      : /unique/i key index_name(?) '(' field_name(s /,/) ')'
 175             {
 176                 $return = {
 177                     name   => $item{'index_name'}[0],
 178                     type   => 'unique',
 179                     fields => $item[5],
 180                 }
 181             }
 182
 183         key          : /key/i
 184                        | /index/i
 185
 186         table_type   : /TYPE=/i /\w+/ { $item[2] }
 187
 188         WORD         : /\w+/
 189
 190         DIGITS       : /\d+/
 191
 192         COMMA        : ','
 193
 194     !;
 195
 196 1;
 197
 198 #-----------------------------------------------------
 199 # Where man is not nature is barren.
 200 # William Blake
 201 #-----------------------------------------------------
 202
 203 =head1 NAME
 204
 205 SQL::Translator::Parser::MySQL - parser for MySQL
 206
 207 =head1 SYNOPSIS
 208
 209   use SQL::Translator;
 210   use SQL::Translator::Parser::MySQL;
 211
 212   my $translator = SQL::Translator->new;
 213   $translator->parser("SQL::Translator::Parser::MySQL");
 214
 215 =head1 DESCRIPTION
 216
 217 Blah blah blah.
 218
 219 =head1 AUTHOR
 220
 221 Ken Y. Clark, kclark@logsoft.com
 222
 223 =head1 SEE ALSO
 224
 225 perl(1).
 226
 227 =cut