[svn:dbi] r14565 - in dbi/branches/sqlengine/lib: DBD DBI/DBD

[email protected] Mon, 13 Dec 2010 14:54:02 -0800 (PST)
Newsgroups perl.dbi.changes
Message-ID <[email protected]>
Author: REHSACK
Date: Mon Dec 13 14:54:01 2010
New Revision: 14565

Modified:
   dbi/branches/sqlengine/lib/DBD/File.pm
   dbi/branches/sqlengine/lib/DBI/DBD/SqlEngine.pm

Log:
fixing backward compatibility $prefix_tables thanks to Tim Bunce


Modified: dbi/branches/sqlengine/lib/DBD/File.pm
==============================================================================
--- dbi/branches/sqlengine/lib/DBD/File.pm	(original)
+++ dbi/branches/sqlengine/lib/DBD/File.pm	Mon Dec 13 14:54:01 2010
@@ -227,6 +227,7 @@
     if (0 == $phase) {
 	# f_ext should not be initialized
 	# f_map is deprecated (but might return)
+	$dbh->{f_in_gofer} = (defined ($INC{'DBD/Gofer.pm'}) and ((caller(5))[0] eq 'DBI::Gofer::Execute'));
 	$dbh->{f_dir}      = Cwd::abs_path (File::Spec->curdir ());
 	$dbh->{f_meta}     = {};
 	$dbh->{f_meta_map} = {}; # choose new name because it contains other keys
@@ -238,7 +239,7 @@
 	my $ro_attrs = $drv_prefix . "readonly_attrs";
 
 	my @comp_attrs = ();
-	if (exists $dbh->{$drv_prefix . "meta"}) {
+	if (exists $dbh->{$drv_prefix . "meta"} and !$dbh->{f_in_gofer}) {
 	    my $attr = $dbh->{$drv_prefix . "meta"};
 	    defined $attr and defined $dbh->{$valid_attrs} and
 		!defined $dbh->{$valid_attrs}{$attr} and
@@ -269,6 +270,21 @@
     return $_[0]->SUPER::disconnect ();
     } # disconnect
 
+sub validate_FETCH_attr
+{
+    my ( $dbh, $attrib ) = @_;
+
+    if ($dbh->{f_in_gofer}) {
+	(my $drv_class = $dbh->{ImplementorClass}) =~ s/::db$//;
+	my $drv_prefix = DBI->driver_prefix ($drv_class);
+	if (exists $dbh->{$drv_prefix . "meta"} and ($attrib eq $dbh->{$drv_prefix . "meta"})) {
+	    $attrib = 'f_meta';
+	    }
+	}
+
+    return $attrib;
+    }
+
 sub validate_STORE_attr
 {
     my ($dbh, $attrib, $value) = @_;

Modified: dbi/branches/sqlengine/lib/DBI/DBD/SqlEngine.pm
==============================================================================
--- dbi/branches/sqlengine/lib/DBI/DBD/SqlEngine.pm	(original)
+++ dbi/branches/sqlengine/lib/DBI/DBD/SqlEngine.pm	Mon Dec 13 14:54:01 2010
@@ -445,9 +445,10 @@
     $attrib eq "AutoCommit"
       and return 1;
 
+    # Driver private attributes are lower cased
     if ( $attrib eq ( lc $attrib ) )
     {
-        # Driver private attributes are lower cased
+        $attrib = $dbh->func( $attrib, "validate_FETCH_attr" ) or return;
 
         my $attr_prefix;
         $attrib =~ m/^([a-z]+_)/ and $attr_prefix = $1;
@@ -460,8 +461,6 @@
         my $valid_attrs = $attr_prefix . "valid_attrs";
         my $ro_attrs    = $attr_prefix . "readonly_attrs";
 
-        $attrib = $dbh->func( $attrib, "validate_FETCH_attr" ) or return;
-
         exists $dbh->{$valid_attrs}
           and ( $dbh->{$valid_attrs}{$attrib}
                 or return $dbh->set_err( $DBI::stderr, "Invalid attribute '$attrib'" ) );