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