From: Ken Youens-Clark Date: Fri, 3 Oct 2003 19:29:31 +0000 (+0000) Subject: Adding a MySQL/DBI parser that talks to the db for the structures. X-Git-Tag: v0.04~148 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=34d79f68b3bb11e8ebc89f458f163c04edfb16d3;p=dbsrgits%2FSQL-Translator.git Adding a MySQL/DBI parser that talks to the db for the structures. --- diff --git a/lib/SQL/Translator/Parser/DBI/MySQL.pm b/lib/SQL/Translator/Parser/DBI/MySQL.pm new file mode 100644 index 0000000..ec8b7c7 --- /dev/null +++ b/lib/SQL/Translator/Parser/DBI/MySQL.pm @@ -0,0 +1,204 @@ +package SQL::Translator::Parser::DBI::MySQL; + +# ------------------------------------------------------------------- +# $Id: MySQL.pm,v 1.1 2003-10-03 19:29:31 kycl4rk Exp $ +# ------------------------------------------------------------------- +# Copyright (C) 2003 Ken Y. Clark . +# +# This program is free software; you can redistribute it and/or +# modify it under the terms of the GNU General Public License as +# published by the Free Software Foundation; version 2. +# +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA +# 02111-1307 USA +# ------------------------------------------------------------------- + +=head1 NAME + +SQL::Translator::Parser::DBI::MySQL - parser for DBD::mysql + +=head1 SYNOPSIS + +See SQL::Translator::Parser::DBI. + +=head1 DESCRIPTION + +Queries the "sqlite_master" table for schema definition. + +=cut + +use strict; +use DBI; +use Data::Dumper; +use SQL::Translator::Schema::Constants; + +use vars qw[ $DEBUG $VERSION @EXPORT_OK ]; +$VERSION = sprintf "%d.%02d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/; +$DEBUG = 0 unless defined $DEBUG; + +# ------------------------------------------------------------------- +sub parse { + my ( $tr, $dbh ) = @_; + + my @table_names = @{ $dbh->selectcol_arrayref( 'show tables') }; + + my $schema = $tr->schema; + + for my $table_name ( @table_names ) { + my $table = $schema->add_table( + name => $table_name, + ) or die $schema->error; + + my $cols = $dbh->selectall_arrayref( + "desc $table_name", + { Columns => {} } + ); + + for my $col ( @$cols ) { + my $fname = $col->{'field'} or next; + my $type = $col->{'type'} or next; + my $collation = $col->{'collation'} || ''; + my $is_nullable = uc $col->{'null'} eq 'YES' ? 1 : 0; + my $key = $col->{'key'}; + my $default = $col->{'default'}; + my $extra = $col->{'extra'}; + + my ( $data_type, $size, $char_set ); + + # + # Normal datatype = "int(11)" + # or "varchar(20) character set latin1" + # + if ( $type =~ m{ + (\w+) # data type + \( # open paren + (\d+) # first number + (?:,(\d+))? # optional comma and number + \) # close paren + (.*)? # anything else (character set) + }x + ) { + $data_type = $1; + $size = $2; + $size .= ",$3" if $3; + $char_set = $4 || ''; + } + # + # Some data type just say "double" or "text" + # + elsif ( $type =~ m{ + (\w+) # data type + (.*)? # anything else (character set) + }x + ) { + $data_type = $1; + $size = undef; + $char_set = $2 || ''; + } + + my $field = $table->add_field( + name => $fname, + data_type => $data_type, + size => $size, + default_value => $default, + is_auto_increment => $extra eq 'auto_increment', + is_nullable => $is_nullable, + comments => $extra, + ) or die $table->error; + + $table->primary_key( $field->name ) if $key eq 'PRI'; + } + + my $indices = $dbh->selectall_arrayref( + "show index from $table_name", + { Columns => {} }, + ); + + my ( %keys, %constraints, $order ); + for my $index ( @$indices ) { + my $table = $index->{'table'}; + my $non_unique = $index->{'non_unique'}; + my $key_name = $index->{'key_name'} || ''; + my $seq_in_index = $index->{'seq_in_index'}; + my $column_name = $index->{'column_name'}; + my $collation = $index->{'collation'}; + my $cardinality = $index->{'cardinality'}; + my $sub_part = $index->{'sub_part'}; + my $packed = $index->{'packed'}; + my $null = $index->{'null'}; + my $index_type = $index->{'index_type'}; + my $comment = $index->{'comment'}; + + my $is_constraint = $key_name eq 'PRIMARY' || $non_unique == 0; + + if ( $is_constraint ) { + $constraints{ $key_name }{'order'} = ++$order; + push @{ $constraints{ $key_name }{'fields'} }, $column_name; + + if ( $key_name eq 'PRIMARY' ) { + $constraints{ $key_name }{'type'} = PRIMARY_KEY; + } + elsif ( $non_unique == 0 ) { + $constraints{ $key_name }{'type'} = UNIQUE; + } + } + else { + $keys{ $key_name }{'order'} = ++$order; + push @{ $keys{ $key_name }{'fields'} }, $column_name; + } + } + + for my $key_name ( + sort { $keys{ $a }{'order'} <=> $keys{ $b }{'order'} } + keys %keys + ) { + my $key = $keys{ $key_name }; + my $index = $table->add_index( + name => $key_name, + type => NORMAL, + fields => $key->{'fields'}, + ) or die $table->error; + } + + for my $constraint_name ( + sort { $constraints{ $a }{'order'} <=> $constraints{ $b }{'order'} } + keys %constraints + ) { + my $def = $constraints{ $constraint_name }; + my $constraint = $table->add_constraint( + name => $constraint_name, + type => $def->{'type'}, + fields => $def->{'fields'}, + ) or die $table->error; + } + } + + return 1; +} + +1; + +# ------------------------------------------------------------------- +# Where man is not nature is barren. +# William Blake +# ------------------------------------------------------------------- + +=pod + +=head1 AUTHOR + +Ken Y. Clark Ekclark@cpan.orgE, +Chris Mungall Ecjm@fruitfly.orgE. + +=head1 SEE ALSO + +perl(1), Parse::RecDescent, SQL::Translator::Schema. + +=cut