package SQL::Translator::Parser::DBI::MySQL;
# -------------------------------------------------------------------
-# $Id: MySQL.pm,v 1.2 2003-10-03 19:47:19 kycl4rk Exp $
-# -------------------------------------------------------------------
-# Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>.
+# Copyright (C) 2002-2009 SQLFairy Authors
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as
=head1 SYNOPSIS
-See SQL::Translator::Parser::DBI.
+This module will be invoked automatically by SQL::Translator::Parser::DBI,
+so there is no need to use it directly.
=head1 DESCRIPTION
-Queries the "sqlite_master" table for schema definition.
+Uses SQL calls to query database directly for schema rather than parsing
+a create file. Should be much faster for larger schemas.
=cut
use DBI;
use Data::Dumper;
use SQL::Translator::Schema::Constants;
+use SQL::Translator::Parser::MySQL;
use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
-$VERSION = sprintf "%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/;
+$VERSION = '1.60';
$DEBUG = 0 unless defined $DEBUG;
# -------------------------------------------------------------------
sub parse {
my ( $tr, $dbh ) = @_;
+ my $schema = $tr->schema;
+ my @table_names = @{ $dbh->selectcol_arrayref('show tables') };
+ my @skip_tables = defined $tr->parser_args->{skip}
+ ? split(/,/, $tr->parser_args->{skip})
+ : ();
- my @table_names = @{ $dbh->selectcol_arrayref( 'show tables') };
-
- my $schema = $tr->schema;
+ $dbh->{'FetchHashKeyName'} = 'NAME_lc';
+ my $create;
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;
- }
+ next if (grep /^$table_name$/, @skip_tables);
+ my $sth = $dbh->prepare("show create table $table_name");
+ $sth->execute;
+ my $table = $sth->fetchrow_hashref;
+ $create .= $table->{'create table'} . ";\n\n";
}
+ SQL::Translator::Parser::MySQL::parse( $tr, $create );
+
return 1;
}
=head1 AUTHOR
-Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
+Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
=head1 SEE ALSO
-perl(1), Parse::RecDescent, SQL::Translator::Schema.
+SQL::Translator.
=cut
projects / dbsrgits/SQL-Translator.git / blobdiff