Apologies, there were a couple of errors with the first patch for
Storage/DBI/mysql.pm
Updated patch attached
Carl
Index: mysql.pm
===================================================================
--- mysql.pm (revision 1369)
+++ mysql.pm (working copy)
@@ -2,21 +2,12 @@
use strict;
use warnings;
+use Carp::Clan qw/^DBIx::Class/;
use base qw/DBIx::Class::Storage::DBI/;
# __PACKAGE__->load_components(qw/PK::Auto/);
-sub last_insert_id {
- return $_[0]->_dbh->{mysql_insertid};
-}
-
-sub sqlt_type {
- return 'MySQL';
-}
-
-1;
-
=head1 NAME
DBIx::Class::Storage::DBI::mysql - Automatic primary key class for MySQL
@@ -31,6 +22,208 @@
This class implements autoincrements for MySQL.
+=head1 METHODS
+
+=head2 columns_info_for
+
+Extends L<DBIx::Class::Storage::DBI/columns_info_for>.
+
+=cut
+
+sub columns_info_for {
+ my ($self, $table) = @_;
+
+ my $result;
+
+ if ($self->dbh->can('column_info')) {
+ my $old_raise_err = $self->dbh->{RaiseError};
+ my $old_print_err = $self->dbh->{PrintError};
+ $self->dbh->{RaiseError} = 1;
+ $self->dbh->{PrintError} = 0;
+ eval {
+ my $sth = $self->dbh->column_info( undef, undef, $table, '%' );
+ $sth->execute();
+ while ( my $info = $sth->fetchrow_hashref() ){
+ my %column_info;
+ $column_info{data_type} = $info->{TYPE_NAME};
+ $column_info{size} = $info->{COLUMN_SIZE};
+ $column_info{is_nullable} = $info->{NULLABLE} ? 1 : 0;
+ $column_info{default_value} = $info->{COLUMN_DEF};
+
+ my %info = $self->_extract_mysql_specs($info);
+ $column_info{$_} = $info{$_} for keys %info;
+
+ $result->{$info->{COLUMN_NAME}} = \%column_info;
+ }
+ };
+ $self->dbh->{RaiseError} = $old_raise_err;
+ $self->dbh->{PrintError} = $old_print_err;
+ return {} if $@;
+ }
+
+ return $result;
+}
+
+sub _extract_mysql_specs {
+ my ($self, $info) = @_;
+
+ my $basetype = lc($info->{TYPE_NAME});
+ my $mysql_type = lc($info->{mysql_type_name});
+ my %info;
+
+ if ($basetype eq 'char') {
+ if (_version_lt($self->dbh->{mysql_serverinfo}, '4.1')) {
+ $info{length_in_bytes} = 1;
+ }
+ $info{ignore_trailing_spaces} = 1;
+ }
+ elsif ($basetype eq 'varchar') {
+ if (_version_le($self->dbh->{mysql_serverinfo}, '4.1')) {
+ $info{ignore_trailing_spaces} = 1;
+ }
+ if (_version_lt($self->dbh->{mysql_serverinfo}, '4.1')) {
+ $info{length_in_bytes} = 1;
+ }
+ }
+ elsif ($basetype =~ /text$/) {
+ if (_version_lt($self->dbh->{mysql_serverinfo}, '4.1')) {
+ $info{length_in_bytes} = 1;
+ }
+ elsif ($basetype =~ /blob$/) {
+ $info{length_in_bytes} = 1;
+ }
+ }
+ elsif ($basetype eq 'binary') {
+ $info{ignore_trailing_spaces} = 1;
+ $info{length_in_bytes} = 1;
+ }
+ elsif ($basetype eq 'varbinary') {
+ if (_version_le($self->dbh->{mysql_serverinfo}, '4.1')) {
+ $info{ignore_trailing_spaces} = 1;
+ }
+ $info{length_in_bytes} = 1;
+ }
+ elsif ($basetype =~ /^(enum|set)/) {
+ $info{data_set} = $info->{mysql_values};
+ }
+ elsif ($basetype =~ /int$/) {
+ if ($mysql_type =~ /unsigned /) {
+ my %max = (
+ tinyint => 2**8 - 1,
+ smallint => 2**16 - 1,
+ mediumint => 2**24 - 1,
+ int => 2**32 - 1,
+ bigint => 2**64 - 1,
+ );
+ $info{is_unsigned} = 1;
+ $info{range_min} = 0;
+ $info{range_max} = $max{$basetype};
+ }
+ else { # not unsigned
+ my %min = (
+ tinyint => - 2**7,
+ smallint => - 2**15,
+ mediumint => - 2**23,
+ int => - 2**31,
+ bigint => - 2**63,
+ );
+ my %max = (
+ tinyint => 2**7 - 1,
+ smallint => 2**15 - 1,
+ mediumint => 2**23 - 1,
+ int => 2**31 - 1,
+ bigint => 2**63 - 1,
+ );
+ $info{range_min} = $min{$basetype};
+ $info{range_max} = $max{$basetype};
+ }
+ }
+ elsif ($basetype =~ /^decimal/) {
+ if (_version_le($self->dbh->{mysql_serverinfo}, '4.1')) {
+ $info{decimal_high_positive} = 1;
+ }
+ if (_version_lt($self->dbh->{mysql_serverinfo}, '3.23')) {
+ $info{decimal_literal_range} = 1;
+ }
+ }
+ else {
+ croak "unknown column type: '$basetype'";
+ }
+
+ return %info;
+}
+
+sub _version_eq {
+ my ($x, $y) = @_;
+
+ ($x, $y) = _version_normalize( @_ );
+
+ return 1 if defined $x && $x eq $y;
+ return;
+}
+
+sub _version_lt {
+ my ($x, $y) = @_;
+
+ ($x, $y) = _version_normalize( @_ );
+
+ return 1 if defined $x && $x lt $y;
+ return;
+}
+
+sub _version_gt {
+ my ($x, $y) = @_;
+
+ ($x, $y) = _version_normalize( @_ );
+
+ return 1 if defined $x && $x gt $y;
+ return;
+}
+
+sub _version_le {
+ my ($x, $y) = @_;
+
+ return 1 if _version_lt($x, $y) || _version_eq($x, $y);
+ return;
+}
+
+sub _version_ge {
+ my ($x, $y) = @_;
+
+ return 1 if _version_gt($x, $y) || _version_eq($x, $y);
+ return;
+}
+
+sub _version_normalize {
+ my ($x, $y) = @_;
+
+ my ($x1, $x2, $x3) = $x =~ /(^\d+)(?:\.(\d+))?(?:\.(\d+))?/
+ or return;
+
+ $x2 = 0 if not defined $x2;
+ $x3 = 0 if not defined $x3;
+
+ $x = sprintf "%03d%03d%03d", $x1, $x2, $x3;
+
+ my ($y1, $y2, $y3) = $y =~ /(^\d+)(?:\.(\d+))?(?:\.(\d+))?/
+ or return;
+
+ $y2 = 0 if not defined $y2;
+ $y3 = 0 if not defined $y3;
+
+ $y = sprintf "%03d%03d%03d", $y1, $y2, $y3;
+
+ return ($x, $y);
+}
+
+sub last_insert_id {
+ return $_[0]->_dbh->{mysql_insertid};
+}
+
+sub sqlt_type {
+ return 'MySQL';
+}
+
=head1 AUTHORS
Matt S. Trout <[EMAIL PROTECTED]>
@@ -40,3 +233,5 @@
You may distribute this code under the same terms as Perl itself.
=cut
+
+1;
_______________________________________________
List: http://lists.rawmode.org/cgi-bin/mailman/listinfo/dbix-class
Wiki: http://dbix-class.shadowcatsystems.co.uk/
IRC: irc.perl.org#dbix-class
SVN: http://dev.catalyst.perl.org/repos/bast/trunk/DBIx-Class/
