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 SQL::Translator::Object::Column;
   9 use SQL::Translator::Object::Index;
  10 use SQL::Translator::Object::Table;
  11 use SQL::Translator::Object::View;
  12
  13 has 'quoter' => (
  14   is => 'rw',
  15   isa => Str,
  16   requried => 1,
  17   lazy => 1,
  18   default => sub { shift->dbh->get_info(29) || q{"} }
  19 );
  20
  21 has 'namesep' => (
  22   is => 'rw',
  23   isa => Str,
  24   required => 1,
  25   lazy => 1,
  26   default => sub { shift->dbh->get_info(41) || '.' }
  27 );
  28
  29 has 'schema_name' => (
  30   is => 'rw',
  31   isa => Maybe[Str],
  32   required => 0,
  33   lazy => 1,
  34   default => undef
  35 );
  36
  37 has 'catalog_name' => (
  38   is => 'rw',
  39   isa => Maybe[Str],
  40   required => 0,
  41   lazy => 1,
  42   default => undef
  43 );
  44
  45 sub _subclass {
  46     my $self = shift;
  47
  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 sub _add_tables {
  56     my $self = shift;
  57     my $schema = shift;
  58
  59     my $sth = $self->dbh->table_info($self->catalog_name, $self->schema_name, '%', 'TABLE,VIEW');
  60     while (my $table_info = $sth->fetchrow_hashref) {
  61         if ($table_info->{TABLE_TYPE} eq 'TABLE') {
  62             my $table = SQL::Translator::Object::Table->new({ name => $table_info->{TABLE_NAME} });
  63             $schema->add_table($table);
  64             $self->_add_columns($table);
  65             $self->_add_primary_key($table);
  66         }
  67         elsif ($table_info->{TABLE_TYPE} eq 'VIEW') {
  68             my $sql = $self->_get_view_sql($table_info->{TABLE_NAME});
  69             $schema->add_view(SQL::Translator::Object::View->new({ name => $table_info->{TABLE_NAME}, sql => $sql }));
  70         }
  71     }
  72 }
  73
  74 sub _add_columns {
  75     my $self  = shift;
  76     my $table = shift;
  77
  78     my $sth = $self->dbh->column_info($self->catalog_name, $self->schema_name, $table->name, '%');
  79     while (my $col_info = $sth->fetchrow_hashref) {
  80         my $column = SQL::Translator::Object::Column->new({ name => $col_info->{COLUMN_NAME},
  81                                                             data_type => $col_info->{TYPE_NAME},
  82                                                             size => $col_info->{COLUMN_SIZE},
  83                                                             default_value => $col_info->{COLUMN_DEF},
  84                                                             is_nullable => $col_info->{NULLABLE}, });
  85         $table->add_column($column);
  86     }
  87 }
  88
  89 sub _add_primary_key {
  90     my $self = shift;
  91     my $table = shift;
  92
  93     my $pk_info = $self->dbh->primary_key_info($self->catalog_name, $self->schema_name, $table->name);
  94     my ($pk_name, @pk_cols);
  95     while (my $pk_col = $pk_info->fetchrow_hashref) {
  96         $pk_name = $pk_col->{PK_NAME};
  97         push @pk_cols, $pk_col->{COLUMN_NAME};
  98     }
  99     my $index = SQL::Translator::Object::Index->new({ name => $pk_name, type => 'PRIMARY_KEY' });
 100     $index->add_column($table->get_column($_)) for @pk_cols;
 101     $table->add_index($index);
 102 }
 103
 104 1;