lib/SQL/Translator/Parser/DBI/MySQL.pm

   1 package SQL::Translator::Parser::DBI::MySQL;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: MySQL.pm,v 1.5 2005-07-12 16:05:35 duality72 Exp $
   5 # -------------------------------------------------------------------
   6 # Copyright (C) 2002-4 SQLFairy Authors
   7 #
   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.
  11 #
  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.
  16 #
  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
  20 # 02111-1307  USA
  21 # -------------------------------------------------------------------
  22
  23 =head1 NAME
  24
  25 SQL::Translator::Parser::DBI::MySQL - parser for DBD::mysql
  26
  27 =head1 SYNOPSIS
  28
  29 This module will be invoked automatically by SQL::Translator::Parser::DBI,
  30 so there is no need to use it directly.
  31
  32 =head1 DESCRIPTION
  33
  34 Uses SQL calls to query database directly for schema rather than parsing
  35 a create file.  Should be much faster for larger schemas.
  36
  37 =cut
  38
  39 use strict;
  40 use DBI;
  41 use Data::Dumper;
  42 use SQL::Translator::Schema::Constants;
  43
  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;
  47
  48 # -------------------------------------------------------------------
  49 sub parse {
  50     my ( $tr, $dbh ) = @_;
  51     my $schema       = $tr->schema;
  52     my @table_names  = @{ $dbh->selectcol_arrayref( 'show tables') };
  53
  54     for my $table_name ( @table_names ) {
  55         my $table =  $schema->add_table(
  56             name  => $table_name,
  57         ) or die $schema->error;
  58
  59         my $cols = $dbh->selectall_arrayref(
  60             "desc $table_name",
  61             { Columns => {} }
  62         );
  63
  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;
  73
  74             my ( $data_type, $size, $char_set );
  75
  76             #
  77             # Normal datatype = "int(11)"
  78             # or "varchar(20) character set latin1"
  79             #
  80             if ( $type =~ m{
  81                 (\w+)       # data type
  82                 \(          # open paren
  83                 (\d+)       # first number
  84                 (?:,(\d+))? # optional comma and number
  85                 \)          # close paren
  86                 (.*)?       # anything else (character set)
  87                 }x
  88             ) {
  89                 $data_type = $1;
  90                 $size      = $2;
  91                 $size     .= ",$3" if $3;
  92                 $char_set  = $4 || '';
  93             }
  94             #
  95             # Some data type just say "double" or "text"
  96             #
  97             elsif ( $type =~ m{
  98                 (\w+)       # data type
  99                 (.*)?       # anything else (character set)
 100                 }x
 101             ) {
 102                 $data_type = $1;
 103                 $size      = undef;
 104                 $char_set  = $2 || '';
 105             }
 106
 107             my $field             =  $table->add_field(
 108                 name              => $fname,
 109                 data_type         => $data_type,
 110                 size              => $size,
 111                 default_value     => $default,
 112                 is_auto_increment => $is_auto_inc,
 113                 is_nullable       => $is_nullable,
 114                 comments          => $extra,
 115             ) or die $table->error;
 116
 117             $table->primary_key( $field->name ) if $key eq 'PRI';
 118         }
 119
 120         my $indices = $dbh->selectall_arrayref(
 121             "show index from $table_name",
 122             { Columns => {} },
 123         );
 124
 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'};
 139
 140             my $is_constraint = $key_name eq 'PRIMARY' || $non_unique == 0;
 141
 142             if ( $is_constraint ) {
 143                 $constraints{ $key_name }{'order'} = ++$order;
 144                 push @{ $constraints{ $key_name }{'fields'} }, $column_name;
 145
 146                 if ( $key_name eq 'PRIMARY' ) {
 147                     $constraints{ $key_name }{'type'} = PRIMARY_KEY;
 148                 }
 149                 elsif ( $non_unique == 0 ) {
 150                     $constraints{ $key_name }{'type'} = UNIQUE;
 151                 }
 152             }
 153             else {
 154                 $keys{ $key_name }{'order'} = ++$order;
 155                 push @{ $keys{ $key_name }{'fields'} }, $column_name;
 156             }
 157         }
 158
 159         for my $key_name (
 160             sort { $keys{ $a }{'order'} <=> $keys{ $b }{'order'} }
 161             keys %keys
 162         ) {
 163             my $key    = $keys{ $key_name };
 164             my $index  =  $table->add_index(
 165                 name   => $key_name,
 166                 type   => NORMAL,
 167                 fields => $key->{'fields'},
 168             ) or die $table->error;
 169         }
 170
 171         for my $constraint_name (
 172             sort { $constraints{ $a }{'order'} <=> $constraints{ $b }{'order'} }
 173             keys %constraints
 174         ) {
 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;
 181         }
 182     }
 183
 184     return 1;
 185 }
 186
 187 1;
 188
 189 # -------------------------------------------------------------------
 190 # Where man is not nature is barren.
 191 # William Blake
 192 # -------------------------------------------------------------------
 193
 194 =pod
 195
 196 =head1 AUTHOR
 197
 198 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
 199
 200 =head1 SEE ALSO
 201
 202 SQL::Translator.
 203
 204 =cut