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',
20 DBIx::DBSchema::DBD::mysql - MySQL native driver for DBIx::DBSchema
27 $dbh = DBI->connect('dbi:mysql:database', 'user', 'pass');
28 $schema = new_native DBIx::DBSchema $dbh;
32 This module implements a MySQL-native driver for DBIx::DBSchema.
37 my($proto, $dbh, $table ) = @_;
38 my $oldkhv=$dbh->{FetchHashKeyName};
39 $dbh->{FetchHashKeyName}="NAME";
40 my $sth = $dbh->prepare("SHOW COLUMNS FROM $table") or die $dbh->errstr;
41 $sth->execute or die $sth->errstr;
43 $_->{'Type'} =~ /^(\w+)\(?([^)]+)?\)?( \d+)?$/
44 or die "Illegal type: ". $_->{'Type'}. "\n";
45 my($type, $length) = ($1, $2);
54 } @{ $sth->fetchall_arrayref( {} ) };
55 $dbh->{FetchHashKeyName}=$oldkhv;
60 # my($proto, $dbh, $table ) = @_;
61 # my $primary_key = '';
62 # my $sth = $dbh->prepare("SHOW INDEX FROM $table")
63 # or die $dbh->errstr;
64 # $sth->execute or die $sth->errstr;
65 # my @pkey = map { $_->{'Column_name'} } grep {
66 # $_->{'Key_name'} eq "PRIMARY"
67 # } @{ $sth->fetchall_arrayref( {} ) };
68 # scalar(@pkey) ? $pkey[0] : '';
72 my($proto, $dbh, $table) = @_;
73 my($pkey, $unique_href, $index_href) = $proto->_show_index($dbh, $table);
78 my($proto, $dbh, $table) = @_;
79 my($pkey, $unique_href, $index_href) = $proto->_show_index($dbh, $table);
84 my($proto, $dbh, $table) = @_;
85 my($pkey, $unique_href, $index_href) = $proto->_show_index($dbh, $table);
90 my($proto, $dbh, $table ) = @_;
91 my $oldkhv=$dbh->{FetchHashKeyName};
92 $dbh->{FetchHashKeyName}="NAME";
93 my $sth = $dbh->prepare("SHOW INDEX FROM $table")
95 $sth->execute or die $sth->errstr;
99 foreach my $row ( @{ $sth->fetchall_arrayref({}) } ) {
100 if ( $row->{'Key_name'} eq 'PRIMARY' ) {
101 $pkey = $row->{'Column_name'};
102 } elsif ( $row->{'Non_unique'} ) { #index
103 push @{ $index{ $row->{'Key_name'} } }, $row->{'Column_name'};
105 push @{ $unique{ $row->{'Key_name'} } }, $row->{'Column_name'};
108 $dbh->{FetchHashKeyName}=$oldkhv;
110 ( $pkey, \%unique, \%index );
113 sub column_callback {
114 my( $proto, $dbh, $table, $column_obj ) = @_;
116 my $hashref = { 'explicit_null' => 1, };
118 $hashref->{'effective_local'} = 'AUTO_INCREMENT'
119 if $column_obj->type =~ /^(\w*)SERIAL$/i;
121 if ( $column_obj->default =~ /^(NOW)\(\)$/i
122 && $column_obj->type =~ /^(TIMESTAMP|DATETIME)$/i ) {
124 $hashref->{'effective_default'} = 'CURRENT_TIMESTAMP';
125 $hashref->{'effective_type'} = 'TIMESTAMP';
135 Ivan Kohler <ivan-dbix-dbschema@420.am>
139 Copyright (c) 2000 Ivan Kohler
140 Copyright (c) 2000 Mail Abuse Prevention System LLC
141 Copyright (c) 2007 Freeside Internet Services, Inc.
143 This program is free software; you can redistribute it and/or modify it under
144 the same terms as Perl itself.
150 L<DBIx::DBSchema>, L<DBIx::DBSchema::DBD>, L<DBI>, L<DBI::DBD>