From: Rafael Kitover <rkitover@cpan.org>
Date: Fri, 10 Jun 2011 16:54:56 +0000 (-0400)
Subject: fix the decimal data type for MS Access over ODBC
X-Git-Tag: 0.07011~75
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FDBIx-Class-Schema-Loader.git;a=commitdiff_plain;h=3568bda98bc24d41e7f5a253a56b258c9aae86fc

fix the decimal data type for MS Access over ODBC
---

diff --git a/Changes b/Changes
index 84aeffe..b5bee8c 100644
--- 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
diff --git a/lib/DBIx/Class/Schema/Loader/DBI/ODBC/ACCESS.pm b/lib/DBIx/Class/Schema/Loader/DBI/ODBC/ACCESS.pm
index 8040b2e..cfaa902 100644
--- a/lib/DBIx/Class/Schema/Loader/DBI/ODBC/ACCESS.pm
+++ b/lib/DBIx/Class/Schema/Loader/DBI/ODBC/ACCESS.pm
@@ -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};
         }
     }
diff --git a/t/10_11msaccess_common.t b/t/10_11msaccess_common.t
index 49e3483..bca0924 100644
--- a/t/10_11msaccess_common.t
+++ b/t/10_11msaccess_common.t
@@ -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;
     },
 );
 
diff --git a/t/lib/dbixcsl_common_tests.pm b/t/lib/dbixcsl_common_tests.pm
index 5c15161..9051c8d 100644
--- a/t/lib/dbixcsl_common_tests.pm
+++ b/t/lib/dbixcsl_common_tests.pm
@@ -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}) {