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

[REH...@cvs.perl.org]

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 ();