Commit | Line | Data |
996be9ee |
1 | package DBIx::Class::Schema::Loader::DBI::mysql; |
2 | |
3 | use strict; |
4 | use warnings; |
5 | use base 'DBIx::Class::Schema::Loader::DBI'; |
942bd5e0 |
6 | use mro 'c3'; |
c0767caf |
7 | use List::Util 'first'; |
ea998e8e |
8 | use Try::Tiny; |
c0767caf |
9 | use namespace::clean; |
996be9ee |
10 | |
4295c4b4 |
11 | our $VERSION = '0.07010'; |
32f784fc |
12 | |
996be9ee |
13 | =head1 NAME |
14 | |
15 | DBIx::Class::Schema::Loader::DBI::mysql - DBIx::Class::Schema::Loader::DBI mysql Implementation. |
16 | |
996be9ee |
17 | =head1 DESCRIPTION |
18 | |
c0767caf |
19 | See L<DBIx::Class::Schema::Loader> and L<DBIx::Class::Schema::Loader::Base>. |
996be9ee |
20 | |
21 | =cut |
22 | |
bc1cb85e |
23 | sub _setup { |
24 | my $self = shift; |
25 | |
6ebd0f33 |
26 | $self->schema->storage->sql_maker->quote_char("`"); |
27 | $self->schema->storage->sql_maker->name_sep("."); |
28 | |
bc1cb85e |
29 | $self->next::method(@_); |
30 | |
31 | if (not defined $self->preserve_case) { |
32 | $self->preserve_case(0); |
33 | } |
34 | } |
35 | |
518472fa |
36 | sub _tables_list { |
bfb43060 |
37 | my ($self, $opts) = @_; |
518472fa |
38 | |
bfb43060 |
39 | return $self->next::method($opts, undef, undef); |
518472fa |
40 | } |
41 | |
996be9ee |
42 | sub _table_fk_info { |
43 | my ($self, $table) = @_; |
44 | |
5223f24a |
45 | my $dbh = $self->schema->storage->dbh; |
3de915bc |
46 | |
3de915bc |
47 | my $table_def_ref = eval { $dbh->selectrow_arrayref("SHOW CREATE TABLE `$table`") }; |
48 | my $table_def = $table_def_ref->[1]; |
49 | |
50 | return [] if not $table_def; |
309e2aa1 |
51 | |
52 | my $qt = qr/["`]/; |
53 | |
54 | my (@reldata) = ($table_def =~ |
55 | /CONSTRAINT $qt.*$qt FOREIGN KEY \($qt(.*)$qt\) REFERENCES $qt(.*)$qt \($qt(.*)$qt\)/ig |
56 | ); |
996be9ee |
57 | |
58 | my @rels; |
59 | while (scalar @reldata > 0) { |
60 | my $cols = shift @reldata; |
61 | my $f_table = shift @reldata; |
62 | my $f_cols = shift @reldata; |
63 | |
bc1cb85e |
64 | my @cols = map { s/(?: \Q$self->{_quoter}\E | $qt )//x; $self->_lc($_) } |
be72dba7 |
65 | split(/$qt?\s*$qt?,$qt?\s*$qt?/, $cols); |
5223f24a |
66 | |
bc1cb85e |
67 | my @f_cols = map { s/(?: \Q$self->{_quoter}\E | $qt )//x; $self->_lc($_) } |
be72dba7 |
68 | split(/$qt?\s*$qt?,$qt?\s*$qt?/, $f_cols); |
996be9ee |
69 | |
c0767caf |
70 | my $remote_table = first { $_ =~ /^${f_table}\z/i } $self->_tables_list; |
71 | |
996be9ee |
72 | push(@rels, { |
73 | local_columns => \@cols, |
74 | remote_columns => \@f_cols, |
c0767caf |
75 | remote_table => $remote_table, |
996be9ee |
76 | }); |
77 | } |
78 | |
79 | return \@rels; |
80 | } |
81 | |
82 | # primary and unique info comes from the same sql statement, |
83 | # so cache it here for both routines to use |
84 | sub _mysql_table_get_keys { |
85 | my ($self, $table) = @_; |
86 | |
5223f24a |
87 | if(!exists($self->{_cache}->{_mysql_keys}->{$table})) { |
996be9ee |
88 | my %keydata; |
89 | my $dbh = $self->schema->storage->dbh; |
075aff97 |
90 | my $sth = $dbh->prepare('SHOW INDEX FROM '.$self->_table_as_sql($table)); |
996be9ee |
91 | $sth->execute; |
92 | while(my $row = $sth->fetchrow_hashref) { |
93 | next if $row->{Non_unique}; |
94 | push(@{$keydata{$row->{Key_name}}}, |
bc1cb85e |
95 | [ $row->{Seq_in_index}, $self->_lc($row->{Column_name}) ] |
996be9ee |
96 | ); |
97 | } |
98 | foreach my $keyname (keys %keydata) { |
99 | my @ordered_cols = map { $_->[1] } sort { $a->[0] <=> $b->[0] } |
100 | @{$keydata{$keyname}}; |
101 | $keydata{$keyname} = \@ordered_cols; |
102 | } |
5223f24a |
103 | $self->{_cache}->{_mysql_keys}->{$table} = \%keydata; |
996be9ee |
104 | } |
105 | |
5223f24a |
106 | return $self->{_cache}->{_mysql_keys}->{$table}; |
996be9ee |
107 | } |
108 | |
109 | sub _table_pk_info { |
110 | my ( $self, $table ) = @_; |
111 | |
112 | return $self->_mysql_table_get_keys($table)->{PRIMARY}; |
113 | } |
114 | |
115 | sub _table_uniq_info { |
116 | my ( $self, $table ) = @_; |
117 | |
118 | my @uniqs; |
119 | my $keydata = $self->_mysql_table_get_keys($table); |
8ac8926d |
120 | foreach my $keyname (keys %$keydata) { |
996be9ee |
121 | next if $keyname eq 'PRIMARY'; |
122 | push(@uniqs, [ $keyname => $keydata->{$keyname} ]); |
123 | } |
124 | |
125 | return \@uniqs; |
126 | } |
127 | |
26334ec1 |
128 | sub _columns_info_for { |
129 | my $self = shift; |
130 | my ($table) = @_; |
131 | |
132 | my $result = $self->next::method(@_); |
133 | |
134 | my $dbh = $self->schema->storage->dbh; |
135 | |
136 | while (my ($col, $info) = each %$result) { |
26334ec1 |
137 | if ($info->{data_type} eq 'int') { |
138 | $info->{data_type} = 'integer'; |
139 | } |
140 | elsif ($info->{data_type} eq 'double') { |
141 | $info->{data_type} = 'double precision'; |
142 | } |
698c11d8 |
143 | my $data_type = $info->{data_type}; |
144 | |
145 | delete $info->{size} if $data_type !~ /^(?: (?:var)?(?:char(?:acter)?|binary) | bit | year)\z/ix; |
26334ec1 |
146 | |
f80b0ea7 |
147 | # information_schema is available in 5.0+ |
33aa3462 |
148 | my ($precision, $scale, $column_type, $default) = eval { $dbh->selectrow_array(<<'EOF', {}, $table, $col) }; |
149 | SELECT numeric_precision, numeric_scale, column_type, column_default |
26334ec1 |
150 | FROM information_schema.columns |
33aa3462 |
151 | WHERE table_name = ? AND column_name = ? |
26334ec1 |
152 | EOF |
698c11d8 |
153 | my $has_information_schema = not $@; |
33aa3462 |
154 | |
26334ec1 |
155 | $column_type = '' if not defined $column_type; |
156 | |
698c11d8 |
157 | if ($data_type eq 'bit' && (not exists $info->{size})) { |
26334ec1 |
158 | $info->{size} = $precision if defined $precision; |
159 | } |
698c11d8 |
160 | elsif ($data_type =~ /^(?:float|double precision|decimal)\z/i) { |
26334ec1 |
161 | if (defined $precision && defined $scale) { |
162 | if ($precision == 10 && $scale == 0) { |
163 | delete $info->{size}; |
164 | } |
165 | else { |
166 | $info->{size} = [$precision,$scale]; |
167 | } |
168 | } |
169 | } |
698c11d8 |
170 | elsif ($data_type eq 'year') { |
26334ec1 |
171 | if ($column_type =~ /\(2\)/) { |
172 | $info->{size} = 2; |
173 | } |
174 | elsif ($column_type =~ /\(4\)/ || $info->{size} == 4) { |
175 | delete $info->{size}; |
176 | } |
177 | } |
698c11d8 |
178 | elsif ($data_type =~ /^(?:date(?:time)?|timestamp)\z/) { |
57a9fc92 |
179 | if (not (defined $self->datetime_undef_if_invalid && $self->datetime_undef_if_invalid == 0)) { |
180 | $info->{datetime_undef_if_invalid} = 1; |
181 | } |
58333f16 |
182 | } |
698c11d8 |
183 | elsif ($data_type =~ /^(?:enum|set)\z/ && $has_information_schema |
184 | && $column_type =~ /^(?:enum|set)\(/) { |
185 | |
186 | delete $info->{extra}{list}; |
187 | |
e00d61ac |
188 | while ($column_type =~ /'((?:[^']* (?:''|\\')* [^']*)* [^\\'])',?/xg) { |
189 | my $el = $1; |
190 | $el =~ s/''/'/g; |
191 | push @{ $info->{extra}{list} }, $el; |
698c11d8 |
192 | } |
193 | } |
33aa3462 |
194 | |
195 | # Sometimes apparently there's a bug where default_value gets set to '' |
196 | # for things that don't actually have or support that default (like ints.) |
197 | if (exists $info->{default_value} && $info->{default_value} eq '') { |
198 | if ($has_information_schema) { |
199 | if (not defined $default) { |
200 | delete $info->{default_value}; |
201 | } |
202 | } |
203 | else { # just check if it's a char/text type, otherwise remove |
698c11d8 |
204 | delete $info->{default_value} unless $data_type =~ /char|text/i; |
33aa3462 |
205 | } |
206 | } |
26334ec1 |
207 | } |
208 | |
209 | return $result; |
210 | } |
211 | |
a8df0345 |
212 | sub _extra_column_info { |
f430297e |
213 | no warnings 'uninitialized'; |
45be2ce7 |
214 | my ($self, $table, $col, $info, $dbi_info) = @_; |
a8df0345 |
215 | my %extra_info; |
78b7ccaa |
216 | |
45be2ce7 |
217 | if ($dbi_info->{mysql_is_auto_increment}) { |
a8df0345 |
218 | $extra_info{is_auto_increment} = 1 |
219 | } |
45be2ce7 |
220 | if ($dbi_info->{mysql_type_name} =~ /\bunsigned\b/i) { |
46bef65f |
221 | $extra_info{extra}{unsigned} = 1; |
222 | } |
45be2ce7 |
223 | if ($dbi_info->{mysql_values}) { |
224 | $extra_info{extra}{list} = $dbi_info->{mysql_values}; |
8fdd52a2 |
225 | } |
3372cb43 |
226 | if ( lc($dbi_info->{COLUMN_DEF}) eq 'current_timestamp' |
227 | && lc($dbi_info->{mysql_type_name}) eq 'timestamp') { |
3facc532 |
228 | |
6e566cc4 |
229 | my $current_timestamp = 'current_timestamp'; |
230 | $extra_info{default_value} = \$current_timestamp; |
f430297e |
231 | } |
8fdd52a2 |
232 | |
a8df0345 |
233 | return \%extra_info; |
8fdd52a2 |
234 | } |
235 | |
db9c411a |
236 | sub _dbh_column_info { |
237 | my $self = shift; |
238 | |
239 | local $SIG{__WARN__} = sub { warn @_ |
240 | unless $_[0] =~ /^column_info: unrecognized column type/ }; |
241 | |
242 | $self->next::method(@_); |
243 | } |
244 | |
5c06aa08 |
245 | sub _table_comment { |
246 | my ( $self, $table ) = @_; |
247 | my $comment = $self->next::method($table); |
248 | if (not $comment) { |
ea998e8e |
249 | ($comment) = try { $self->schema->storage->dbh->selectrow_array( |
5c06aa08 |
250 | qq{SELECT table_comment |
251 | FROM information_schema.tables |
252 | WHERE table_schema = schema() |
253 | AND table_name = ? |
254 | }, undef, $table); |
ea998e8e |
255 | }; |
5c06aa08 |
256 | # InnoDB likes to auto-append crap. |
257 | if (not $comment) { |
258 | # Do nothing. |
259 | } |
260 | elsif ($comment =~ /^InnoDB free:/) { |
261 | $comment = undef; |
262 | } |
263 | else { |
264 | $comment =~ s/; InnoDB.*//; |
265 | } |
266 | } |
ea998e8e |
267 | return $comment; |
5c06aa08 |
268 | } |
269 | |
270 | sub _column_comment { |
271 | my ( $self, $table, $column_number, $column_name ) = @_; |
272 | my $comment = $self->next::method($table, $column_number, $column_name); |
273 | if (not $comment) { |
ea998e8e |
274 | ($comment) = try { $self->schema->storage->dbh->selectrow_array( |
5c06aa08 |
275 | qq{SELECT column_comment |
276 | FROM information_schema.columns |
277 | WHERE table_schema = schema() |
278 | AND table_name = ? |
279 | AND column_name = ? |
280 | }, undef, $table, $column_name); |
ea998e8e |
281 | }; |
5c06aa08 |
282 | } |
283 | return $comment; |
284 | } |
285 | |
996be9ee |
286 | =head1 SEE ALSO |
287 | |
288 | L<DBIx::Class::Schema::Loader>, L<DBIx::Class::Schema::Loader::Base>, |
289 | L<DBIx::Class::Schema::Loader::DBI> |
290 | |
be80bba7 |
291 | =head1 AUTHOR |
292 | |
9cc8e7e1 |
293 | See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>. |
be80bba7 |
294 | |
295 | =head1 LICENSE |
296 | |
297 | This library is free software; you can redistribute it and/or modify it under |
298 | the same terms as Perl itself. |
299 | |
996be9ee |
300 | =cut |
301 | |
302 | 1; |
26334ec1 |
303 | # vim:et sw=4 sts=4 tw=0: |