From: Rafael Kitover <rkitover@cpan.org>
Date: Thu, 4 Feb 2010 05:32:49 +0000 (-0500)
Subject: fix default_value introspection for Oracle
X-Git-Tag: 0.05001~9
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6b0e47fc86f045183810ccea343e9afcd438ee1a;hp=31a65b45d0092a32bcc45091382e9907afceb3f6;p=dbsrgits%2FDBIx-Class-Schema-Loader.git

fix default_value introspection for Oracle
---

diff --git a/lib/DBIx/Class/Schema/Loader.pm b/lib/DBIx/Class/Schema/Loader.pm
index 8904b27..f755e2e 100644
--- a/lib/DBIx/Class/Schema/Loader.pm
+++ b/lib/DBIx/Class/Schema/Loader.pm
@@ -78,10 +78,10 @@ setting up the columns, primary keys, and relationships.
 
 DBIx::Class::Schema::Loader currently supports only the DBI storage type.  It
 has explicit support for L<DBD::Pg>, L<DBD::mysql>, L<DBD::DB2>,
-L<DBD::SQLite>, L<DBD::Sybase>, L<DBD::ODBC> (for MSSQL) and L<DBD::Oracle>.
-Other DBI drivers may function to a greater or lesser degree with this loader,
-depending on how much of the DBI spec they implement, and how standard their
-implementation is.
+L<DBD::SQLite>, L<DBD::Sybase> (for Sybase ASE and MSSSQL), L<DBD::ODBC> (for
+MSSQL) and L<DBD::Oracle>.  Other DBI drivers may function to a greater or
+lesser degree with this loader, depending on how much of the DBI spec they
+implement, and how standard their implementation is.
 
 Patches to make other DBDs work correctly welcome.
 
diff --git a/lib/DBIx/Class/Schema/Loader/DBI/Component/QuotedDefault.pm b/lib/DBIx/Class/Schema/Loader/DBI/Component/QuotedDefault.pm
new file mode 100644
index 0000000..97a94ce
--- /dev/null
+++ b/lib/DBIx/Class/Schema/Loader/DBI/Component/QuotedDefault.pm
@@ -0,0 +1,61 @@
+package DBIx::Class::Schema::Loader::DBI::Component::QuotedDefault;
+
+use strict;
+use warnings;
+use Class::C3;
+
+our $VERSION = '0.05000';
+
+=head1 NAME
+
+DBIx::Class::Schema::Loader::DBI::Component::QuotedDefault -- Loader Component
+to parse quoted default constants and functions
+
+=head1 DESCRIPTION
+
+If C<COLUMN_DEF> from L<DBI/column_info> returns character constants quoted,
+then we need to remove the quotes. This also allows distinguishing between
+default functions without information schema introspection.
+
+=cut
+
+sub _columns_info_for {
+    my $self    = shift;
+    my ($table) = @_;
+
+    my $result = $self->next::method(@_);
+
+    while (my ($col, $info) = each %$result) {
+        if (my $def = $info->{default_value}) {
+            $def =~ s/^\s+//;
+            $def =~ s/\s+\z//;
+
+            if ($def =~ /^["'](.*?)['"]\z/) {
+                $info->{default_value} = $1;
+            }
+            else {
+                $info->{default_value} = $def =~ /^\d/ ? $def : \$def;
+            }
+        }
+    }
+
+    return $result;
+}
+
+1;
+
+=head1 SEE ALSO
+
+L<DBIx::Class::Schema::Loader>, L<DBIx::Class::Schema::Loader::Base>,
+L<DBIx::Class::Schema::Loader::DBI>
+
+=head1 AUTHOR
+
+See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
+
+=head1 LICENSE
+
+This library is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
diff --git a/lib/DBIx/Class/Schema/Loader/DBI/Oracle.pm b/lib/DBIx/Class/Schema/Loader/DBI/Oracle.pm
index 1a8d817..dfc8650 100644
--- a/lib/DBIx/Class/Schema/Loader/DBI/Oracle.pm
+++ b/lib/DBIx/Class/Schema/Loader/DBI/Oracle.pm
@@ -2,7 +2,10 @@ package DBIx::Class::Schema::Loader::DBI::Oracle;
 
 use strict;
 use warnings;
-use base 'DBIx::Class::Schema::Loader::DBI';
+use base qw/
+    DBIx::Class::Schema::Loader::DBI::Component::QuotedDefault
+    DBIx::Class::Schema::Loader::DBI
+/;
 use Carp::Clan qw/^DBIx::Class/;
 use Class::C3;
 
diff --git a/t/14ora_common.t b/t/14ora_common.t
index 2cd05b5..f68a7e3 100644
--- a/t/14ora_common.t
+++ b/t/14ora_common.t
@@ -1,6 +1,8 @@
 use strict;
 use lib qw(t/lib);
 use dbixcsl_common_tests;
+use Test::More;
+use Test::Exception;
 
 my $dsn      = $ENV{DBICTEST_ORA_DSN} || '';
 my $user     = $ENV{DBICTEST_ORA_USER} || '';
@@ -30,6 +32,51 @@ my $tester = dbixcsl_common_tests->new(
     dsn         => $dsn,
     user        => $user,
     password    => $password,
+    extra       => {
+        create => [
+            q{
+                CREATE TABLE oracle_loader_test1 (
+                    id INTEGER PRIMARY KEY,
+                    a_varchar VARCHAR2(100) DEFAULT 'foo',
+                    an_int INTEGER DEFAULT 42,
+                    a_double DOUBLE PRECISION DEFAULT 10.555,
+                    a_date DATE DEFAULT sysdate
+                )
+            },
+        ],
+        drop   => [ qw/ oracle_loader_test1 / ],
+        count  => 5,
+        run    => sub {
+            my ($schema, $monikers, $classes) = @_;
+
+            my $rsrc = $schema->resultset($monikers->{oracle_loader_test1})
+                ->result_source;
+
+            is $rsrc->column_info('a_varchar')->{default_value},
+                'foo',
+                'constant character default';
+
+            is $rsrc->column_info('an_int')->{default_value},
+                42,
+                'constant integer default';
+
+            is $rsrc->column_info('a_double')->{default_value},
+                10.555,
+                'constant numeric default';
+
+            my $function_default =
+                $rsrc->column_info('a_date')->{default_value};
+
+            ok ((ref $function_default eq 'SCALAR'),
+                'default_value for function default is a scalar ref')
+            or diag "default_value is: ", $function_default
+            ;
+
+            eval { is $$function_default,
+                'sysdate',
+                'default_value for function default is correct' };
+        },
+    },
 );
 
 if( !$dsn || !$user ) {