[svn:dbd-oracle] r15465 - in dbd-oracle/trunk: . lib/DBD t

Author: mjevans
Date: Wed Oct 31 02:04:53 2012
New Revision: 15465

Modified:
   dbd-oracle/trunk/Changes
   dbd-oracle/trunk/lib/DBD/Oracle.pm
   dbd-oracle/trunk/t/39attr.t

Log:
39attr.t could fail if using oracle client > 11 but not >= 11.2
minor code formatting changes in Oracle.pm
document ora_server_version
remove empty h1 in Oracle.pm


Modified: dbd-oracle/trunk/Changes
==============================================================================
--- dbd-oracle/trunk/Changes	(original)
+++ dbd-oracle/trunk/Changes	Wed Oct 31 02:04:53 2012
@@ -3,9 +3,7 @@
 NEXT_VERSION
 
   [BUG FIXES]
-  
-  - simple code clean up, replacing 3 uses of safemalloc with Newz (John Scoles)
-  
+
   - fix memory leak in execute_array (John Scoles, Pierre-Alain Blanc)
 
   - Fix RT80349 - The error message in execute_for_fetch when a row fails
@@ -24,6 +22,11 @@
     SYS_REFCURSOR is not defined. Instead of CREATE/DROP PROCEDURE,
     use anonymous block. Thanks to Steffen Goeldner.
 
+  - Fix bug in 39attr.t which could fail if using an Oracle Client >
+    11 but not >= 11.2 (Martin J. Evans)
+
+  - ora_server_version was not documented.
+
   [MISCELLANEOUS]
 
   - The original 26exe_array test was replaced some time ago with a
@@ -32,6 +35,9 @@
     above). To make keeping them in synch easier I've modularised the
     tests. Hence new ExecuteArray.pm. (Martin J. Evans)
 
+  - simple code clean up, replacing 3 uses of safemalloc with Newz
+    (John Scoles)
+
 
 1.52      2012-10-19
 

Modified: dbd-oracle/trunk/lib/DBD/Oracle.pm
==============================================================================
--- dbd-oracle/trunk/lib/DBD/Oracle.pm	(original)
+++ dbd-oracle/trunk/lib/DBD/Oracle.pm	Wed Oct 31 02:04:53 2012
@@ -982,30 +982,29 @@
     }
 
     sub dbms_msgpipe_ack {
-	my $dbh = shift;
-	my $msg = shift;
-	my $sth = $dbh->prepare_cached(q{
-	    begin dbms_msgpipe.acknowledge(:returnpipe, :errormsg, :param); end;
-	}) or return;
-	$sth->bind_param_inout(":returnpipe", \$msg->[0],   30);
-	$sth->bind_param_inout(":proc",       \$msg->[1],   30);
-	$sth->bind_param_inout(":param",      \$msg->[2], 4000);
-	$sth->execute or return undef;
-	return 1;
+        my $dbh = shift;
+        my $msg = shift;
+        my $sth = $dbh->prepare_cached(q{
+	    begin dbms_msgpipe.acknowledge(:returnpipe, :errormsg, :param); end;}) or return;
+        $sth->bind_param_inout(":returnpipe", \$msg->[0],   30);
+        $sth->bind_param_inout(":proc",       \$msg->[1],   30);
+        $sth->bind_param_inout(":param",      \$msg->[2], 4000);
+        $sth->execute or return undef;
+        return 1;
     }
 
     sub ora_server_version {
-	my $dbh = shift;
-	return $dbh->{ora_server_version} if defined $dbh->{ora_server_version};
-	my $banner = $dbh->selectrow_array(<<'SQL', undef, 'Oracle%', 'Personal Oracle%');
+        my $dbh = shift;
+        return $dbh->{ora_server_version} if defined $dbh->{ora_server_version};
+        my $banner = $dbh->selectrow_array(<<'SQL', undef, 'Oracle%', 'Personal Oracle%');
 SELECT banner
   FROM v$version
   WHERE banner LIKE ? OR banner LIKE ?
 SQL
-	if (defined $banner) {
-	    my @version = $banner =~ /(?:^|\s)(\d+)\.(\d+)\.(\d+)\.(\d+)\.(\d+)(?:\s|$)/;
-	    $dbh->{ora_server_version} = \@version if @version;
-	}
+        if (defined $banner) {
+            my @version = $banner =~ /(?:^|\s)(\d+)\.(\d+)\.(\d+)\.(\d+)\.(\d+)(?:\s|$)/;
+            $dbh->{ora_server_version} = \@version if @version;
+        }
     }
 
     sub ora_nls_parameters {
@@ -2196,6 +2195,16 @@
 by the v$nls_parameters view. The values fetched are cached between calls.
 To cause the latest values to be fetched, pass a true value to the function.
 
+=head1 ORACLE-SPECIFIC DATABASE FUNCTIONS
+
+=head2 B<ora_server_version>
+
+  $versions = $dbh->func('ora_server_version');
+
+Returns an array reference of server version strings e.g.,
+
+  [11,2,0,2,0]
+
 =head1 DATABASE HANDLE METHODS
 
 =head2 B<selectall_arrayref>
@@ -5333,8 +5342,6 @@
 A git mirror of the subversion is also available at
 `https://github.com/yanick/DBD-Oracle`.
 
-=head1 Oracle Related Links
-
 =head1 WHICH VERSION OF DBD::ORACLE IS FOR ME?
 
 From version 1.25 onwards DBD::Oracle only support Oracle clients

Modified: dbd-oracle/trunk/t/39attr.t
==============================================================================
--- dbd-oracle/trunk/t/39attr.t	(original)
+++ dbd-oracle/trunk/t/39attr.t	Wed Oct 31 02:04:53 2012
@@ -33,23 +33,33 @@
     my $dbh = eval { DBI->connect($dsn, $dbuser, '',) }
         or plan skip_all => "Unable to connect to Oracle";
 
+    diag("Oracle version: " . join(".", @{$dbh->func('ora_server_version')}));
+    diag("client version: " . ORA_OCI());
+
   SKIP: {
         my @attrs = (qw(ora_module_name
-                             ora_driver_name
-                             ora_client_info
-                             ora_client_identifier
-                             ora_action));
-        skip('Oracle OCI too old', 1 + @attrs) if ORA_OCI() < 11;
-
-        like($dbh->{ora_driver_name}, qr/DBD/, 'Default driver name');
-        foreach my $attr (qw(ora_module_name
-                             ora_driver_name
-                             ora_client_info
-                             ora_client_identifier
-                             ora_action)) {
+                        ora_client_info
+                        ora_client_identifier
+                        ora_action));
+        my @attrs112 = (qw(ora_driver_name));
+
+        skip('Oracle OCI too old', 1 + @attrs + @attrs112) if ORA_OCI() < 11;
+
+        foreach my $attr (@attrs) {
             $dbh->{$attr} = 'fred';
             is($dbh->{$attr}, 'fred', "attribute $attr set and retrieved");
         }
+
+      SKIP: {
+            skip 'Oracle OCI too old', 1 + @attrs112 if ORA_OCI() < 11.2;
+
+            like($dbh->{ora_driver_name}, qr/DBD/, 'Default driver name');
+
+            foreach my $attr (@attrs) {
+                $dbh->{$attr} = 'fred';
+                is($dbh->{$attr}, 'fred', "attribute $attr set and retrieved");
+            }
+        }
     };
 
     foreach my $attr (qw(ora_oci_success_warn