lib/SQL/Translator/Parser/DBI.pm

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