Commit | Line | Data |
4f4fd192 |
1 | use MooseX::Declare; |
2 | role SQL::Translator::Parser::DBI { |
3 | use DBI::Const::GetInfoType; |
4 | use DBI::Const::GetInfo::ANSI; |
5 | use DBI::Const::GetInfoReturn; |
6 | |
7 | use MooseX::Types::Moose qw(HashRef Maybe Str); |
984c6a77 |
8 | use MooseX::MultiMethods; |
4f4fd192 |
9 | |
10 | use SQL::Translator::Object::Column; |
11 | use SQL::Translator::Object::ForeignKey; |
12 | use SQL::Translator::Object::Index; |
13 | use SQL::Translator::Object::PrimaryKey; |
14 | use SQL::Translator::Object::Table; |
15 | use SQL::Translator::Object::View; |
16 | |
9406163a |
17 | use SQL::Translator::Types qw(Schema Table Column); |
4f4fd192 |
18 | |
19 | has 'quoter' => ( |
20 | is => 'rw', |
21 | isa => Str, |
22 | lazy => 1, |
23 | default => sub { shift->dbh->get_info(29) || q{"} } |
24 | ); |
25 | |
26 | has 'namesep' => ( |
27 | is => 'rw', |
28 | isa => Str, |
29 | lazy => 1, |
30 | default => sub { shift->dbh->get_info(41) || '.' } |
31 | ); |
32 | |
33 | has 'schema_name' => ( |
34 | is => 'rw', |
35 | isa => Maybe[Str], |
36 | lazy => 1, |
37 | default => undef |
38 | ); |
39 | |
40 | has 'catalog_name' => ( |
41 | is => 'rw', |
42 | isa => Maybe[Str], |
43 | lazy => 1, |
44 | default => undef |
45 | ); |
46 | |
f76715bd |
47 | method _subclass { |
4f4fd192 |
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 | } |
641ce7d8 |
54 | |
13ad9861 |
55 | method _is_auto_increment(HashRef $column_info) { 0 } |
4f4fd192 |
56 | |
9ad20a72 |
57 | method _column_default_value(HashRef $column_info) { $column_info->{COLUMN_DEF} } |
4f4fd192 |
58 | |
9ad20a72 |
59 | method _column_data_type(HashRef $column_info) { $column_info->{DATA_TYPE} } |
f76715bd |
60 | |
9406163a |
61 | method _add_column_extra(Column $column, HashRef $column_info) { return } |
62 | |
4f4fd192 |
63 | method _add_tables(Schema $schema) { |
64 | my $sth = $self->dbh->table_info($self->catalog_name, $self->schema_name, '%', "TABLE,VIEW,'LOCAL TEMPORARY','GLOBAL TEMPORARY'"); |
65 | while (my $table_info = $sth->fetchrow_hashref) { |
66 | if ($table_info->{TABLE_TYPE} =~ /^(TABLE|LOCAL TEMPORARY|GLOBAL TEMPORARY)$/) { |
67 | my $temp = $table_info->{TABLE_TYPE} =~ /TEMPORARY$/ ? 1 : 0; |
d1f9323a |
68 | my $table = SQL::Translator::Object::Table->new({ name => $table_info->{TABLE_NAME}, temporary => $temp, schema => $schema }); |
4f4fd192 |
69 | $schema->add_table($table); |
70 | |
71 | $self->_add_columns($table); |
72 | $self->_add_primary_key($table); |
73 | $self->_add_indexes($table); |
74 | } |
75 | elsif ($table_info->{TABLE_TYPE} eq 'VIEW') { |
76 | my $sql = $self->_get_view_sql($table_info->{TABLE_NAME}); |
77 | my $view = SQL::Translator::Object::View->new({ name => $table_info->{TABLE_NAME}, sql => $sql }); |
78 | $schema->add_view($view); |
79 | $self->_add_columns($view); |
80 | } |
684763c1 |
81 | } |
4f4fd192 |
82 | $self->_add_foreign_keys($schema->get_table($_), $schema) for $schema->table_ids; |
684763c1 |
83 | } |
b8657f04 |
84 | |
4f4fd192 |
85 | method _add_columns(Table $table) { |
86 | my $sth = $self->dbh->column_info($self->catalog_name, $self->schema_name, $table->name, '%'); |
aef7f568 |
87 | my @columns; |
4f4fd192 |
88 | while (my $column_info = $sth->fetchrow_hashref) { |
89 | my $column = SQL::Translator::Object::Column->new({ name => $column_info->{COLUMN_NAME}, |
f76715bd |
90 | data_type => $self->_column_data_type($column_info), |
4f4fd192 |
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 | }); |
9406163a |
96 | $self->_add_column_extra($column, $column_info); |
aef7f568 |
97 | push @columns, { column => $column, pos => $column_info->{ORDINAL_POSITION} || $#columns }; |
4f4fd192 |
98 | } |
aef7f568 |
99 | $table->add_column($_->{column}) for sort { $a->{pos} <=> $b->{pos} } @columns; |
684763c1 |
100 | } |
684763c1 |
101 | |
4f4fd192 |
102 | method _add_primary_key(Table $table) { |
103 | my $pk_info = $self->dbh->primary_key_info($self->catalog_name, $self->schema_name, $table->name); |
b8657f04 |
104 | |
4f4fd192 |
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 | return unless $pk_name; |
47b211fd |
111 | |
4f4fd192 |
112 | my $pk = SQL::Translator::Object::PrimaryKey->new({ name => $pk_name }); |
113 | $pk->add_column($table->get_column($_)) for @pk_cols; |
114 | $table->add_index($pk); |
115 | } |
47b211fd |
116 | |
4f4fd192 |
117 | method _add_foreign_keys(Table $table, Schema $schema) { |
118 | my $fk_info = $self->dbh->foreign_key_info($self->catalog_name, $self->schema_name, $table->name, $self->catalog_name, $self->schema_name, undef); |
119 | return unless $fk_info; |
47b211fd |
120 | |
4f4fd192 |
121 | my $fk_data; |
122 | while (my $fk_col = $fk_info->fetchrow_hashref) { |
123 | my $fk_name = $fk_col->{FK_NAME}; |
47b211fd |
124 | |
4f4fd192 |
125 | push @{$fk_data->{$fk_name}{columns}}, $fk_col->{FK_COLUMN_NAME}; |
126 | $fk_data->{$fk_name}{table} = $fk_col->{FK_TABLE_NAME}; |
127 | $fk_data->{$fk_name}{uk} = $schema->get_table($fk_col->{UK_TABLE_NAME})->get_index($fk_col->{UK_NAME}); |
128 | } |
47b211fd |
129 | |
4f4fd192 |
130 | foreach my $fk_name (keys %$fk_data) { |
131 | my $fk = SQL::Translator::Object::ForeignKey->new({ name => $fk_name, references => $fk_data->{$fk_name}{uk} }); |
132 | $fk->add_column($schema->get_table($fk_data->{$fk_name}{table})->get_column($_)) for @{$fk_data->{$fk_name}{columns}}; |
133 | $table->add_constraint($fk); |
134 | } |
47b211fd |
135 | } |
92403c5e |
136 | |
4f4fd192 |
137 | method _add_indexes(Table $table) { |
138 | my $index_info = $self->dbh->statistics_info($self->catalog_name, $self->schema_name, $table->name, 1, 0); |
92403c5e |
139 | |
f76715bd |
140 | return unless defined $index_info; |
141 | |
4f4fd192 |
142 | my ($index_name, $index_type, @index_cols); |
143 | while (my $index_col = $index_info->fetchrow_hashref) { |
144 | $index_name = $index_col->{INDEX_NAME}; |
145 | $index_type = $index_col->{NON_UNIQUE} ? 'NORMAL' : 'UNIQUE'; |
146 | push @index_cols, $index_col->{COLUMN_NAME}; |
147 | } |
148 | return if $table->exists_index($index_name); |
149 | my $index = SQL::Translator::Object::Index->new({ name => $index_name, type => $index_type }); |
150 | $index->add_column($table->get_column($_)) for @index_cols; |
151 | $table->add_index($index); |
92403c5e |
152 | } |
984c6a77 |
153 | |
154 | multi method parse(Schema $data) { $data } |
155 | |
156 | multi method parse(Any $) { |
157 | $self->_add_tables($self->schema); |
158 | } |
92403c5e |
159 | } |