X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FTranslator%2FParser%2FMySQL.pm;h=b99ff5369482b7d14fa3e4e727dfb7d1cab09e5d;hb=8d0f3086649b45d56dcb4fdbaac9a9d3e2f3eeca;hp=b119217ddf8ea1de2aeb62a9d6078f996691c8b1;hpb=9a7841ddb10b27d35ad58eecb5f413e8bdaa907f;p=dbsrgits%2FSQL-Translator.git diff --git a/lib/SQL/Translator/Parser/MySQL.pm b/lib/SQL/Translator/Parser/MySQL.pm index b119217..b99ff53 100644 --- a/lib/SQL/Translator/Parser/MySQL.pm +++ b/lib/SQL/Translator/Parser/MySQL.pm @@ -1,10 +1,11 @@ package SQL::Translator::Parser::MySQL; -#----------------------------------------------------- -# $Id: MySQL.pm,v 1.2 2002-03-21 18:50:53 dlc Exp $ -#----------------------------------------------------- -# Copyright (C) 2002 Ken Y. Clark , -# darren chamberlain +# ------------------------------------------------------------------- +# $Id: MySQL.pm,v 1.10 2003-01-29 13:28:28 dlc Exp $ +# ------------------------------------------------------------------- +# Copyright (C) 2003 Ken Y. Clark , +# darren chamberlain , +# Chris Mungall # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License as @@ -21,207 +22,328 @@ package SQL::Translator::Parser::MySQL; # 02111-1307 USA # ------------------------------------------------------------------- +=head1 NAME + +SQL::Translator::Parser::MySQL - parser for MySQL + +=head1 SYNOPSIS + + use SQL::Translator; + use SQL::Translator::Parser::MySQL; + + my $translator = SQL::Translator->new; + $translator->parser("SQL::Translator::Parser::MySQL"); + +=head1 DESCRIPTION + +The grammar is influenced heavily by Tim Bunce's "mysql2ora" grammar. + +=cut + use strict; -use vars qw($VERSION $GRAMMAR @EXPORT_OK); -$VERSION = sprintf "%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/; +use vars qw[ $DEBUG $VERSION $GRAMMAR @EXPORT_OK ]; +$VERSION = sprintf "%d.%02d", q$Revision: 1.10 $ =~ /(\d+)\.(\d+)/; +$DEBUG = 0 unless defined $DEBUG; -#use SQL::Translator::Parser; # This is not necessary! +use Data::Dumper; use Parse::RecDescent; use Exporter; use base qw(Exporter); @EXPORT_OK = qw(parse); +# Enable warnings within the Parse::RecDescent module. +$::RD_ERRORS = 1; # Make sure the parser dies when it encounters an error +$::RD_WARN = 1; # Enable warnings. This will warn on unused rules &c. +$::RD_HINT = 1; # Give out hints to help fix problems. + my $parser; # should we do this? There's no programmic way to # change the grammar, so I think this is safe. -sub parse { - my ( $translator, $data ) = @_; - $parser ||= Parse::RecDescent->new($GRAMMAR); - unless (defined $parser) { - $translator->error_out("Error instantiating Parse::RecDescent ". - "instance: Bad grammer"); - return; - } +$GRAMMAR = q! + +{ our ( %tables, $table_order ) } + +startrule : statement(s) { \%tables } + +statement : comment + | drop + | create + | + +drop : /drop/i WORD(s) ';' + +create : create_table table_name '(' create_definition(s /,/) ')' table_option(s?) ';' + { + my $table_name = $item{'table_name'}; + $tables{ $table_name }{'order'} = ++$table_order; + $tables{ $table_name }{'table_name'} = $table_name; + + my $i = 1; + for my $definition ( @{ $item[4] } ) { + if ( $definition->{'type'} eq 'field' ) { + my $field_name = $definition->{'name'}; + $tables{ $table_name }{'fields'}{ $field_name } = + { %$definition, order => $i }; + $i++; + + if ( $definition->{'is_primary_key'} ) { + push @{ $tables{ $table_name }{'indices'} }, + { + type => 'primary_key', + fields => [ $field_name ], + } + ; + } + } + else { + push @{ $tables{ $table_name }{'indices'} }, + $definition; + } + } - # Is this right? It was $parser->parse before, but that didn't - # work; Parse::RecDescent appears to need the name of a rule - # with which to begin, so I chose the first rule in the grammar. - return $parser->file($data); -} + for my $opt ( @{ $item{'table_option'} } ) { + if ( my ( $key, $val ) = each %$opt ) { + $tables{ $table_name }{'table_options'}{ $key } = $val; + } + } + } -$GRAMMAR = - q! - { our ( %tables ) } - - file : statement(s) { \%tables } - - statement : comment - | create - | - - create : create_table table_name '(' line(s /,/) ')' table_type(?) ';' - { - my $i = 0; - for my $line ( @{ $item[4] } ) { - if ( $line->{'type'} eq 'field' ) { - my $field_name = $line->{'name'}; - $tables{ $item{'table_name'} } - {'fields'}{$field_name} = - { %$line, order => $i }; - $i++; - - if ( $line->{'is_primary_key'} ) { - push - @{ $tables{ $item{'table_name'} }{'indeces'} }, - { - type => 'primary_key', - fields => [ $field_name ], - }; - } - } - else { - push @{ $tables{ $item{'table_name'} }{'indeces'} }, - $line; - } - $tables{ $item{'table_name'} }{'type'} = - $item{'table_type'}[0]; - } - } - | - - line : index - | field - | - - comment : /^\s*#.*\n/ - - blank : /\s*/ - - field : field_name data_type not_null(?) default_val(?) auto_inc(?) primary_key(?) - { - my $null = defined $item{'not_null'}[0] - ? $item{'not_null'}[0] : 1 ; - $return = { - type => 'field', - name => $item{'field_name'}, - data_type => $item{'data_type'}{'type'}, - size => $item{'data_type'}{'size'}, - null => $null, - default => $item{'default_val'}[0], - is_auto_inc => $item{'auto_inc'}[0], - is_primary_key => $item{'primary_key'}[0], - } - } - | - - index : primary_key_index - | unique_index - | normal_index - - table_name : WORD - - field_name : WORD - - index_name : WORD - - data_type : WORD field_size(?) - { - $return = { - type => $item[1], - size => $item[2][0] - } +create : /CREATE/i unique(?) /(INDEX|KEY)/i index_name /on/i table_name '(' field_name(s /,/) ')' ';' + { + push @{ $tables{ $item{'table_name'} }{'indices'} }, + { + name => $item[4], + type => $item[2] ? 'unique' : 'normal', + fields => $item[8], } + ; + } - field_type : WORD +create_definition : index + | field + | + +comment : /^\s*(?:#|-{2}).*\n/ + +blank : /\s*/ + +field : field_name data_type field_qualifier(s?) + { + my %qualifiers = map { %$_ } @{ $item{'field_qualifier'} || [] }; + my $null = defined $item{'not_null'} ? $item{'not_null'} : 1; + delete $qualifiers{'not_null'}; + if ( my @type_quals = @{ $item{'data_type'}{'qualifiers'} || [] } ) { + $qualifiers{ $_ } = 1 for @type_quals; + } + + $return = { + type => 'field', + name => $item{'field_name'}, + data_type => $item{'data_type'}{'type'}, + size => $item{'data_type'}{'size'}, + list => $item{'data_type'}{'list'}, + null => $null, + %qualifiers, + } + } + | - field_size : '(' num_range ')' { $item{'num_range'} } +field_qualifier : not_null + { + $return = { + null => $item{'not_null'}, + } + } - num_range : DIGITS ',' DIGITS - { $return = $item[1].','.$item[3] } - | DIGITS - { $return = $item[1] } +field_qualifier : default_val + { + $return = { + default => $item{'default_val'}, + } + } +field_qualifier : auto_inc + { + $return = { + is_auto_inc => $item{'auto_inc'}, + } + } - create_table : /create/i /table/i +field_qualifier : primary_key + { + $return = { + is_primary_key => $item{'primary_key'}, + } + } - not_null : /not/i /null/i { $return = 0 } +field_qualifier : unsigned + { + $return = { + is_unsigned => $item{'unsigned'}, + } + } - default_val : /default/i /(?:')?[\w\d.-]*(?:')?/ { $item[2]=~s/'//g; $return=$item[2] } +index : primary_key_index + | unique_index + | normal_index + +table_name : WORD + +field_name : WORD + +index_name : WORD + +data_type : WORD parens_value_list(s?) type_qualifier(s?) + { + my $type = $item[1]; + my $size; # field size, applicable only to non-set fields + my $list; # set list, applicable only to sets (duh) + + if ( uc($type) =~ /^(SET|ENUM)$/ ) { + $size = undef; + $list = $item[2][0]; + } + else { + $size = $item[2][0]; + $list = []; + } + + $return = { + type => $type, + size => $size, + list => $list, + qualifiers => $item[3], + } + } - auto_inc : /auto_increment/i { 1 } +parens_value_list : '(' VALUE(s /,/) ')' + { $item[2] } - primary_key : /primary/i /key/i { 1 } +type_qualifier : /(BINARY|UNSIGNED|ZEROFILL)/i + { lc $item[1] } - primary_key_index : primary_key index_name(?) '(' field_name(s /,/) ')' - { - $return = { - name => $item{'index_name'}[0], - type => 'primary_key', - fields => $item[4], - } - } +field_type : WORD - normal_index : key index_name(?) '(' field_name(s /,/) ')' - { - $return = { - name => $item{'index_name'}[0], - type => 'normal', - fields => $item[4], - } - } +field_size : '(' num_range ')' { $item{'num_range'} } - unique_index : /unique/i key index_name(?) '(' field_name(s /,/) ')' - { - $return = { - name => $item{'index_name'}[0], - type => 'unique', - fields => $item[5], - } - } +num_range : DIGITS ',' DIGITS + { $return = $item[1].','.$item[3] } + | DIGITS + { $return = $item[1] } - key : /key/i - | /index/i +create_table : /create/i /table/i - table_type : /TYPE=/i /\w+/ { $item[2] } +create_index : /create/i /index/i - WORD : /\w+/ +not_null : /not/i /null/i { $return = 0 } - DIGITS : /\d+/ +unsigned : /unsigned/i { $return = 0 } - COMMA : ',' +default_val : /default/i /(?:')?[\w\d.-]*(?:')?/ + { + $item[2] =~ s/'//g; + $return = $item[2]; + } - !; +auto_inc : /auto_increment/i { 1 } -1; +primary_key : /primary/i /key/i { 1 } -#----------------------------------------------------- -# Where man is not nature is barren. -# William Blake -#----------------------------------------------------- +primary_key_index : primary_key index_name(?) '(' field_name(s /,/) ')' + { + $return = { + name => $item{'index_name'}[0], + type => 'primary_key', + fields => $item[4], + } + } -=head1 NAME +normal_index : key index_name(?) '(' name_with_opt_paren(s /,/) ')' + { + $return = { + name => $item{'index_name'}[0], + type => 'normal', + fields => $item[4], + } + } -SQL::Translator::Parser::MySQL - parser for MySQL +unique_index : unique key(?) index_name(?) '(' name_with_opt_paren(s /,/) ')' + { + $return = { + name => $item{'index_name'}[0], + type => 'unique', + fields => $item[5], + } + } -=head1 SYNOPSIS +name_with_opt_paren : NAME parens_value_list(s?) + { $item[2][0] ? "$item[1]($item[2][0][0])" : $item[1] } - use SQL::Translator; - use SQL::Translator::Parser::MySQL; +unique : /unique/i { 1 } - my $translator = SQL::Translator->new; - $translator->parser("SQL::Translator::Parser::MySQL"); +key : /key/i | /index/i -=head1 DESCRIPTION +table_option : /[^\s;]*/ + { + $return = { split /=/, $item[1] } + } + +WORD : /\w+/ + +DIGITS : /\d+/ + +COMMA : ',' + +NAME : "`" /\w+/ "`" + { $item[2] } + | /\w+/ + { $item[1] } + +VALUE : /[-+]?\.?\d+(?:[eE]\d+)?/ + { $item[1] } + | /'.*?'/ # XXX doesn't handle embedded quotes + { $item[1] } + | /NULL/ + { 'NULL' } + +!; + +# ------------------------------------------------------------------- +sub parse { + my ( $translator, $data ) = @_; + $parser ||= Parse::RecDescent->new($GRAMMAR); + + $::RD_TRACE = $translator->trace ? 1 : undef; + $DEBUG = $translator->debug; + + unless (defined $parser) { + return $translator->error("Error instantiating Parse::RecDescent ". + "instance: Bad grammer"); + } + + my $result = $parser->startrule($data); + die "Parse failed.\n" unless defined $result; + warn Dumper($result) if $DEBUG; + return $result; +} + +1; + +#----------------------------------------------------- +# Where man is not nature is barren. +# William Blake +#----------------------------------------------------- -Blah blah blah. +=pod =head1 AUTHOR -Ken Y. Clark, kclark@logsoft.com +Ken Y. Clark Ekclark@cpan.orgE, +Chris Mungall =head1 SEE ALSO -perl(1). +perl(1), Parse::RecDescent. =cut