fix the decimal data type for MS Access over ODBC
Rafael Kitover [Fri, 10 Jun 2011 16:54:56 +0000 (12:54 -0400)]
Changes
lib/DBIx/Class/Schema/Loader/DBI/ODBC/ACCESS.pm
t/10_11msaccess_common.t
t/lib/dbixcsl_common_tests.pm

diff --git a/Changes b/Changes
index 84aeffe..b5bee8c 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,6 @@
 Revision history for Perl extension DBIx::Class::Schema::Loader
 
+        - fix the decimal data type for MS Access over ODBC
         - fix enum/set detection for MySQL (RT#68717)
         - fix is_nullable detection on MS Access
         - remove '$table has no primary key' warning
index 8040b2e..cfaa902 100644 (file)
@@ -310,14 +310,19 @@ sub _columns_info_for {
             $info->{original}{data_type} = 'currency';
 
             if (ref $info->{size} eq 'ARRAY' && $info->{size}[0] == 19 && $info->{size}[1] == 4) {
-                # Actual money column via ODBC, otherwise we pass the sizes on to the ADO driver for decimal
-                # columns (which masquerade as money columns...)
+                # Actual money column via ODBC, otherwise we pass the sizes on to the ADO driver for
+                # decimal columns (which masquerade as money columns...)
+                delete $info->{size};
+            }
+        }
+        elsif ($data_type eq 'decimal') {
+            if (ref $info->{size} eq 'ARRAY' && $info->{size}[0] == 18 && $info->{size}[1] == 0) {
                 delete $info->{size};
             }
         }
 
 # Pass through currency (which can be decimal for ADO.)
-        if ($data_type !~ /^(?:(?:var)?(?:char|binary))\z/ && $data_type ne 'currency') {
+        if ($data_type !~ /^(?:(?:var)?(?:char|binary)|decimal)\z/ && $data_type ne 'currency') {
             delete $info->{size};
         }
     }
index 49e3483..bca0924 100644 (file)
@@ -1,6 +1,8 @@
 use strict;
 use warnings;
 use Test::More;
+use DBIx::Class::Schema::Loader::DBI::ODBC::ACCESS ();
+use Win32::OLE ();
 use lib qw(t/lib);
 use dbixcsl_common_tests;
 
@@ -105,7 +107,31 @@ my $tester = dbixcsl_common_tests->new(
         'image'       => { data_type => 'image', original => { data_type => 'longbinary' } },
         'longbinary'  => { data_type => 'image', original => { data_type => 'longbinary' } },
 
-        ($ado_dsn && (not $odbc_dsn) ? %ado_extra_types : ())
+        %ado_extra_types,
+    },
+    data_types_ddl_cb => sub {
+        my $ddl = shift;
+        {
+            package DBIXCSL_Test::DummySchema;
+            use base 'DBIx::Class::Schema';
+        }
+        my @connect_info = $odbc_dsn ? ($odbc_dsn, $odbc_user, $odbc_password)
+                                     : ($ado_dsn,  $ado_user,  $ado_password);
+
+        my $schema = DBIXCSL_Test::DummySchema->connect(@connect_info);
+
+        my $loader = DBIx::Class::Schema::Loader::DBI::ODBC::ACCESS->new(
+            schema => $schema,
+            naming => 'current',
+        );
+
+        my $conn = $loader->_ado_connection;
+
+        my $comm = Win32::OLE->new('ADODB.Command');
+
+        $comm->{ActiveConnection} = $conn;
+        $comm->{CommandText}      = $ddl;
+        $comm->Execute;
     },
 );
 
index 5c15161..9051c8d 100644 (file)
@@ -156,7 +156,14 @@ sub run_only_extra_tests {
         $dbh->do($_) for @{ $self->{extra}{create} || [] };
 
         if (not ($self->{vendor} eq 'mssql' && $dbh->{Driver}{Name} eq 'Sybase')) {
-            $dbh->do($_) for @{ $self->{data_type_tests}{ddl} || []};
+            foreach my $ddl (@{ $self->{data_type_tests}{ddl} || []}) {
+                if (my $cb = $self->{data_types_ddl_cb}) {
+                    $cb->($ddl);
+                }
+                else {
+                    $dbh->do($_) 
+                }
+            }
         }
 
         $self->{_created} = 1;
@@ -1864,7 +1871,14 @@ sub create {
     $dbh->do($_) foreach (@statements);
 
     if (not ($self->{vendor} eq 'mssql' && $dbh->{Driver}{Name} eq 'Sybase')) {
-        $dbh->do($_) foreach (@{ $self->{data_type_tests}{ddl} || [] });
+        foreach my $ddl (@{ $self->{data_type_tests}{ddl} || [] }) {
+            if (my $cb = $self->{data_types_ddl_cb}) {
+                $cb->($ddl);
+            }
+            else {
+                $dbh->do($_) 
+            }
+        }
     }
 
     unless ($self->{skip_rels}) {