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);
return $this;
@@ -259,6 +253,7 @@
package DBD::DBM::Statement;
############################
use base qw( DBD::File::Statement );
+use Carp qw(croak);
use IO::File; # for locking only
use Fcntl;
@@ -335,7 +330,7 @@
# could replace this by trying to open the file in non-create mode
# first and dieing if that succeeds.
# Currently this test doesn't work where NDBM is actually Berkeley (.db)
- die "Cannot CREATE '$file$ext' because it already exists"
+ croak "Cannot CREATE '$file$ext' because it already exists"
if $createMode and (-e "$file$ext");
# LOCKING
@@ -388,7 +383,7 @@
if ( $self->{command} ne 'DROP') {
my $tie_class = shift @tie_args;
eval { tie %h, $tie_class, @tie_args };
- die "Cannot tie(%h $tie_class @tie_args): $@" if $@;
+ croak "Cannot tie(%h $tie_class @tie_args): $@" if $@;
}
@@ -644,7 +639,7 @@
DBD::DBM is a database management sytem that can work right out of the box.
If you have a standard installation of Perl and a standard installation of DBI,
you can begin creating, accessing, and modifying database tables without any
further installation. You can also add some other modules to it for more
robust capabilities if you wish.
-The module uses a DBM file storage layer. DBM file storage is common on many
platforms and files can be created with it in many languges. That means that,
in addition to creating files with DBI/SQL, you can also use DBI/SQL to access
and modify files created by other DBM modules and programs. You can also use
those programs to access files created with DBD::DBM.
+The module uses a DBM file storage layer. DBM file storage is common on many
platforms and files can be created with it in many languages. That means that,
in addition to creating files with DBI/SQL, you can also use DBI/SQL to access
and modify files created by other DBM modules and programs. You can also use
those programs to access files created with DBD::DBM.
DBM files are stored in binary format optimized for quick retrieval when using
a key field. That optimization can be used advantageously to make DBD::DBM SQL
operations that use key fields very fast. There are several different
"flavors" of DBM - different storage formats supported by different sorts of
perl modules such as SDBM_File and MLDBM. This module supports all of the
flavors that perl supports and, when used with MLDBM, supports tables with any
number of columns and insertion of Perl objects into tables.
Index: Changes
===================================================================
--- Changes (revision 13919)
+++ Changes (working copy)
@@ -14,6 +14,7 @@
thanks to Vernon Lyon.
Fixed DBI->trace(0, *STDERR); (H.Merijn Brand)
which tried to open a file named "*main::STDERR" in perl-5.10.x
+ Fixed inheritance issue in DBD::DBM::dr::connect (J. Rehsack)
Changed "Issuing rollback() due to DESTROY without explicit disconnect"
warning to not be issued if ReadOnly set for that dbh.
@@ -29,6 +30,8 @@
Added support to DBD::Gofer for Basic HTTP Authentication
and GoferConfigVerbose config setting to Gofer mod_perl
thanks to Stuart Johnston.
+ Added thread id check to DBD::File to avoid resource conflicts (J.
+ Rehsack)
Documentation changes:
Documented specification of type casting behaviour for bind_col()
Index: DBI.pm
===================================================================
--- DBI.pm (revision 13919)
+++ DBI.pm (working copy)
@@ -523,6 +523,7 @@
while ( my ($driver, $drh) = each %DBI::installed_drh) {
no strict 'refs';
next if defined &{"DBD::${driver}::CLONE"};
+# FIXME derived?
warn("$driver has no driver CLONE() function so is unsafe threaded\n");
}
%DBI::installed_drh = (); # clear loaded drivers so they have a chance to
reinitialize
