[svn:dbi] r15604 - in dbi/trunk: . lib/DBI/DBD t

Author: REHSACK
Date: Mon Apr  1 09:10:36 2013
New Revision: 15604

Modified:
   dbi/trunk/Changes
   dbi/trunk/lib/DBI/DBD/SqlEngine.pm
   dbi/trunk/t/48dbi_dbd_sqlengine.t

Log:
Fixed ignoring RootClass attribute during connect() by
  DBI::DBD::SqlEngine reported in RT#84260 by Michael Schout


Modified: dbi/trunk/Changes
==============================================================================
--- dbi/trunk/Changes	(original)
+++ dbi/trunk/Changes	Mon Apr  1 09:10:36 2013
@@ -12,6 +12,8 @@
 
   Fixed heap-use-after-free during global destruction RT#75614
     thanks to Reini Urban.
+  Fixed ignoring RootClass attribute during connect() by
+    DBI::DBD::SqlEngine reported in RT#84260 by Michael Schout
 
 =head2 Changes in DBI 1.624 (svn r15576) 22nd March 2013
 

Modified: dbi/trunk/lib/DBI/DBD/SqlEngine.pm
==============================================================================
--- dbi/trunk/lib/DBI/DBD/SqlEngine.pm	(original)
+++ dbi/trunk/lib/DBI/DBD/SqlEngine.pm	Mon Apr  1 09:10:36 2013
@@ -33,7 +33,7 @@
 use Carp;
 use vars qw( @ISA $VERSION $drh %methods_installed);
 
-$VERSION = "0.05";
+$VERSION = "0.06";
 
 $drh = undef;    # holds driver handle(s) once initialized
 
@@ -143,7 +143,10 @@
         my $two_phased_init;
         defined $dbh->{sql_init_phase} and $two_phased_init = ++$dbh->{sql_init_phase};
         my %second_phase_attrs;
-	my @func_inits;
+        my @func_inits;
+
+        # this must be done to allow DBI.pm reblessing got handle after successful connecting
+        exists $attr->{RootClass} and $second_phase_attrs{RootClass} = delete $attr->{RootClass};
 
         my ( $var, $val );
         while ( length $dbname )
@@ -162,8 +165,10 @@
             {
                 $var = $1;
                 ( $val = $2 ) =~ s/\\(.)/$1/g;
-		exists $attr->{$var} and carp("$var is given in DSN *and* \$attr during DBI->connect()") if($^W);
-		exists $attr->{$var} or $attr->{$var} = $val;
+                exists $attr->{$var}
+                  and carp("$var is given in DSN *and* \$attr during DBI->connect()")
+                  if ($^W);
+                exists $attr->{$var} or $attr->{$var} = $val;
             }
             elsif ( $var =~ m/^(.+?)=>(.*)/s )
             {
@@ -171,55 +176,55 @@
                 ( $val = $2 ) =~ s/\\(.)/$1/g;
                 my $ref = eval $val;
                 # $dbh->$var($ref);
-		push(@func_inits, $var, $ref);
+                push( @func_inits, $var, $ref );
             }
         }
 
-	# The attributes need to be sorted in a specific way as the
-	# assignment is through tied hashes and calls STORE on each
-	# attribute.  Some attributes require to be called prior to
-	# others
-	# e.g. f_dir *must* be done before xx_tables in DBD::File
-	# The dbh attribute sql_init_order is a hash with the order
-	# as key (low is first, 0 .. 100) and the attributes that
-	# are set to that oreder as anon-list as value:
-	# {  0 => [qw( AutoCommit PrintError RaiseError Profile ... )],
-	#   10 => [ list of attr to be dealt with immediately after first ],
-	#   50 => [ all fields that are unspecified or default sort order ],
-	#   90 => [ all fields that are needed after other initialisation ],
-	#   }
-
-	my %order = map {
-	    my $order = $_;
-	    map { ( $_ => $order ) } @{ $dbh->{sql_init_order}{$order} };
-	} sort { $a <=> $b } keys %{ $dbh->{sql_init_order} || {} };
-	my @ordered_attr =
-	  map  { $_->[0] }
-	  sort { $a->[1] <=> $b->[1] }
-	  map  { [ $_, defined $order{$_} ? $order{$_} : 50 ] }
-	  keys %$attr;
-
-	# initialize given attributes ... lower weighted before higher weighted
-	foreach my $a (@ordered_attr)
-	{
-	    exists $attr->{$a} or next;
-	    $two_phased_init and eval {
-		$dbh->{$a} = $attr->{$a};
-		delete $attr->{$a};
-	    };
-	    $@ and $second_phase_attrs{$a} = delete $attr->{$a};
-	    $two_phased_init or $dbh->STORE($a, delete $attr->{$a});
-	}
-
-	$two_phased_init and $dbh->func( 1, "init_default_attributes" );
-	%$attr = %second_phase_attrs;
-
-	for( my $i = 0; $i < scalar(@func_inits); $i += 2 )
-	{
-	    my $func = $func_inits[$i];
-	    my $arg = $func_inits[$i+1];
-	    $dbh->$func($arg);
-	}
+        # The attributes need to be sorted in a specific way as the
+        # assignment is through tied hashes and calls STORE on each
+        # attribute.  Some attributes require to be called prior to
+        # others
+        # e.g. f_dir *must* be done before xx_tables in DBD::File
+        # The dbh attribute sql_init_order is a hash with the order
+        # as key (low is first, 0 .. 100) and the attributes that
+        # are set to that oreder as anon-list as value:
+        # {  0 => [qw( AutoCommit PrintError RaiseError Profile ... )],
+        #   10 => [ list of attr to be dealt with immediately after first ],
+        #   50 => [ all fields that are unspecified or default sort order ],
+        #   90 => [ all fields that are needed after other initialisation ],
+        #   }
+
+        my %order = map {
+            my $order = $_;
+            map { ( $_ => $order ) } @{ $dbh->{sql_init_order}{$order} };
+        } sort { $a <=> $b } keys %{ $dbh->{sql_init_order} || {} };
+        my @ordered_attr =
+          map  { $_->[0] }
+          sort { $a->[1] <=> $b->[1] }
+          map  { [ $_, defined $order{$_} ? $order{$_} : 50 ] }
+          keys %$attr;
+
+        # initialize given attributes ... lower weighted before higher weighted
+        foreach my $a (@ordered_attr)
+        {
+            exists $attr->{$a} or next;
+            $two_phased_init and eval {
+                $dbh->{$a} = $attr->{$a};
+                delete $attr->{$a};
+            };
+            $@ and $second_phase_attrs{$a} = delete $attr->{$a};
+            $two_phased_init or $dbh->STORE( $a, delete $attr->{$a} );
+        }
+
+        $two_phased_init and $dbh->func( 1, "init_default_attributes" );
+        %$attr = %second_phase_attrs;
+
+        for ( my $i = 0; $i < scalar(@func_inits); $i += 2 )
+        {
+            my $func = $func_inits[$i];
+            my $arg  = $func_inits[ $i + 1 ];
+            $dbh->$func($arg);
+        }
 
         $dbh->func("init_done");
 

Modified: dbi/trunk/t/48dbi_dbd_sqlengine.t
==============================================================================
--- dbi/trunk/t/48dbi_dbd_sqlengine.t	(original)
+++ dbi/trunk/t/48dbi_dbd_sqlengine.t	Mon Apr  1 09:10:36 2013
@@ -78,4 +78,14 @@
     cmp_ok( $sql_parser->dialect(), "eq", "ANSI", "SQL::Parser has 'ANSI' as dialect" );
 }
 
+SKIP: {
+    skip( 'not running with DBIx::ContextualFetch' )
+	unless eval { require DBIx::ContextualFetch; 1; };
+
+    my $dbh;
+
+    ok ($dbh = DBI->connect('dbi:File:','','', {RootClass => 'DBIx::ContextualFetch'}));
+    is ref $dbh, 'DBIx::ContextualFetch::db', 'root class is DBIx::ContextualFetch';
+}
+
 done_testing ();

• [svn:dbi] r15604 - in dbi/trunk: . lib/DBI/DBD t by REHSACK