04ba5bba72f3fd661653b419253f057f7ac781aa
[dbsrgits/SQL-Translator-2.0-ish.git] / 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     required => 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     lazy => 1,
33     default => undef
34 );
35
36 has 'catalog_name' => (
37     is => 'rw',
38     isa => Maybe[Str],
39     lazy => 1,
40     default => undef
41 );
42
43 sub _subclass {
44     my $self = shift;
45
46     my $dbtype = $self->dbh->get_info($GetInfoType{SQL_DBMS_NAME}) || $self->dbh->{Driver}{Name};
47
48     my $class = __PACKAGE__ . '::'. $dbtype;
49     Class::MOP::load_class($class);
50     $class->meta->apply($self);
51 }
52
53 sub _is_auto_increment { 0 }
54
55 sub _column_default_value {
56     my $self = shift;
57     my $column_info = shift;
58
59     return $column_info->{COLUMN_DEF};
60 }
61
62 sub _add_tables {
63     my $self = shift;
64     my $schema = shift;
65
66     my $sth = $self->dbh->table_info($self->catalog_name, $self->schema_name, '%', 'TABLE,VIEW');
67     while (my $table_info = $sth->fetchrow_hashref) {
68         if ($table_info->{TABLE_TYPE} eq 'TABLE') {
69             my $table = Table->new({ name => $table_info->{TABLE_NAME} });
70             $schema->add_table($table);
71             $self->_add_columns($table);
72             $self->_add_primary_key($table);
73         }
74         elsif ($table_info->{TABLE_TYPE} eq 'VIEW') {
75             my $sql = $self->_get_view_sql($table_info->{TABLE_NAME});
76             my $view = View->new({ name => $table_info->{TABLE_NAME}, sql => $sql });
77             $schema->add_view($view);
78             $self->_add_columns($view);
79         }
80     }
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 $index = Index->new({ name => $pk_name, type => 'PRIMARY_KEY' });
111     $index->add_column($table->get_column($_)) for @pk_cols;
112     $table->add_index($index);
113 }
114
115 1;