Commit | Line | Data |
b8657f04 |
1 | package SQL::Translator::Parser::DBI::Dialect; |
2 | use Moose::Role; |
c4ec1b63 |
3 | use MooseX::Types::Moose qw(Str); |
4 | use SQL::Translator::Types qw(DBIHandle); |
5 | use SQL::Translator::Object::Column; |
6 | use SQL::Translator::Object::Table; |
7 | use SQL::Translator::Object::Schema; |
b8657f04 |
8 | |
c4ec1b63 |
9 | has 'dbh' => ( |
10 | is => 'rw', |
11 | isa => DBIHandle, |
12 | required => 1 |
13 | ); |
b8657f04 |
14 | |
c4ec1b63 |
15 | has 'quoter' => ( |
16 | is => 'rw', |
17 | isa => Str, |
18 | requried => 1, |
b74bec21 |
19 | lazy => 1, |
20 | default => sub { shift->dbh->get_info(29) || q{"} } |
c4ec1b63 |
21 | ); |
22 | |
23 | has 'namesep' => ( |
24 | is => 'rw', |
25 | isa => Str, |
26 | required => 1, |
b74bec21 |
27 | lazy => 1, |
28 | default => sub { shift->dbh->get_info(41) || '.' } |
c4ec1b63 |
29 | ); |
30 | |
31 | sub BUILD { |
b8657f04 |
32 | } |
33 | |
c4ec1b63 |
34 | sub _tables_list { |
35 | my $self = shift; |
36 | |
37 | my $dbh = $self->dbh; |
38 | my $quoter = $self->quoter; |
39 | my $namesep = $self->namesep; |
40 | |
41 | my @tables = $dbh->tables(undef, $self->schema->name, '%', '%'); |
42 | |
43 | s/\Q$quoter\E//g for @tables; |
44 | s/^.*\Q$namesep\E// for @tables; |
45 | |
46 | my %retval; |
47 | map { $retval{$_} = SQL::Translator::Object::Table->new({ name => $_, schema => $self->schema }) } @tables; |
48 | |
49 | return \%retval; |
50 | } |
51 | |
52 | sub _table_columns { |
53 | my ($self, $table) = @_; |
54 | |
55 | my $dbh = $self->dbh; |
56 | |
57 | if($self->schema->name) { |
58 | $table = $self->schema->name . $self->namesep . $table; |
59 | } |
60 | |
61 | my $sth = $dbh->prepare("SELECT * FROM $table WHERE 1 = 0"); |
62 | $sth->execute; |
b74bec21 |
63 | |
c4ec1b63 |
64 | my $retval = \@{$sth->{NAME_lc}}; |
65 | $sth->finish; |
66 | |
67 | $retval; |
68 | } |
69 | |
70 | sub _table_pk_info { |
71 | my ($self, $table) = @_; |
72 | |
73 | my $dbh = $self->dbh; |
b74bec21 |
74 | my $quoter = $self->quoter; |
c4ec1b63 |
75 | |
76 | my @primary = map { lc } $dbh->primary_key('', $self->schema->name, $table); |
b74bec21 |
77 | s/\Q$quoter\E//g for @primary; |
78 | |
79 | my $sth = $dbh->primary_key_info('', $self->schema->name, $table); |
b74bec21 |
80 | while ( my $info = $sth->fetchrow_hashref() ) { |
81 | # my $column = SQL::Translator::Object::Column->new( { name => $info->{COLUMN_NAME}, size => undef, data_type => $info->{ |
b74bec21 |
82 | } |
c4ec1b63 |
83 | |
84 | return \@primary; |
85 | } |
86 | |
b74bec21 |
87 | sub _table_fk_info { |
88 | my ($self, $table) = @_; |
89 | |
90 | my $dbh = $self->dbh; |
91 | my $quoter = $self->quoter; |
92 | my $sth = $dbh->foreign_key_info( '', $self->schema, '', |
93 | '', $self->schema, $table ); |
94 | return [] if !$sth; |
95 | |
96 | my %rels; |
97 | |
98 | my $i = 1; # for unnamed rels, which hopefully have only 1 column ... |
99 | while(my $raw_rel = $sth->fetchrow_arrayref) { |
100 | my $uk_tbl = $raw_rel->[2]; |
101 | my $uk_col = lc $raw_rel->[3]; |
102 | my $fk_col = lc $raw_rel->[7]; |
103 | my $relid = ($raw_rel->[11] || ( "__dcsld__" . $i++ )); |
104 | $uk_tbl =~ s/\Q$quoter\E//g; |
105 | $uk_col =~ s/\Q$quoter\E//g; |
106 | $fk_col =~ s/\Q$quoter\E//g; |
107 | $relid =~ s/\Q$quoter\E//g; |
108 | $rels{$relid}->{tbl} = $uk_tbl; |
109 | $rels{$relid}->{cols}->{$uk_col} = $fk_col; |
110 | } |
111 | $sth->finish; |
112 | |
113 | my @rels; |
114 | foreach my $relid (keys %rels) { |
115 | push(@rels, { |
116 | remote_columns => [ keys %{$rels{$relid}->{cols}} ], |
117 | local_columns => [ values %{$rels{$relid}->{cols}} ], |
118 | remote_table => $rels{$relid}->{tbl}, |
119 | }); |
120 | } |
121 | |
122 | return \@rels; |
123 | } |
124 | |
c4ec1b63 |
125 | sub _table_uniq_info { |
126 | my ($self, $table) = @_; |
127 | |
128 | my $dbh = $self->dbh; |
129 | if(!$dbh->can('statistics_info')) { |
130 | warn "No UNIQUE constraint information can be gathered for this vendor"; |
131 | return []; |
132 | } |
133 | |
134 | my %indices; |
135 | my $sth = $dbh->statistics_info(undef, $self->schema->name, $table, 1, 1); |
136 | while(my $row = $sth->fetchrow_hashref) { |
137 | # skip table-level stats, conditional indexes, and any index missing |
138 | # critical fields |
139 | next if $row->{TYPE} eq 'table' |
140 | || defined $row->{FILTER_CONDITION} |
141 | || !$row->{INDEX_NAME} |
142 | || !defined $row->{ORDINAL_POSITION} |
143 | || !$row->{COLUMN_NAME}; |
144 | |
145 | $indices{$row->{INDEX_NAME}}->{$row->{ORDINAL_POSITION}} = $row->{COLUMN_NAME}; |
146 | } |
147 | $sth->finish; |
148 | |
149 | my @retval; |
150 | foreach my $index_name (keys %indices) { |
151 | my $index = $indices{$index_name}; |
152 | push(@retval, [ $index_name => [ |
153 | map { $index->{$_} } |
154 | sort keys %$index |
155 | ]]); |
156 | } |
157 | |
158 | return \@retval; |
159 | } |
160 | |
161 | sub _columns_info_for { |
162 | my ($self, $table) = @_; |
163 | |
164 | my $dbh = $self->dbh; |
165 | |
166 | if ($dbh->can('column_info')) { |
167 | my %result; |
168 | eval { |
169 | my $sth = $dbh->column_info( undef, $self->schema->name, $table, '%' ); |
170 | while ( my $info = $sth->fetchrow_hashref() ) { |
171 | my (%column_info, $col_name); |
172 | $column_info{data_type} = $info->{TYPE_NAME}; |
173 | $column_info{size} = $info->{COLUMN_SIZE}; |
174 | $column_info{is_nullable} = $info->{NULLABLE} ? 1 : 0; |
175 | $column_info{default_value} = $info->{COLUMN_DEF}; |
176 | $column_info{index} = $info->{ORDINAL_POSITION}; |
177 | $column_info{remarks} = $info->{REMARKS}; |
178 | $col_name = $info->{COLUMN_NAME}; |
179 | $col_name =~ s/^\"(.*)\"$/$1/; |
180 | $column_info{name} = $col_name; |
181 | |
182 | my $extra_info = $self->_extra_column_info($info) || {}; |
183 | my $column = SQL::Translator::Object::Column->new(%column_info); |
184 | |
185 | # $result{$col_name} = { %column_info, %$extra_info }; |
186 | $result{$col_name} = $column; |
187 | } |
188 | $sth->finish; |
189 | }; |
190 | return \%result if !$@ && scalar keys %result; |
191 | print "OH NOES, $@\n"; |
192 | } |
193 | |
194 | if($self->schema->name) { |
195 | $table = $self->schema->name . $self->namesep . $table; |
196 | } |
197 | my %result; |
198 | my $sth = $dbh->prepare("SELECT * FROM $table WHERE 1 = 0"); |
199 | $sth->execute; |
200 | my @columns = @{$sth->{NAME_lc}}; |
201 | for my $i ( 0 .. $#columns ) { |
202 | my %column_info; |
203 | $column_info{data_type} = $sth->{TYPE}->[$i]; |
204 | $column_info{size} = $sth->{PRECISION}->[$i]; |
205 | $column_info{is_nullable} = $sth->{NULLABLE}->[$i] ? 1 : 0; |
206 | $column_info{index} = $i; |
207 | |
208 | if ($column_info{data_type} =~ m/^(.*?)\((.*?)\)$/) { |
209 | $column_info{data_type} = $1; |
210 | $column_info{size} = $2; |
211 | } |
212 | |
213 | my $extra_info = $self->_extra_column_info($table, $columns[$i], $sth, $i) || {}; |
214 | |
215 | # $result{$columns[$i]} = { %column_info, %$extra_info }; |
216 | $column_info{name} = $columns[$i]; |
217 | my $column = SQL::Translator::Object::Column->new(%column_info); |
218 | $result{$columns[$i]} = $column; |
219 | |
220 | } |
221 | $sth->finish; |
222 | |
223 | foreach my $col (keys %result) { |
224 | my $colinfo = $result{$col}; |
225 | my $type_num = $colinfo->{data_type}; |
226 | my $type_name; |
227 | if (defined $type_num && $dbh->can('type_info')) { |
228 | my $type_info = $dbh->type_info($type_num); |
229 | $type_name = $type_info->{TYPE_NAME} if $type_info; |
230 | $colinfo->{data_type} = $type_name if $type_name; |
231 | } |
232 | } |
233 | |
234 | return \%result; |
235 | } |
236 | |
237 | sub _extra_column_info { } |
238 | |
b8657f04 |
239 | 1; |