Ima::DBI patch for mod_perl compatibility

[prev] [thread] [next] [Date index for 2005/06/09]

--=-0Q+iUBOU1zKcFP80wnfG
Content-Type: text/plain
Content-Transfer-Encoding: 7bit

Attached is a patch I'm using for Ima::DBI which makes all the stuff on
the wiki's mod_perl page unnecessary.  This is for mod_perl 1, but I can
expand it to mod_perl 2 (or someone else can) if it seems likely this
patch will get incorporated into Ima::DBI.  The other option would be to
change this into Class::DBI::Plugin::ModPerl, but since pretty much
everyone running mod_perl should be using some variation of this code
(e.g. the stuff on the wiki), I'm not sure it's wise to make it a
separate download.

Features:
- No performance impact on people not using mod_perl.
- Prevents handles opened during startup (by set_up_table)from being
used after forking.
- Makes sure Apache::DBI::connect or DBI's connect_cached gets called
once per request to ping the handle and reconnect if necessary.
- Cache verified handle in pnotes() for quick retrieval during the
course of a request.  (Caching it in a closure variable before prevented
the ping from happening on each request.)
- Prevents warnings about disconnected handles during startup when using
Apache::DBI and set_up_table() calls.

What do you think, Tony?  Is this something you could include in
Ima::DBI, or do you want me to package it separately?

- Perrin

--=-0Q+iUBOU1zKcFP80wnfG
Content-Disposition: attachment; filename=ima_dbi.patch
Content-Type: text/x-patch; name=ima_dbi.patch; charset=utf-8
Content-Transfer-Encoding: 7bit

--- /home/perrin/DBI.pm	2005-06-09 14:48:58.000000000 -0400
+++ ./lib/Ima/DBI.pm	2005-06-08 13:18:45.000000000 -0400
@@ -254,13 +254,25 @@
 
 %attr is combined with a set of defaults (RaiseError => 1, AutoCommit
 => 0, PrintError => 0, Taint => 1).  This is a better default IMHO,
-however it does give databases without transactions (such as MySQL) a
-hard time.  Be sure to turn AutoCommit back on if your database does
-not support transactions.
+however it does give databases without transactions (such as MySQL when
+used with the default MyISAM table type) a hard time.  Be sure to turn 
+AutoCommit back on if your database does not support transactions.
 
 The actual database handle creation (and thus the database connection)
 is held off until a prepare is attempted with this handle.
 
+When used under mod_perl, there is some special behavior to prevent 
+common problems.  If you open connections before the server has forked, 
+the connection method caches them separately and stops using them after 
+the fork.  It also calls for a handle at the beginning of every request, 
+so that it won't interfere with the automatic rollback behavior of 
+Apache::DBI.  Handles are kept in C<$r->pnotes()> for the length of the 
+request for some extra speed.
+
+Handles opened during startup will not be used after forking, but if you 
+want to make sure they are closed immediately you can add a line at the 
+end of your startup.pl to request the handle and call C<disconnect()> on it.
+
 =cut
 
 sub _croak { my $self = shift; require Carp; Carp::croak(@_) }
@@ -311,13 +323,44 @@
 
 sub _mk_db_closure {
 	my ($class, @connection) = @_;
-	my $dbh;
-	return sub {
-		unless ($dbh && $dbh->FETCH('Active') && $dbh->ping) {
-			$dbh = DBI->connect_cached(@connection);
-		}
-		return $dbh;
-	};
+	if ($ENV{MOD_PERL}) {
+		
+		my $dbh_id = $class->_dbh_id(@connection);
+		my $prefork_dbh;
+		return sub {
+			# handle special case for starting up first
+			if ($Apache::ServerStarting) {
+				if (!$prefork_dbh) {
+					$prefork_dbh = DBI->connect_cached(@connection);
+				}
+				return $prefork_dbh;
+			}
+
+			# cache in pnotes for extra speed
+			my $dbh = Apache->request()->pnotes($dbh_id);
+			if (!$dbh) {
+				$dbh = DBI->connect_cached(@connection);
+				Apache->request()->pnotes($dbh_id, $dbh);
+			}
+			return $dbh;
+		};
+	
+    } else {
+		
+		my $dbh;
+		return sub {
+			unless ($dbh && $dbh->FETCH('Active') && $dbh->ping) {
+				$dbh = DBI->connect_cached(@connection);
+			}
+			return $dbh;
+		};
+		
+	}
+}
+
+sub _dbh_id {
+	my ($class, @connection) = @_;
+	return join($;, sort @connection);
 }
 
 =pod

--=-0Q+iUBOU1zKcFP80wnfG--