use vars qw($VERSION @ISA %typemap);
use DBIx::DBSchema::DBD;
-$VERSION = '0.03';
+$VERSION = '0.09';
@ISA = qw(DBIx::DBSchema::DBD);
%typemap = (
- 'TIMESTAMP' => 'DATETIME',
- 'SERIAL' => 'INTEGER',
- 'BOOL' => 'TINYINT',
+ 'TIMESTAMP' => 'DATETIME',
+ 'SERIAL' => 'INTEGER',
+ 'BIGSERIAL' => 'BIGINT',
+ 'BOOL' => 'TINYINT',
+ 'LONG VARBINARY' => 'LONGBLOB',
+ 'TEXT' => 'LONGTEXT',
);
=head1 NAME
This module implements a MySQL-native driver for DBIx::DBSchema.
=cut
+ use Data::Dumper;
sub columns {
my($proto, $dbh, $table ) = @_;
+ my $oldkhv=$dbh->{FetchHashKeyName};
+ $dbh->{FetchHashKeyName}="NAME";
my $sth = $dbh->prepare("SHOW COLUMNS FROM $table") or die $dbh->errstr;
$sth->execute or die $sth->errstr;
- map {
- $_->{'Type'} =~ /^(\w+)\(?([\d\,]+)?\)?( unsigned)?$/
+ my @r = map {
+ #warn Dumper($_);
+ $_->{'Type'} =~ /^(\w+)\(?([^)]+)?\)?( \d+)?$/
or die "Illegal type: ". $_->{'Type'}. "\n";
my($type, $length) = ($1, $2);
+
+ my $default = $_->{'Default'};
+ if ( defined($default) ) {
+ $default = \"''" if $default eq '';
+ $default = \0 if $default eq '0';
+ $default = \'NOW()' if uc($default) eq 'CURRENT_TIMESTAMP';
+ } else {
+ $default = '';
+ }
+
[
$_->{'Field'},
$type,
- $_->{'Null'},
+ ( $_->{'Null'} =~ /^YES$/i ? 'NULL' : '' ),
$length,
- $_->{'Default'},
+ $default,
$_->{'Extra'}
]
} @{ $sth->fetchall_arrayref( {} ) };
+ $dbh->{FetchHashKeyName}=$oldkhv;
+ @r;
}
#sub primary_key {
sub _show_index {
my($proto, $dbh, $table ) = @_;
+ my $oldkhv=$dbh->{FetchHashKeyName};
+ $dbh->{FetchHashKeyName}="NAME";
my $sth = $dbh->prepare("SHOW INDEX FROM $table")
or die $dbh->errstr;
$sth->execute or die $sth->errstr;
push @{ $unique{ $row->{'Key_name'} } }, $row->{'Column_name'};
}
}
+ $dbh->{FetchHashKeyName}=$oldkhv;
( $pkey, \%unique, \%index );
}
+sub column_callback {
+ my( $proto, $dbh, $table, $column_obj ) = @_;
+
+ my $hashref = { 'explicit_null' => 1, };
+
+ $hashref->{'effective_local'} = 'AUTO_INCREMENT'
+ if $column_obj->type =~ /^(\w*)SERIAL$/i;
+
+ if ( $column_obj->quoted_default =~ /^(NOW)\(\)$/i
+ && $column_obj->type =~ /^(TIMESTAMP|DATETIME)$/i ) {
+
+ $hashref->{'effective_default'} = 'CURRENT_TIMESTAMP';
+ $hashref->{'effective_type'} = 'TIMESTAMP';
+
+ }
+
+ # MySQL no longer supports defaults for text/blob columns
+ if ( $column_obj->type =~ /(TEXT|BLOB)/i
+ and defined $column_obj->default ) {
+
+ # There's no way to unset the default cleanly.
+ # An empty string isn't quite right.
+ $column_obj->{'default'} = undef;
+ }
+
+ $hashref;
+
+}
+
+sub alter_column_callback {
+ my( $proto, $dbh, $table, $old_column, $new_column ) = @_;
+ my $old_name = $old_column->name;
+ my $new_def = $new_column->line($dbh);
+
+ my $hashref = {};
+
+ my %canonical = (
+ 'INTEGER' => 'INT',
+ 'SERIAL' => 'INT',
+ 'BIGSERIAL' => 'BIGINT',
+ 'REAL' => 'DOUBLE', #'FLOAT',
+ 'DOUBLE PRECISION' => 'DOUBLE',
+ );
+ foreach ($old_column, $new_column) {
+ $_->type($canonical{uc($_->type)}) if $canonical{uc($_->type)};
+ }
+
+ my %canonical_length = (
+ 'INT' => 11,
+ 'BIGINT' => 20,
+ 'DECIMAL' => '10,0',
+ );
+ $new_column->length( $canonical_length{uc($new_column->type)} )
+ if $canonical_length{uc($new_column->type)}
+ && ($new_column->length||'') eq '';
+
+ #change type/length
+ if ( uc($old_column->type) ne uc($new_column->type)
+ || ($old_column->length||'') ne ($new_column->length||'')
+ )
+ {
+ my $old_def = $old_column->line($dbh);
+ $hashref->{'sql_alter_type'} =
+ "CHANGE $old_name $new_def";
+ }
+
+ #change nullability
+ if ( $old_column->null ne $new_column->null ) {
+ $hashref->{'sql_alter_null'} =
+ "ALTER TABLE $table MODIFY $new_def";
+ }
+
+ $hashref;
+}
+
=head1 AUTHOR
Ivan Kohler <ivan-dbix-dbschema@420.am>
Copyright (c) 2000 Ivan Kohler
Copyright (c) 2000 Mail Abuse Prevention System LLC
+Copyright (c) 2007-2013 Freeside Internet Services, Inc.
All rights reserved.
This program is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.