From: Rafael Kitover 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;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, L, L, -L, L, L (for MSSQL) and L. -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, L (for Sybase ASE and MSSSQL), L (for +MSSQL) and L. 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 from L 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, L, +L + +=head1 AUTHOR + +See L and L. + +=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 ) {