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

   1 package SQL::Translator::Parser::DBI::MySQL;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: MySQL.pm,v 1.4 2004-02-09 22:23:40 kycl4rk 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.4 $ =~ /(\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
  73             my ( $data_type, $size, $char_set );
  74
  75             #
  76             # Normal datatype = "int(11)"
  77             # or "varchar(20) character set latin1"
  78             #
  79             if ( $type =~ m{
  80                 (\w+)       # data type
  81                 \(          # open paren
  82                 (\d+)       # first number
  83                 (?:,(\d+))? # optional comma and number
  84                 \)          # close paren
  85                 (.*)?       # anything else (character set)
  86                 }x
  87             ) {
  88                 $data_type = $1;
  89                 $size      = $2;
  90                 $size     .= ",$3" if $3;
  91                 $char_set  = $4 || '';
  92             }
  93             #
  94             # Some data type just say "double" or "text"
  95             #
  96             elsif ( $type =~ m{
  97                 (\w+)       # data type
  98                 (.*)?       # anything else (character set)
  99                 }x
 100             ) {
 101                 $data_type = $1;
 102                 $size      = undef;
 103                 $char_set  = $2 || '';
 104             }
 105
 106             my $field             =  $table->add_field(
 107                 name              => $fname,
 108                 data_type         => $data_type,
 109                 size              => $size,
 110                 default_value     => $default,
 111                 is_auto_increment => $extra eq 'auto_increment',
 112                 is_nullable       => $is_nullable,
 113                 comments          => $extra,
 114             ) or die $table->error;
 115
 116             $table->primary_key( $field->name ) if $key eq 'PRI';
 117         }
 118
 119         my $indices = $dbh->selectall_arrayref(
 120             "show index from $table_name",
 121             { Columns => {} },
 122         );
 123
 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'};
 138
 139             my $is_constraint = $key_name eq 'PRIMARY' || $non_unique == 0;
 140
 141             if ( $is_constraint ) {
 142                 $constraints{ $key_name }{'order'} = ++$order;
 143                 push @{ $constraints{ $key_name }{'fields'} }, $column_name;
 144
 145                 if ( $key_name eq 'PRIMARY' ) {
 146                     $constraints{ $key_name }{'type'} = PRIMARY_KEY;
 147                 }
 148                 elsif ( $non_unique == 0 ) {
 149                     $constraints{ $key_name }{'type'} = UNIQUE;
 150                 }
 151             }
 152             else {
 153                 $keys{ $key_name }{'order'} = ++$order;
 154                 push @{ $keys{ $key_name }{'fields'} }, $column_name;
 155             }
 156         }
 157
 158         for my $key_name (
 159             sort { $keys{ $a }{'order'} <=> $keys{ $b }{'order'} }
 160             keys %keys
 161         ) {
 162             my $key    = $keys{ $key_name };
 163             my $index  =  $table->add_index(
 164                 name   => $key_name,
 165                 type   => NORMAL,
 166                 fields => $key->{'fields'},
 167             ) or die $table->error;
 168         }
 169
 170         for my $constraint_name (
 171             sort { $constraints{ $a }{'order'} <=> $constraints{ $b }{'order'} }
 172             keys %constraints
 173         ) {
 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;
 180         }
 181     }
 182
 183     return 1;
 184 }
 185
 186 1;
 187
 188 # -------------------------------------------------------------------
 189 # Where man is not nature is barren.
 190 # William Blake
 191 # -------------------------------------------------------------------
 192
 193 =pod
 194
 195 =head1 AUTHOR
 196
 197 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
 198
 199 =head1 SEE ALSO
 200
 201 SQL::Translator.
 202
 203 =cut