Adam Prime wrote:
> Fred Moyer wrote:
>> On Tue, Jul 21, 2009 at 8:39 PM, Adam Prime<adam.pr...@utoronto.ca> wrote:
>>> Adam Prime wrote:
>>>> What I wanted to do was fix this issue:
>>>>
>>>> http://rt.cpan.org/Public/Bug/Display.html?id=36346
>> I was just looking over your original code where you connect() in
>> startup.pl. Won't that cause issues since the database handle will be
>> forked also? Here's what I have in my startup.pl:
>
> The code in the ticket was just to illustrate the failure. I ran into
> this problem because I wanted to preload a large read-only datastructure
> out of the database prior to the fork to get it completely shared
> between all the children. The handle itself is then disconnected and
> discarded.
>
> Adam
>
The patch attached ads code to bail out of connect() calls called prior
to the fork by setting a package global during the ChildInit phase,
along with the other patch which was submitted to the users mailing list.
It works fine for me in extremely limited testing.
Thoughts?
Adam
Index: lib/Apache/DBI.pm
===================================================================
--- lib/Apache/DBI.pm (revision 796605)
+++ lib/Apache/DBI.pm (working copy)
@@ -39,6 +39,9 @@
# a negative value de-activates ping,
# default = 0
my %LastPingTime; # keeps track of last ping per data_source
+my $ChildExitHandlerInstalled; # set to true on installation of
+ # PerlChildExitHandler
+my $InChild;
# Check to see if we need to reset TaintIn and TaintOut
my $TaintInOut = ($DBI::VERSION >= 1.31) ? 1 : 0;
@@ -121,8 +124,7 @@
# unpredictable query results.
# See:
http://perl.apache.org/docs/2.0/user/porting/compat.html#C__Apache__Server__Starting__and_C__Apache__Server__ReStarting_
if (MP2) {
- require Apache2::ServerUtil;
- if (Apache2::ServerUtil::restart_count() == 1) {
+ if (!$InChild) {
debug(2, "$prefix skipping connection during server startup, read
the docu !!");
return $drh->connect(@args);
}
@@ -134,6 +136,23 @@
}
}
+ # this PerlChildExitHandler is supposed to disconnect all open
+ # connections to the database
+ if (!$ChildExitHandlerInstalled) {
+ $ChildExitHandlerInstalled = 1;
+ my $s;
+ if (MP2) {
+ $s = Apache2::ServerUtil->server;
+ }
+ elsif (Apache->can('push_handlers')) {
+ $s = 'Apache';
+ }
+ if ($s) {
+ debug(2, "$prefix push PerlChildExitHandler");
+ $s->push_handlers(PerlChildExitHandler => \&childexit);
+ }
+ }
+
# this PerlCleanupHandler is supposed to initiate a rollback after the
# script has finished if AutoCommit is off. however, cleanup can only
# be determined at end of handle life as begin_work may have been called
@@ -203,6 +222,7 @@
my $prefix = "$$ Apache::DBI ";
debug(2, "$prefix PerlChildInitHandler");
+ $InChild = 1;
%Connected = () if MP2;
if (@ChildConnect) {
@@ -216,6 +236,22 @@
1;
}
+# The PerlChildExitHandler disconnects all open connections
+sub childexit {
+
+ my $prefix = "$$ Apache::DBI ";
+ debug(2, "$prefix PerlChildExitHandler");
+
+ foreach my $dbh (values(%Connected)) {
+ eval { DBI::db::disconnect($dbh) };
+ if ($@) {
+ debug(2, "$prefix DBI::db::disconnect failed - $@");
+ }
+ }
+
+ 1;
+}
+
# The PerlCleanupHandler is supposed to initiate a rollback after the script
# has finished if AutoCommit is off.
# Note: the PerlCleanupHandler runs after the response has been sent to
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscr...@perl.apache.org
For additional commands, e-mail: dev-h...@perl.apache.org
