1 package DBIx::Class::Schema::Loader::DBI::mysql;
5 use base 'DBIx::Class::Schema::Loader::DBI';
6 use Carp::Clan qw/^DBIx::Class/;
9 our $VERSION = '0.06001';
13 DBIx::Class::Schema::Loader::DBI::mysql - DBIx::Class::Schema::Loader::DBI mysql Implementation.
18 use base qw/DBIx::Class::Schema::Loader/;
20 __PACKAGE__->loader_options( debug => 1 );
26 See L<DBIx::Class::Schema::Loader::Base>.
31 my ($self, $opts) = @_;
33 return $self->next::method($opts, undef, undef);
37 my ($self, $table) = @_;
39 my $dbh = $self->schema->storage->dbh;
41 local $dbh->{RaiseError} = 0;
42 local $dbh->{PrintError} = 0;
44 my $table_def_ref = eval { $dbh->selectrow_arrayref("SHOW CREATE TABLE `$table`") };
45 my $table_def = $table_def_ref->[1];
47 return [] if not $table_def;
51 my (@reldata) = ($table_def =~
52 /CONSTRAINT $qt.*$qt FOREIGN KEY \($qt(.*)$qt\) REFERENCES $qt(.*)$qt \($qt(.*)$qt\)/ig
56 while (scalar @reldata > 0) {
57 my $cols = shift @reldata;
58 my $f_table = shift @reldata;
59 my $f_cols = shift @reldata;
61 my @cols = map { s/(?: \Q$self->{_quoter}\E | $qt )//x; lc $_ }
62 split(/\s*,\s*/, $cols);
64 my @f_cols = map { s/(?: \Q$self->{_quoter}\E | $qt )//x; lc $_ }
65 split(/\s*,\s*/, $f_cols);
68 local_columns => \@cols,
69 remote_columns => \@f_cols,
70 remote_table => $f_table
77 # primary and unique info comes from the same sql statement,
78 # so cache it here for both routines to use
79 sub _mysql_table_get_keys {
80 my ($self, $table) = @_;
82 if(!exists($self->{_cache}->{_mysql_keys}->{$table})) {
84 my $dbh = $self->schema->storage->dbh;
85 my $sth = $dbh->prepare('SHOW INDEX FROM '.$self->_table_as_sql($table));
87 while(my $row = $sth->fetchrow_hashref) {
88 next if $row->{Non_unique};
89 push(@{$keydata{$row->{Key_name}}},
90 [ $row->{Seq_in_index}, lc $row->{Column_name} ]
93 foreach my $keyname (keys %keydata) {
94 my @ordered_cols = map { $_->[1] } sort { $a->[0] <=> $b->[0] }
95 @{$keydata{$keyname}};
96 $keydata{$keyname} = \@ordered_cols;
98 $self->{_cache}->{_mysql_keys}->{$table} = \%keydata;
101 return $self->{_cache}->{_mysql_keys}->{$table};
105 my ( $self, $table ) = @_;
107 return $self->_mysql_table_get_keys($table)->{PRIMARY};
110 sub _table_uniq_info {
111 my ( $self, $table ) = @_;
114 my $keydata = $self->_mysql_table_get_keys($table);
115 foreach my $keyname (keys %$keydata) {
116 next if $keyname eq 'PRIMARY';
117 push(@uniqs, [ $keyname => $keydata->{$keyname} ]);
123 sub _columns_info_for {
127 my $result = $self->next::method(@_);
129 my $dbh = $self->schema->storage->dbh;
131 while (my ($col, $info) = each %$result) {
133 unless $info->{data_type} =~ /^(?: (?:var)?(?:char(?:acter)?|binary) | bit | year)\z/ix;
135 if ($info->{data_type} eq 'int') {
136 $info->{data_type} = 'integer';
138 elsif ($info->{data_type} eq 'double') {
139 $info->{data_type} = 'double precision';
142 my ($precision, $scale, $column_type) = eval { $dbh->selectrow_array(<<'EOF', {}, lc $table, lc $col) };
143 SELECT numeric_precision, numeric_scale, column_type
144 FROM information_schema.columns
145 WHERE lower(table_name) = ? AND lower(column_name) = ?
147 $column_type = '' if not defined $column_type;
149 if ($info->{data_type} eq 'bit' && (not exists $info->{size})) {
150 $info->{size} = $precision if defined $precision;
152 elsif ($info->{data_type} =~ /^(?:float|double precision|decimal)\z/) {
153 if (defined $precision && defined $scale) {
154 if ($precision == 10 && $scale == 0) {
155 delete $info->{size};
158 $info->{size} = [$precision,$scale];
162 elsif ($info->{data_type} eq 'year') {
163 if ($column_type =~ /\(2\)/) {
166 elsif ($column_type =~ /\(4\)/ || $info->{size} == 4) {
167 delete $info->{size};
175 sub _extra_column_info {
176 no warnings 'uninitialized';
177 my ($self, $table, $col, $info, $dbi_info) = @_;
180 if ($dbi_info->{mysql_is_auto_increment}) {
181 $extra_info{is_auto_increment} = 1
183 if ($dbi_info->{mysql_type_name} =~ /\bunsigned\b/i) {
184 $extra_info{extra}{unsigned} = 1;
186 if ($dbi_info->{mysql_values}) {
187 $extra_info{extra}{list} = $dbi_info->{mysql_values};
189 if ( $dbi_info->{COLUMN_DEF} =~ /^CURRENT_TIMESTAMP\z/i
190 && $dbi_info->{mysql_type_name} =~ /^TIMESTAMP\z/i) {
192 $extra_info{default_value} = \'CURRENT_TIMESTAMP';
200 L<DBIx::Class::Schema::Loader>, L<DBIx::Class::Schema::Loader::Base>,
201 L<DBIx::Class::Schema::Loader::DBI>
205 See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
209 This library is free software; you can redistribute it and/or modify it under
210 the same terms as Perl itself.
215 # vim:et sw=4 sts=4 tw=0: