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

Author: hmbrand
Date: Thu Dec 13 05:57:18 2012
New Revision: 15511

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

Log:
Fixed RT#81516 - Test failures due to hash randomisation in perl 5.17.6

Modified: dbi/branches/sqlengine/Changes
==============================================================================
--- dbi/branches/sqlengine/Changes	(original)
+++ dbi/branches/sqlengine/Changes	Thu Dec 13 05:57:18 2012
@@ -8,11 +8,13 @@
 
 =cut
 
-=head2 Changes in DBI 1.623 (svn r15467) 19th Nov 2012
+=head2 Changes in DBI 1.623 (svn r15467) 13th Dec 2012
 
   Fixed RT#64330 - ping wipes out errstr (Martin J. Evans).
-  Fixed RT#80474 - segfault in DESTROY with threads.
   Fixed RT#75868 - DBD::Proxy shouldn't call connected() on the server.
+  Fixed RT#80474 - segfault in DESTROY with threads.
+  Fixed RT#81516 - Test failures due to hash randomisation in perl 5.17.6
+    thanks to Jens Rehsack and H.Merijn Brand and feedback on IRC
   Fixed unused variable / self-assignment compiler warnings.
   Corrected typo in DBI->installed_versions docs RT#78825
     thanks to Jan Dubois.

Modified: dbi/branches/sqlengine/lib/DBD/File.pm
==============================================================================
--- dbi/branches/sqlengine/lib/DBD/File.pm	(original)
+++ dbi/branches/sqlengine/lib/DBD/File.pm	Thu Dec 13 05:57:18 2012
@@ -186,6 +186,8 @@
 	# f_map is deprecated (but might return)
 	$dbh->{f_dir}      = Cwd::abs_path (File::Spec->curdir ());
 
+	push @{$dbh->{sql_init_order}{90}}, "f_meta";
+
 	if(0) { # XXX remove block
 	# complete derived attributes, if required
 	(my $drv_class = $dbh->{ImplementorClass}) =~ s/::db$//;

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	Thu Dec 13 05:57:18 2012
@@ -179,8 +179,32 @@
 
         if ($two_phased_init)
         {
-            foreach $a (qw(Profile RaiseError PrintError AutoCommit))
-            {    # do these first
+            # 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;
                 eval {
                     $dbh->{$a} = $attr->{$a};
@@ -188,11 +212,6 @@
                 };
                 $@ and $second_phase_attrs{$a} = delete $attr->{$a};
             }
-            while ( my ( $a, $v ) = each %$attr )
-            {
-                eval { $dbh->{$a} = $v };
-                $@ and $second_phase_attrs{$a} = $v;
-            }
 
             $dbh->func( 1, "init_default_attributes" );
             %$attr = %second_phase_attrs;
@@ -413,7 +432,24 @@
         $dbh->{sql_meta}     = {};
         $dbh->{sql_meta_map} = {};    # choose new name because it contains other keys
 
-        my @comp_attrs = qw(valid_attrs version readonly_attrs);
+        # init_default_attributes calls inherited routine before derived DBD's
+	# init their default attributes, so we don't override something here
+	#
+	# defining an order of attribute initialization from connect time
+	# specified ones with a magic baarier (see next statement)
+	my $drv_pfx_meta = $drv_prefix . "meta";
+	$dbh->{sql_init_order} = {
+	     0 => [qw( Profile RaiseError PrintError AutoCommit )],
+	    90 => [ "sql_meta", $dbh->{$drv_pfx_meta} ? $dbh->{$drv_pfx_meta} : ()],
+	    };
+	# ensuring Profile, RaiseError, PrintError, AutoCommit are initialized
+	# first when initializing attributes from connect time specified
+	# attributes
+	# further, initializations to predefined tables are happens after any
+	# unspecified attribute initialization (that default to order 50)
+
+	my @comp_attrs = qw(valid_attrs version readonly_attrs);
+
         if ( exists $dbh->{ $drv_prefix . "meta" } and !$dbh->{sql_engine_in_gofer} )
         {
             my $attr = $dbh->{ $drv_prefix . "meta" };