lib/SQL/Translator/Parser/DBI.pm

   1 use MooseX::Declare;
   2 role SQL::Translator::Parser::DBI {
   3     use DBI::Const::GetInfoType;
   4     use DBI::Const::GetInfo::ANSI;
   5     use DBI::Const::GetInfoReturn;
   6
   7     use MooseX::Types::Moose qw(HashRef Maybe Str);
   8     use MooseX::MultiMethods;
   9
  10     use SQL::Translator::Object::Column;
  11     use SQL::Translator::Object::ForeignKey;
  12     use SQL::Translator::Object::Index;
  13     use SQL::Translator::Object::PrimaryKey;
  14     use SQL::Translator::Object::Table;
  15     use SQL::Translator::Object::View;
  16
  17     use SQL::Translator::Types qw(Schema Table);
  18
  19     has 'quoter' => (
  20         is => 'rw',
  21         isa => Str,
  22         lazy => 1,
  23         default => sub { shift->dbh->get_info(29) || q{"} }
  24     );
  25
  26     has 'namesep' => (
  27         is => 'rw',
  28         isa => Str,
  29         lazy => 1,
  30         default => sub { shift->dbh->get_info(41) || '.' }
  31     );
  32
  33     has 'schema_name' => (
  34         is => 'rw',
  35         isa => Maybe[Str],
  36         lazy => 1,
  37         default => undef
  38     );
  39
  40     has 'catalog_name' => (
  41         is => 'rw',
  42         isa => Maybe[Str],
  43         lazy => 1,
  44         default => undef
  45     );
  46
  47     method _subclass {
  48         my $dbtype = $self->dbh->get_info($GetInfoType{SQL_DBMS_NAME}) || $self->dbh->{Driver}{Name};
  49
  50         my $class = __PACKAGE__ . '::'. $dbtype;
  51         Class::MOP::load_class($class);
  52         $class->meta->apply($self);
  53     }
  54
  55     method _is_auto_increment(HashRef $column_info) { 0 }
  56
  57     method _column_default_value(HashRef $column_info) { $column_info->{COLUMN_DEF} }
  58
  59     method _column_data_type(HashRef $column_info) { $column_info->{DATA_TYPE} }
  60
  61     method _add_tables(Schema $schema) {
  62         my $sth = $self->dbh->table_info($self->catalog_name, $self->schema_name, '%', "TABLE,VIEW,'LOCAL TEMPORARY','GLOBAL TEMPORARY'");
  63         while (my $table_info = $sth->fetchrow_hashref) {
  64             if ($table_info->{TABLE_TYPE} =~ /^(TABLE|LOCAL TEMPORARY|GLOBAL TEMPORARY)$/) {
  65                 my $temp = $table_info->{TABLE_TYPE} =~ /TEMPORARY$/ ? 1 : 0;
  66                 my $table = SQL::Translator::Object::Table->new({ name => $table_info->{TABLE_NAME}, temporary => $temp, schema => $schema });
  67                 $schema->add_table($table);
  68
  69                 $self->_add_columns($table);
  70                 $self->_add_primary_key($table);
  71                 $self->_add_indexes($table);
  72             }
  73             elsif ($table_info->{TABLE_TYPE} eq 'VIEW') {
  74                 my $sql = $self->_get_view_sql($table_info->{TABLE_NAME});
  75                 my $view = SQL::Translator::Object::View->new({ name => $table_info->{TABLE_NAME}, sql => $sql });
  76                 $schema->add_view($view);
  77                 $self->_add_columns($view);
  78             }
  79         }
  80         $self->_add_foreign_keys($schema->get_table($_), $schema) for $schema->table_ids;
  81     }
  82
  83     method _add_columns(Table $table) {
  84         my $sth = $self->dbh->column_info($self->catalog_name, $self->schema_name, $table->name, '%');
  85         while (my $column_info = $sth->fetchrow_hashref) {
  86             my $column = SQL::Translator::Object::Column->new({ name => $column_info->{COLUMN_NAME},
  87                                                                 data_type => $self->_column_data_type($column_info),
  88                                                                 size => $column_info->{COLUMN_SIZE},
  89                                                                 default_value => $self->_column_default_value($column_info),
  90                                                                 is_auto_increment => $self->_is_auto_increment($column_info),
  91                                                                 is_nullable => $column_info->{NULLABLE},
  92                                                               });
  93             $table->add_column($column);
  94         }
  95     }
  96
  97     method _add_primary_key(Table $table) {
  98         my $pk_info = $self->dbh->primary_key_info($self->catalog_name, $self->schema_name, $table->name);
  99
 100         my ($pk_name, @pk_cols);
 101         while (my $pk_col = $pk_info->fetchrow_hashref) {
 102             $pk_name = $pk_col->{PK_NAME};
 103             push @pk_cols, $pk_col->{COLUMN_NAME};
 104         }
 105         return unless $pk_name;
 106
 107         my $pk = SQL::Translator::Object::PrimaryKey->new({ name => $pk_name });
 108         $pk->add_column($table->get_column($_)) for @pk_cols;
 109         $table->add_index($pk);
 110     }
 111
 112     method _add_foreign_keys(Table $table, Schema $schema) {
 113         my $fk_info = $self->dbh->foreign_key_info($self->catalog_name, $self->schema_name, $table->name, $self->catalog_name, $self->schema_name, undef);
 114         return unless $fk_info;
 115
 116         my $fk_data;
 117         while (my $fk_col = $fk_info->fetchrow_hashref) {
 118             my $fk_name = $fk_col->{FK_NAME};
 119
 120             push @{$fk_data->{$fk_name}{columns}}, $fk_col->{FK_COLUMN_NAME};
 121             $fk_data->{$fk_name}{table} = $fk_col->{FK_TABLE_NAME};
 122             $fk_data->{$fk_name}{uk} = $schema->get_table($fk_col->{UK_TABLE_NAME})->get_index($fk_col->{UK_NAME});
 123         }
 124
 125         foreach my $fk_name (keys %$fk_data) {
 126             my $fk = SQL::Translator::Object::ForeignKey->new({ name => $fk_name, references => $fk_data->{$fk_name}{uk} });
 127             $fk->add_column($schema->get_table($fk_data->{$fk_name}{table})->get_column($_)) for @{$fk_data->{$fk_name}{columns}};
 128             $table->add_constraint($fk);
 129         }
 130     }
 131
 132     method _add_indexes(Table $table) {
 133         my $index_info = $self->dbh->statistics_info($self->catalog_name, $self->schema_name, $table->name, 1, 0);
 134
 135         return unless defined $index_info;
 136
 137         my ($index_name, $index_type, @index_cols);
 138         while (my $index_col = $index_info->fetchrow_hashref) {
 139             $index_name = $index_col->{INDEX_NAME};
 140             $index_type = $index_col->{NON_UNIQUE} ? 'NORMAL' : 'UNIQUE';
 141             push @index_cols, $index_col->{COLUMN_NAME};
 142         }
 143         return if $table->exists_index($index_name);
 144         my $index = SQL::Translator::Object::Index->new({ name => $index_name, type => $index_type });
 145         $index->add_column($table->get_column($_)) for @index_cols;
 146         $table->add_index($index);
 147     }
 148
 149     multi method parse(Schema $data) { $data }
 150
 151     multi method parse(Any $) {
 152         $self->_add_tables($self->schema);
 153     }
 154 }