1 package DBIx::DBSchema::DBD::mysql;
4 use vars qw($VERSION @ISA %typemap);
5 use DBIx::DBSchema::DBD;
8 @ISA = qw(DBIx::DBSchema::DBD);
11 'TIMESTAMP' => 'DATETIME',
12 'SERIAL' => 'INTEGER',
13 'BIGSERIAL' => 'BIGINT',
15 'LONG VARBINARY' => 'LONGBLOB',
21 DBIx::DBSchema::DBD::mysql - MySQL native driver for DBIx::DBSchema
28 $dbh = DBI->connect('dbi:mysql:database', 'user', 'pass');
29 $schema = new_native DBIx::DBSchema $dbh;
33 This module implements a MySQL-native driver for DBIx::DBSchema.
39 my($proto, $dbh, $table ) = @_;
40 my $oldkhv=$dbh->{FetchHashKeyName};
41 $dbh->{FetchHashKeyName}="NAME";
42 my $sth = $dbh->prepare("SHOW COLUMNS FROM $table") or die $dbh->errstr;
43 $sth->execute or die $sth->errstr;
46 $_->{'Type'} =~ /^(\w+)\(?([^)]+)?\)?( \d+)?$/
47 or die "Illegal type: ". $_->{'Type'}. "\n";
48 my($type, $length) = ($1, $2);
50 my $default = $_->{'Default'};
51 if ( defined($default) ) {
52 $default = \"''" if $default eq '';
53 $default = \0 if $default eq '0';
54 $default = \'NOW()' if uc($default) eq 'CURRENT_TIMESTAMP';
62 ( $_->{'Null'} =~ /^YES$/i ? 'NULL' : '' ),
67 } @{ $sth->fetchall_arrayref( {} ) };
68 $dbh->{FetchHashKeyName}=$oldkhv;
73 # my($proto, $dbh, $table ) = @_;
74 # my $primary_key = '';
75 # my $sth = $dbh->prepare("SHOW INDEX FROM $table")
76 # or die $dbh->errstr;
77 # $sth->execute or die $sth->errstr;
78 # my @pkey = map { $_->{'Column_name'} } grep {
79 # $_->{'Key_name'} eq "PRIMARY"
80 # } @{ $sth->fetchall_arrayref( {} ) };
81 # scalar(@pkey) ? $pkey[0] : '';
85 my($proto, $dbh, $table) = @_;
86 my($pkey, $unique_href, $index_href) = $proto->_show_index($dbh, $table);
91 my($proto, $dbh, $table) = @_;
92 my($pkey, $unique_href, $index_href) = $proto->_show_index($dbh, $table);
97 my($proto, $dbh, $table) = @_;
98 my($pkey, $unique_href, $index_href) = $proto->_show_index($dbh, $table);
103 my($proto, $dbh, $table ) = @_;
104 my $oldkhv=$dbh->{FetchHashKeyName};
105 $dbh->{FetchHashKeyName}="NAME";
106 my $sth = $dbh->prepare("SHOW INDEX FROM $table")
108 $sth->execute or die $sth->errstr;
112 foreach my $row ( @{ $sth->fetchall_arrayref({}) } ) {
113 if ( $row->{'Key_name'} eq 'PRIMARY' ) {
114 $pkey = $row->{'Column_name'};
115 } elsif ( $row->{'Non_unique'} ) { #index
116 push @{ $index{ $row->{'Key_name'} } }, $row->{'Column_name'};
118 push @{ $unique{ $row->{'Key_name'} } }, $row->{'Column_name'};
121 $dbh->{FetchHashKeyName}=$oldkhv;
123 ( $pkey, \%unique, \%index );
126 sub column_callback {
127 my( $proto, $dbh, $table, $column_obj ) = @_;
129 my $hashref = { 'explicit_null' => 1, };
131 $hashref->{'effective_local'} = 'AUTO_INCREMENT'
132 if $column_obj->type =~ /^(\w*)SERIAL$/i;
134 if ( $column_obj->quoted_default =~ /^(NOW)\(\)$/i
135 && $column_obj->type =~ /^(TIMESTAMP|DATETIME)$/i ) {
137 $hashref->{'effective_default'} = 'CURRENT_TIMESTAMP';
138 $hashref->{'effective_type'} = 'TIMESTAMP';
146 sub alter_column_callback {
147 my( $proto, $dbh, $table, $old_column, $new_column ) = @_;
148 my $old_name = $old_column->name;
149 my $new_def = $new_column->line($dbh);
151 # this would have been nice, but it appears to be doing too much...
153 # return {} if $old_column->line($dbh) eq $new_column->line($dbh);
156 # { 'sql_alter_null' =>
157 # "ALTER TABLE $table CHANGE $old_name $new_def",
160 return {} if $old_column->null eq $new_column->null;
161 { 'sql_alter_null' =>
162 "ALTER TABLE $table MODIFY $new_def",
170 Ivan Kohler <ivan-dbix-dbschema@420.am>
174 Copyright (c) 2000 Ivan Kohler
175 Copyright (c) 2000 Mail Abuse Prevention System LLC
176 Copyright (c) 2007-2010 Freeside Internet Services, Inc.
178 This program is free software; you can redistribute it and/or modify it under
179 the same terms as Perl itself.
185 L<DBIx::DBSchema>, L<DBIx::DBSchema::DBD>, L<DBI>, L<DBI::DBD>