1 package SQL::Translator::Parser::DBI::MySQL;
3 # -------------------------------------------------------------------
4 # $Id: MySQL.pm,v 1.5 2005-07-12 16:05:35 duality72 Exp $
5 # -------------------------------------------------------------------
6 # Copyright (C) 2002-4 SQLFairy Authors
8 # This program is free software; you can redistribute it and/or
9 # modify it under the terms of the GNU General Public License as
10 # published by the Free Software Foundation; version 2.
12 # This program is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15 # General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with this program; if not, write to the Free Software
19 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
21 # -------------------------------------------------------------------
25 SQL::Translator::Parser::DBI::MySQL - parser for DBD::mysql
29 This module will be invoked automatically by SQL::Translator::Parser::DBI,
30 so there is no need to use it directly.
34 Uses SQL calls to query database directly for schema rather than parsing
35 a create file. Should be much faster for larger schemas.
42 use SQL::Translator::Schema::Constants;
44 use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
45 $VERSION = sprintf "%d.%02d", q$Revision: 1.5 $ =~ /(\d+)\.(\d+)/;
46 $DEBUG = 0 unless defined $DEBUG;
48 # -------------------------------------------------------------------
50 my ( $tr, $dbh ) = @_;
51 my $schema = $tr->schema;
52 my @table_names = @{ $dbh->selectcol_arrayref( 'show tables') };
54 for my $table_name ( @table_names ) {
55 my $table = $schema->add_table(
57 ) or die $schema->error;
59 my $cols = $dbh->selectall_arrayref(
64 for my $col ( @$cols ) {
65 my $fname = $col->{'field'} or next;
66 my $type = $col->{'type'} or next;
67 my $collation = $col->{'collation'} || '';
68 my $is_nullable = uc $col->{'null'} eq 'YES' ? 1 : 0;
69 my $key = $col->{'key'};
70 my $default = $col->{'default'};
71 my $extra = $col->{'extra'};
72 my $is_auto_inc = $extra =~ s/auto_increment//i;
74 my ( $data_type, $size, $char_set );
77 # Normal datatype = "int(11)"
78 # or "varchar(20) character set latin1"
84 (?:,(\d+))? # optional comma and number
86 (.*)? # anything else (character set)
95 # Some data type just say "double" or "text"
99 (.*)? # anything else (character set)
104 $char_set = $2 || '';
107 my $field = $table->add_field(
109 data_type => $data_type,
111 default_value => $default,
112 is_auto_increment => $is_auto_inc,
113 is_nullable => $is_nullable,
115 ) or die $table->error;
117 $table->primary_key( $field->name ) if $key eq 'PRI';
120 my $indices = $dbh->selectall_arrayref(
121 "show index from $table_name",
125 my ( %keys, %constraints, $order );
126 for my $index ( @$indices ) {
127 my $table = $index->{'table'};
128 my $non_unique = $index->{'non_unique'};
129 my $key_name = $index->{'key_name'} || '';
130 my $seq_in_index = $index->{'seq_in_index'};
131 my $column_name = $index->{'column_name'};
132 my $collation = $index->{'collation'};
133 my $cardinality = $index->{'cardinality'};
134 my $sub_part = $index->{'sub_part'};
135 my $packed = $index->{'packed'};
136 my $null = $index->{'null'};
137 my $index_type = $index->{'index_type'};
138 my $comment = $index->{'comment'};
140 my $is_constraint = $key_name eq 'PRIMARY' || $non_unique == 0;
142 if ( $is_constraint ) {
143 $constraints{ $key_name }{'order'} = ++$order;
144 push @{ $constraints{ $key_name }{'fields'} }, $column_name;
146 if ( $key_name eq 'PRIMARY' ) {
147 $constraints{ $key_name }{'type'} = PRIMARY_KEY;
149 elsif ( $non_unique == 0 ) {
150 $constraints{ $key_name }{'type'} = UNIQUE;
154 $keys{ $key_name }{'order'} = ++$order;
155 push @{ $keys{ $key_name }{'fields'} }, $column_name;
160 sort { $keys{ $a }{'order'} <=> $keys{ $b }{'order'} }
163 my $key = $keys{ $key_name };
164 my $index = $table->add_index(
167 fields => $key->{'fields'},
168 ) or die $table->error;
171 for my $constraint_name (
172 sort { $constraints{ $a }{'order'} <=> $constraints{ $b }{'order'} }
175 my $def = $constraints{ $constraint_name };
176 my $constraint = $table->add_constraint(
177 name => $constraint_name,
178 type => $def->{'type'},
179 fields => $def->{'fields'},
180 ) or die $table->error;
189 # -------------------------------------------------------------------
190 # Where man is not nature is barren.
192 # -------------------------------------------------------------------
198 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.