lib/SQL/Translator/Parser/DBI.pm

   1 package SQL::Translator::Parser::DBI;
   2 use Moose::Role;
   3 use MooseX::Types::Moose qw(Maybe Str);
   4 use DBI::Const::GetInfoType;
   5 use DBI::Const::GetInfo::ANSI;
   6 use DBI::Const::GetInfoReturn;
   7 use SQL::Translator::Object::Column;
   8 use SQL::Translator::Object::Index;
   9 use SQL::Translator::Object::Table;
  10 use SQL::Translator::Object::View;
  11
  12 has 'quoter' => (
  13   is => 'rw',
  14   isa => Str,
  15   requried => 1,
  16   lazy => 1,
  17   default => sub { shift->dbh->get_info(29) || q{"} }
  18 );
  19
  20 has 'namesep' => (
  21   is => 'rw',
  22   isa => Str,
  23   required => 1,
  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   required => 1,
  32   lazy => 1,
  33   default => sub { undef }
  34 );
  35
  36 has 'catalog_name' => (
  37   is => 'rw',
  38   isa => Maybe[Str],
  39   required => 1,
  40   lazy => 1,
  41   default => sub { undef }
  42 );
  43
  44 no Moose;
  45
  46 sub _subclass {
  47     my $self = shift;
  48
  49     my $dbtype = $self->dbh->get_info($GetInfoType{SQL_DBMS_NAME}) || $self->dbh->{Driver}{Name};
  50
  51     my $class = __PACKAGE__ . '::'. $dbtype;
  52     Class::MOP::load_class($class);
  53     $class->meta->apply($self);
  54 }
  55
  56 sub _add_tables {
  57     my $self = shift;
  58     my $schema = shift;
  59
  60     my $sth = $self->dbh->table_info($self->catalog_name, $self->schema_name, '%', 'TABLE,VIEW');
  61     while (my $table_info = $sth->fetchrow_hashref) {
  62         if ($table_info->{TABLE_TYPE} eq 'TABLE') {
  63             my $table = SQL::Translator::Object::Table->new({ name => $table_info->{TABLE_NAME} });
  64             $schema->add_table($table);
  65             $self->_add_columns($table);
  66             $self->_add_primary_key($table);
  67         }
  68         elsif ($table_info->{TABLE_TYPE} eq 'VIEW') {
  69             my $sql = $self->_get_view_sql($table_info->{TABLE_NAME});
  70             $schema->add_view(SQL::Translator::Object::View->new({ name => $table_info->{TABLE_NAME}, sql => $sql }));
  71         }
  72     }
  73 }
  74
  75 sub _add_columns {
  76     my $self  = shift;
  77     my $table = shift;
  78
  79     my $sth = $self->dbh->column_info($self->catalog_name, $self->schema_name, $table->name, '%');
  80     while (my $col_info = $sth->fetchrow_hashref) {
  81         my $column = SQL::Translator::Object::Column->new({ name => $col_info->{COLUMN_NAME},
  82                                                             data_type => $col_info->{TYPE_NAME},
  83                                                             size => $col_info->{COLUMN_SIZE},
  84                                                             default_value => $col_info->{COLUMN_DEF},
  85                                                             is_nullable => $col_info->{NULLABLE}, });
  86         $table->add_column($column);
  87
  88     }
  89 }
  90
  91 sub _add_primary_key {
  92     my $self = shift;
  93     my $table = shift;
  94
  95     my $pk_info = $self->dbh->primary_key_info($self->catalog_name, $self->schema_name, $table->name);
  96 #    use Data::Dumper;
  97     my ($pk_name, @pk_cols);
  98     while (my $pk_col = $pk_info->fetchrow_hashref) {
  99         $pk_name = $pk_col->{PK_NAME};
 100         push @pk_cols, $pk_col->{COLUMN_NAME};
 101 #        print Dumper($pk_col);
 102 =cut
 103 $VAR1 = {
 104           'PK_NAME' => 'tester_pkey',
 105           'pg_column' => 'tester_pkey',
 106           'pg_table' => 'tester',
 107           'COLUMN_NAME' => 'id',
 108           'pg_tablespace_name' => undef,
 109           'pg_tablespace_location' => undef,
 110           'TABLE_CAT' => undef,
 111           'TABLE_NAME' => 'tester',
 112           'DATA_TYPE' => 'int4',
 113           'pg_schema' => 'public',
 114           'TABLE_SCHEM' => 'public',
 115           'KEY_SEQ' => '1'
 116         };
 117 =cut
 118     }
 119     my $index = SQL::Translator::Object::Index->new({ name => $pk_name, type => 'PRIMARY_KEY' });
 120     $index->add_column($table->get_column($_)) for @pk_cols;
 121     $table->add_index($index);
 122 }
 123
 124 1;