1 package SQL::Translator::Parser::DBI::MySQL;
3 # -------------------------------------------------------------------
4 # $Id: MySQL.pm,v 1.2 2003-10-03 19:47:19 kycl4rk Exp $
5 # -------------------------------------------------------------------
6 # Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>.
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 See SQL::Translator::Parser::DBI.
33 Queries the "sqlite_master" table for schema definition.
40 use SQL::Translator::Schema::Constants;
42 use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
43 $VERSION = sprintf "%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/;
44 $DEBUG = 0 unless defined $DEBUG;
46 # -------------------------------------------------------------------
48 my ( $tr, $dbh ) = @_;
50 my @table_names = @{ $dbh->selectcol_arrayref( 'show tables') };
52 my $schema = $tr->schema;
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'};
73 my ( $data_type, $size, $char_set );
76 # Normal datatype = "int(11)"
77 # or "varchar(20) character set latin1"
83 (?:,(\d+))? # optional comma and number
85 (.*)? # anything else (character set)
94 # Some data type just say "double" or "text"
98 (.*)? # anything else (character set)
103 $char_set = $2 || '';
106 my $field = $table->add_field(
108 data_type => $data_type,
110 default_value => $default,
111 is_auto_increment => $extra eq 'auto_increment',
112 is_nullable => $is_nullable,
114 ) or die $table->error;
116 $table->primary_key( $field->name ) if $key eq 'PRI';
119 my $indices = $dbh->selectall_arrayref(
120 "show index from $table_name",
124 my ( %keys, %constraints, $order );
125 for my $index ( @$indices ) {
126 my $table = $index->{'table'};
127 my $non_unique = $index->{'non_unique'};
128 my $key_name = $index->{'key_name'} || '';
129 my $seq_in_index = $index->{'seq_in_index'};
130 my $column_name = $index->{'column_name'};
131 my $collation = $index->{'collation'};
132 my $cardinality = $index->{'cardinality'};
133 my $sub_part = $index->{'sub_part'};
134 my $packed = $index->{'packed'};
135 my $null = $index->{'null'};
136 my $index_type = $index->{'index_type'};
137 my $comment = $index->{'comment'};
139 my $is_constraint = $key_name eq 'PRIMARY' || $non_unique == 0;
141 if ( $is_constraint ) {
142 $constraints{ $key_name }{'order'} = ++$order;
143 push @{ $constraints{ $key_name }{'fields'} }, $column_name;
145 if ( $key_name eq 'PRIMARY' ) {
146 $constraints{ $key_name }{'type'} = PRIMARY_KEY;
148 elsif ( $non_unique == 0 ) {
149 $constraints{ $key_name }{'type'} = UNIQUE;
153 $keys{ $key_name }{'order'} = ++$order;
154 push @{ $keys{ $key_name }{'fields'} }, $column_name;
159 sort { $keys{ $a }{'order'} <=> $keys{ $b }{'order'} }
162 my $key = $keys{ $key_name };
163 my $index = $table->add_index(
166 fields => $key->{'fields'},
167 ) or die $table->error;
170 for my $constraint_name (
171 sort { $constraints{ $a }{'order'} <=> $constraints{ $b }{'order'} }
174 my $def = $constraints{ $constraint_name };
175 my $constraint = $table->add_constraint(
176 name => $constraint_name,
177 type => $def->{'type'},
178 fields => $def->{'fields'},
179 ) or die $table->error;
188 # -------------------------------------------------------------------
189 # Where man is not nature is barren.
191 # -------------------------------------------------------------------
197 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
201 perl(1), Parse::RecDescent, SQL::Translator::Schema.