lib/SQL/Translator/Parser/MySQL.pm

   1 package SQL::Translator::Parser::MySQL;
   2
   3 #-----------------------------------------------------
   4 # $Id: MySQL.pm,v 1.3 2002-07-23 19:22:11 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.3 $ =~ /(\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'} }{'indeces'} },
  76                                     {
  77                                         type   => 'primary_key',
  78                                         fields => [ $field_name ],
  79                                     };
  80                                 }
  81                             }
  82                             else {
  83                                 push @{ $tables{ $item{'table_name'} }{'indeces'} },
  84                                     $line;
  85                             }
  86                             $tables{ $item{'table_name'} }{'type'} =
  87                                 $item{'table_type'}[0];
  88                         }
  89                     }
  90                        | <error>
  91
  92         line         : index
  93                        | field
  94                        | <error>
  95
  96         comment      : /^\s*#.*\n/
  97
  98         blank        : /\s*/
  99
 100         field        : field_name data_type not_null(?) default_val(?) auto_inc(?) primary_key(?)
 101                        {
 102                             my $null = defined $item{'not_null'}[0]
 103                                        ? $item{'not_null'}[0] : 1 ;
 104                             $return = {
 105                                 type           => 'field',
 106                                 name           => $item{'field_name'},
 107                                 data_type      => $item{'data_type'}{'type'},
 108                                 size           => $item{'data_type'}{'size'},
 109                                 null           => $null,
 110                                 default        => $item{'default_val'}[0],
 111                                 is_auto_inc    => $item{'auto_inc'}[0],
 112                                 is_primary_key => $item{'primary_key'}[0],
 113                            }
 114                        }
 115                     | <error>
 116
 117         index        : primary_key_index
 118                        | unique_index
 119                        | normal_index
 120
 121         table_name   : WORD
 122
 123         field_name   : WORD
 124
 125         index_name   : WORD
 126
 127         data_type    : WORD field_size(?)
 128             {
 129                 $return = {
 130                     type => $item[1],
 131                     size => $item[2][0]
 132                 }
 133             }
 134
 135         field_type   : WORD
 136
 137         field_size   : '(' num_range ')' { $item{'num_range'} }
 138
 139         num_range    : DIGITS ',' DIGITS
 140             { $return = $item[1].','.$item[3] }
 141                        | DIGITS
 142             { $return = $item[1] }
 143
 144
 145         create_table : /create/i /table/i
 146
 147         not_null     : /not/i /null/i { $return = 0 }
 148
 149         default_val  : /default/i /(?:')?[\w\d.-]*(?:')?/ { $item[2]=~s/'//g; $return=$item[2] }
 150
 151         auto_inc     : /auto_increment/i { 1 }
 152
 153         primary_key  : /primary/i /key/i { 1 }
 154
 155         primary_key_index : primary_key index_name(?) '(' field_name(s /,/) ')'
 156             {
 157                 $return = {
 158                     name   => $item{'index_name'}[0],
 159                     type   => 'primary_key',
 160                     fields => $item[4],
 161                 }
 162             }
 163
 164         normal_index      : key index_name(?) '(' field_name(s /,/) ')'
 165             {
 166                 $return = {
 167                     name   => $item{'index_name'}[0],
 168                     type   => 'normal',
 169                     fields => $item[4],
 170                 }
 171             }
 172
 173         unique_index      : /unique/i key index_name(?) '(' field_name(s /,/) ')'
 174             {
 175                 $return = {
 176                     name   => $item{'index_name'}[0],
 177                     type   => 'unique',
 178                     fields => $item[5],
 179                 }
 180             }
 181
 182         key          : /key/i
 183                        | /index/i
 184
 185         table_type   : /TYPE=/i /\w+/ { $item[2] }
 186
 187         WORD         : /\w+/
 188
 189         DIGITS       : /\d+/
 190
 191         COMMA        : ','
 192
 193     !;
 194
 195 1;
 196
 197 #-----------------------------------------------------
 198 # Where man is not nature is barren.
 199 # William Blake
 200 #-----------------------------------------------------
 201
 202 =head1 NAME
 203
 204 SQL::Translator::Parser::MySQL - parser for MySQL
 205
 206 =head1 SYNOPSIS
 207
 208   use SQL::Translator;
 209   use SQL::Translator::Parser::MySQL;
 210
 211   my $translator = SQL::Translator->new;
 212   $translator->parser("SQL::Translator::Parser::MySQL");
 213
 214 =head1 DESCRIPTION
 215
 216 Blah blah blah.
 217
 218 =head1 AUTHOR
 219
 220 Ken Y. Clark, kclark@logsoft.com
 221
 222 =head1 SEE ALSO
 223
 224 perl(1).
 225
 226 =cut