On 04/23/10 12:02, Jens Rehsack wrote:
Hi,
as proposed last week, here is the first patch for DBD::File and
DBD::DBM (primary: inheritance issue) for more thread safety. I'd like
to have this applied before starting with DBD::DBM refactoring (and I'd
like to have it applied before DBI 1.611 comes out).
Tim, do you have a time schedule for DBI 1.611?
Tux Sno|, I need an entry for the Changelog. One line, clear and consice
please
Attached (and you got 2)
Jens
Index: lib/DBD/File.pm
===
--- lib/DBD/File.pm (revision 13919)
+++ lib/DBD/File.pm (working copy)
@@ -9,7 +9,7 @@
#
# The original author is Jochen Wiedmann.
#
-# Copyright (C) 2009 by H.Merijn Brand Jens Rehsack
+# Copyright (C) 2009,2010 by H.Merijn Brand Jens Rehsack
# Copyright (C) 2004 by Jeff Zucker
# Copyright (C) 1998 by Jochen Wiedmann
#
@@ -123,7 +123,10 @@
package DBD::File::dr;
use strict;
+use Config;
+our $threadid = 0; # holds private thread id of driver
+
$DBD::File::dr::imp_data_size = 0;
sub connect ($$;$$$)
@@ -172,6 +175,7 @@
};
}
$this-STORE (Active = 1);
+$this-STORE (p_threadid = $threadid);
return set_versions ($this);
} # connect
@@ -227,6 +231,13 @@
{
} # disconnect_all
+sub CLONE
+{
+if( $Config{useithreads} $INC{'threads.pm'} ) {
+ $threadid = threads-tid();
+ }
+} # CLONE
+
sub DESTROY
{
undef;
@@ -250,6 +261,11 @@
{
my ($dbh, $statement, @attribs) = @_;
+my $ownerid = $dbh-FETCH('p_threadid');
+unless( $ownerid == $DBD::File::dr::threadid ) {
+ croak database handle is owned by thread $ownerid and this is
$DBD::File::dr::threadid
+ }
+
# create a 'blank' sth
my $sth = DBI::_new_sth ($dbh, {Statement = $statement});
@@ -284,6 +300,7 @@
$sth-STORE (f_stmt, $stmt);
$sth-STORE (f_params, []);
$sth-STORE (NUM_OF_PARAMS, scalar ($stmt-params ()));
+ $sth-STORE (p_threadid, $DBD::File::dr::threadid );
}
}
return $sth;
@@ -340,7 +357,7 @@
if ($attrib eq lc $attrib) {
# Driver private attributes are lower cased
- # I'm not implementing this yet becuase other drivers may be
+ # I'm not implementing this yet because other drivers may be
# setting f_ and sql_ attrs I don't know about
# I'll investigate and publicize warnings to DBD authors
# then implement this
Index: lib/DBD/DBM.pm
===
--- lib/DBD/DBM.pm (revision 13919)
+++ lib/DBD/DBM.pm (working copy)
@@ -68,13 +68,13 @@
my($drh, $dbname, $user, $auth, $attr)= @_;
# create a 'blank' dbh
-my $this = DBI::_new_dbh($drh, {
- Name = $dbname,
-});
+#my $this = DBI::_new_dbh($drh, {
+# Name = $dbname,
+#});
+my $this = $drh-SUPER::connect( $dbname, $user, $auth, $attr );
# parse the connection string for name=value pairs
if ($this) {
-
# define valid private attributes
#
# attempts to set non-valid attrs in connect() or
@@ -85,15 +85,15 @@
# see the STORE methods below for how to check these attrs
#
$this-{dbm_valid_attrs} = {
-dbm_tables= 1 # per-table information
- , dbm_type = 1 # the global DBM type e.g. SDBM_File
- , dbm_mldbm = 1 # the global MLDBM serializer
- , dbm_cols = 1 # the global column names
- , dbm_version = 1 # verbose DBD::DBM version
- , dbm_ext = 1 # file extension
- , dbm_lockfile = 1 # lockfile extension
- , dbm_store_metadata= 1 # column names, etc.
- , dbm_berkeley_flags= 1 # for BerkeleyDB
+dbm_tables= 1, # per-table information
+dbm_type = 1, # the global DBM type e.g. SDBM_File
+dbm_mldbm = 1, # the global MLDBM serializer
+dbm_cols = 1, # the global column names
+dbm_version = 1, # verbose DBD::DBM version
+dbm_ext = 1, # file extension
+dbm_lockfile = 1, # lockfile extension
+dbm_store_metadata= 1, # column names, etc.
+dbm_berkeley_flags= 1, # for BerkeleyDB
};
my($var, $val);
@@ -121,12 +121,6 @@
}
$this-{f_version} = $DBD::File::VERSION;
$this-{dbm_version} = $DBD::DBM::VERSION;
-for (qw( nano_version statement_version)) {
-$this-{'sql_'.$_} = $DBI::SQL::Nano::versions-{$_}||'';
-}
-$this-{sql_handler} = ($this-{sql_statement_version})
- ? 'SQL::Statement'
-: 'DBI::SQL::Nano';
}
$this-STORE('Active',1);