To my chagrin, the old patch stopped the warnings but also made
"00_compile.t" fail. The new patch adds the feature of "only invoke
set_sql once" in a different way. We don't try to access
__PACKAGE__->set_sql at compile-time (because who knows whether it's
really being compiled in the right context?) but instead only call it
when needed, just remembering never to do it twice.
diff --git a/lib/Class/DBI/Plugin/DateFormat/Oracle.pm b/lib/Class/DBI/Plugin/DateFormat/Oracle.pm
index ee97760..92860fd 100644
--- a/lib/Class/DBI/Plugin/DateFormat/Oracle.pm
+++ b/lib/Class/DBI/Plugin/DateFormat/Oracle.pm
@@ -22,18 +22,24 @@ sub import {
$self->_croak("ALTER SESSION ERROR ".$@ ) if $@;
};
- *{"$pkg\::get_nls_date_format"} = sub {
- my $self = shift;
- my $date_format;
-
- $self->set_sql(nls_date_format => q[SELECT VALUE FROM v$nls_parameters WHERE PARAMETER = 'NLS_DATE_FORMAT']);
-
- eval {
- $date_format = $self->search_nls_date_format->first->{value};
- };
-
- $self->_croak("SELECT NLS_DATE_FORMAT ERROR ".$@ ) if $@;
- return $date_format;
+ {
+ # In a block so the variable is really private.
+ my $_dateFormatHasBeenSetBefore = 0 ;
+ *{"$pkg\::get_nls_date_format"} = sub {
+ my $self = shift;
+ my $date_format;
+
+ $self->set_sql(nls_date_format => q[SELECT VALUE FROM v$nls_parameters WHERE PARAMETER = 'NLS_DATE_FORMAT'])
+ unless $_dateFormatHasBeenSetBefore ;
+ $_dateFormatHasBeenSetBefore = 1 ;
+
+ eval {
+ $date_format = $self->search_nls_date_format->first->{value};
+ };
+
+ $self->_croak("SELECT NLS_DATE_FORMAT ERROR ".$@ ) if $@;
+ return $date_format;
+ }
}
}
diff --git a/t/05_goodpattern.t b/t/05_goodpattern.t
new file mode 100644
index 0000000..a89591c
--- /dev/null
+++ b/t/05_goodpattern.t
@@ -0,0 +1,32 @@
+use strict ;
+use lib '../lib' ;
+use Test::More tests => 5 ;
+
+BEGIN { use_ok( 'Class::DBI') || BAIL_OUT( 'Class::DBI does not seem to be installed' ) } ;
+BEGIN { use_ok( 'DBD::Oracle') || BAIL_OUT( 'DBD::Oracle does not seem to be installed' ) } ;
+
+package Test05 ;
+use base 'Class::DBI';
+
+use Class::DBI::Plugin::DateFormat::Oracle ;
+
+## The connect string is lifted from DBD::Oracle's t/nchar_test_lib.pl#oracle_test_dsn
+my $default = 'dbi:Oracle' ;
+my $dsn = $ENV{ORACLE_DSN} ;
+$dsn ||= $ENV{DBI_DSN} if $ENV{DBI_DSN} && ($ENV{DBI_DSN} =~ /^$default/io);
+$dsn ||= $default ;
+my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
+
+__PACKAGE__->connection($dsn, $dbuser, '');
+
+package main ;
+
+ok( Test05->db_Main, 'Connection succeded' ) ;
+
+Test05->set_nls_date_format( 'YYYY-MM-DD HH24:MI:SS' ) ;
+my $longData = Test05->db_Main->selectrow_array( 'SELECT SYSDATE FROM DUAL' ) ;
+like( $longData, qr/^\d{4}-\d{2}-\d{2} \d{2}:\d{2}:\d{2}$/, 'Setting to long format works' );
+
+Test05->set_nls_date_format( 'YYYY-MON-DD' ) ;
+my $shortData = Test05->db_Main->selectrow_array( 'SELECT SYSDATE FROM DUAL' ) ;
+like( $shortData, qr/^\d{4}-\w{3}-\d{2}$/, 'Setting to short format works' );
diff --git a/t/10_nowarnings.t b/t/10_nowarnings.t
new file mode 100644
index 0000000..3afc620
--- /dev/null
+++ b/t/10_nowarnings.t
@@ -0,0 +1,37 @@
+use strict ;
+use lib '../lib' ;
+use Test::More tests => 6 ;
+
+BEGIN { use_ok( 'Class::DBI') || BAIL_OUT( 'Class::DBI does not seem to be installed' ) } ;
+BEGIN { use_ok( 'DBD::Oracle') || BAIL_OUT( 'DBD::Oracle does not seem to be installed' ) } ;
+
+package Test10 ;
+use base 'Class::DBI';
+
+use Class::DBI::Plugin::DateFormat::Oracle ;
+
+## The connect string is lifted from DBD::Oracle's t/nchar_test_lib.pl#oracle_test_dsn
+my $default = 'dbi:Oracle' ;
+my $dsn = $ENV{ORACLE_DSN} ;
+$dsn ||= $ENV{DBI_DSN} if $ENV{DBI_DSN} && ($ENV{DBI_DSN} =~ /^$default/io);
+$dsn ||= $default ;
+my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
+
+__PACKAGE__->connection($dsn, $dbuser, '');
+
+package main ;
+
+ok( Test10->db_Main, 'Connection succeded' ) ;
+
+my $errMsg = undef ;
+## TODO: Just use Test::Warn
+local $SIG{__WARN__} = sub { $errMsg = join( ',', @_ ); warn @_ ; } ;
+my $f = eval { Test10->get_nls_date_format } ;
+
+## TODO: Skip is better than BAIL
+ok( $f, 'NLS_DATE is retrieved' )
+ || BAIL_OUT( 'Could not retrieve NLS_DATE. Failed to connect? ' . $@ ) ;
+my $g = Test10->get_nls_date_format ;
+
+ok( ! $errMsg, 'No warnings' ) ;
+is( $f, $g, 'NLS_DATE is preserved' ) ;
