RE: Breaks in mod_perl, works in Perl
Mark Hazen wrote: I am hoping there is a someone brilliant on this list that can help me. A little while ago, I posted to clp.perl asking how I can capture the trace output from DBI into a variable. Since DBI is an external process, I couldn't do it just by piping STDERR. Benjamin Goldberg came up with a module called IO::Capture (see below). It works amazingly well in standard Perl. Here is a sample script: use IO::Capture; $capturer = IO::Capture-new(\*STDERR); Doesn't IO::Scalar do the same? http://perl.apache.org/guide/porting.html#Redirecting_STDOUT_into_a_Scalar IO::Scalar can redirect STDOUT for the mod_perl script itself, but not any external processes like DBI. I am still left without a solution. It amazes me. Mark
Re: Breaks in mod_perl, works in Perl
On Wed, Mar 06, 2002 at 11:02:51AM -0700, Mark Hazen wrote: IO::Scalar can redirect STDOUT for the mod_perl script itself, but not any external processes like DBI. I am still left without a solution. It amazes me. But using DBI isn't an 'external process', is it? It's a part of your process, and hence should make use of whatver you're STDERR handle is. WHy not cop oot, and just redirect STDERR to a file, and collect it's output when youre done? Not graceful, but low-tech... Mark -- Brian 'you Bastard' Reichert[EMAIL PROTECTED] 37 Crystal Ave. #303Daytime number: (603) 434-6842 Derry NH 03038-1713 USA Intel architecture: the left-hand path
RE: Breaks in mod_perl, works in Perl
On Wed, Mar 06, 2002 at 11:02:51AM -0700, Mark Hazen wrote: IO::Scalar can redirect STDOUT for the mod_perl script itself, but not any external processes like DBI. I am still left without a solution. It amazes me. But using DBI isn't an 'external process', is it? It's a part of your process, and hence should make use of whatver you're STDERR handle is. WHy not cop oot, and just redirect STDERR to a file, and collect it's output when youre done? Not graceful, but low-tech... I wish this were true, but no one will ever get IO::Scalar to catch DBI's STDERR output. Throwing all this stuff into a file is already something DBI can do, but as I already said, opening several hundred files per minute will overwhelm my system. Mark
RE: Breaks in mod_perl, works in Perl
Mark Hazen wrote: I wish this were true, but no one will ever get IO::Scalar to catch DBI's STDERR output. If so, it's only because STDERR under mod_perl is already tied. DBI is not an external process. Throwing all this stuff into a file is already something DBI can do, but as I already said, opening several hundred files per minute will overwhelm my system. I don't think it does that. It should open one file per process that has tracing turned on and keep writing to it. I already suggested that you can just turn it on for a single process. That would mean one file being written to by one process, which is very unlikely to overwhelm any system. That's your opinion. In my opinion, a bunch of disk IO and file seeks are a waste of resources. The bigger issue here is that it is better to store in memory, and it saddens me that it doesn't seem possible. Mark
Re: Breaks in mod_perl, works in Perl
On Wed, Mar 06, 2002 at 11:27:28AM -0700, Mark Hazen wrote: Mark Hazen wrote: I wish this were true, but no one will ever get IO::Scalar to catch DBI's STDERR output. If so, it's only because STDERR under mod_perl is already tied. DBI is not an external process. Throwing all this stuff into a file is already something DBI can do, but as I already said, opening several hundred files per minute will overwhelm my system. I don't think it does that. It should open one file per process that has tracing turned on and keep writing to it. I already suggested that you can just turn it on for a single process. That would mean one file being written to by one process, which is very unlikely to overwhelm any system. That's your opinion. In my opinion, a bunch of disk IO and file seeks are a waste of resources. The bigger issue here is that it is better to store in memory, and it saddens me that it doesn't seem possible. This is a design flaw of DBI then. You might get more results if you post on the DBI users list. We got part of the way there by redefining the trace_msg function, the only part that remains is gathering the output of the lower-level DBD calls, that might involve modifying some XS code, (or it might not).. Propose a 'callback' interface on dbi-users, you'll probably get a warm reception. -- Paul Lindner[EMAIL PROTECTED] | | | | | | | | | | mod_perl Developer's Cookbook http://www.modperlcookbook.org/ Human Rights Declaration http://www.unhchr.ch/udhr/index.htm
Re: Breaks in mod_perl, works in Perl
Mark Hazen wrote: Mark Hazen wrote: I wish this were true, but no one will ever get IO::Scalar to catch DBI's STDERR output. If so, it's only because STDERR under mod_perl is already tied. DBI is not an external process. Throwing all this stuff into a file is already something DBI can do, but as I already said, opening several hundred files per minute will overwhelm my system. I don't think it does that. It should open one file per process that has tracing turned on and keep writing to it. I already suggested that you can just turn it on for a single process. That would mean one file being written to by one process, which is very unlikely to overwhelm any system. That's your opinion. In my opinion, a bunch of disk IO and file seeks are a waste of resources. The bigger issue here is that it is better to store in memory, and it saddens me that it doesn't seem possible. Hmm, then create a ramdisk and read from the file virtually stored in the RAM. _ Stas Bekman JAm_pH -- Just Another mod_perl Hacker http://stason.org/ mod_perl Guide http://perl.apache.org/guide mailto:[EMAIL PROTECTED] http://ticketmaster.com http://apacheweek.com http://singlesheaven.com http://perl.apache.org http://perlmonth.com/
Re: Breaks in mod_perl, works in Perl
On Thu, 7 Mar 2002, Stas Bekman wrote:
Mark Hazen wrote:
That's your opinion. In my opinion, a bunch of disk IO and file seeks are a
waste of resources. The bigger issue here is that it is better to store in
memory, and it saddens me that it doesn't seem possible.
Hmm, then create a ramdisk and read from the file virtually stored in
the RAM.
Why should this be necessary? Since writes to disk don't happen
immediatly writing to 'disk' and reading it back in again and then
deleting the file should all happen in cache and not actually hit the hdd
at all (unless of course you run out of memory in which case slamming it
to disk would be no worse than a page hit) correct?
Or am I missing something?
Later.
Mark.
--
s'' Mark Fowler London.pm Bath.pm
http://www.twoshortplanks.com/ [EMAIL PROTECTED]
';use Term'Cap;$t=Tgetent Term'Cap{};print$t-Tputs(cl);for$w(split/ +/
){for(0..30){$|=print$t-Tgoto(cm,$_,$y). $w;select$k,$k,$k,.03}$y+=2}
RE: Breaks in mod_perl, works in Perl
Hmm, then create a ramdisk and read from the file virtually stored in the RAM. Stas, This is an elegant solution that I had not thought of. My problem is that I can't get ramdisks to work on my Red Hat 6.2 with 2.4.9 machine. But that's really my problem, and you've all been a big help. Thanks Mark
RE: Breaks in mod_perl, works in Perl
This is a design flaw of DBI then. You might get more results if you post on the DBI users list. We got part of the way there by redefining the trace_msg function, the only part that remains is gathering the output of the lower-level DBD calls, that might involve modifying some XS code, (or it might not).. Propose a 'callback' interface on dbi-users, you'll probably get a warm reception. I agree. This always was a design flaw of DBI. I was only hoping that there would be another way around it. I took this to the creator of DBI long before posting here and never heard back. I will take it to dbi-users and see where I get. Thanks for all the help you gave. Mark
Re: Breaks in mod_perl, works in Perl
Mark Hazen wrote: Hmm, then create a ramdisk and read from the file virtually stored in the RAM. Stas, This is an elegant solution that I had not thought of. My problem is that I can't get ramdisks to work on my Red Hat 6.2 with 2.4.9 machine. But that's really my problem, and you've all been a big help. Have a look at TMPFS. It creates a RAM-based filesystem that is more flexible than a RAM disk. Add to your /etc/fstab: none /tmpfs tmpfs defaults,noatime,size=200M 0 0 ...or something similar, and away you go!
Breaks in mod_perl, works in Perl
I am hoping there is a someone brilliant on this list that can help me. A
little while ago, I posted to clp.perl asking how I can capture the trace
output from DBI into a variable. Since DBI is an external process, I
couldn't do it just by piping STDERR. Benjamin Goldberg came up with a
module called IO::Capture (see below). It works amazingly well in standard
Perl. Here is a sample script:
use IO::Capture;
$capturer = IO::Capture-new(\*STDERR);
use DBI;
$dbh = DBI-connect (DBI:mysql:test:localhost, username, password, {
RaiseError = 0, PrintError = 0 });
DBI-trace( 1 );
$sth = $dbh-prepare (qq{
CREATE TABLE IF NOT EXISTS test_table
(
a CHAR(15) NOT NULL,
b INT UNSIGNED NOT NULL
)
});
$sth-execute ();
$sth-finish ();
$dbh-disconnect ();
$text = $capturer-capture;
print qq{
Output is:
$text
};
The problem is that once I try this script through mod_perl, it hangs the
child process infinitely. And then on subsequent requests, it has to create
a new process. This eventually results in the whole machine spiraling down
because hundreds of Apache children are hung. What I am hoping is that
someone will spot something that neither Ben nor I have been able to spot.
The module appears after my name.
Thanks for any help you can provide.
Mark
package IO::Capture;
use strict;
use warnings;
use Symbol qw(gensym);
sub new {
(my ($class, $filehandle) = _) == 2
or croak(Usage: IO::Capture-new(\$filehandle));
if( ref $filehandle or ref \$filehandle eq GLOB ) {
$filehandle = \*$filehandle; # this is a sort of typecast.
} else {
$filehandle = caller() . :: . $filehandle
unless $filehandle =~ /::/ or
$filehandle =~ /^STD(?:IN|OUT|ERR)\z/;
no strict 'refs';
$filehandle = \*$filehandle;
}
defined(fileno $filehandle)
or croak(Argument to IO::Capture-new has no fileno());
my $save = gensym;
open $save, .fileno($filehandle)
or die sprintf(Couldn't dup2(%s,%s): $!\n,
fileno($save),fileno($filehandle));
my ($getresponse, $sendresponse) = (gensym, gensym);
pipe($getresponse, $sendresponse) or die pipe: $!;
my ($readnew, $writenew) = (gensym, gensym);
pipe($readnew, $writenew) or die pipe: $!;
open( $filehandle, . fileno($writenew) )
or die sprintf(Couldn't dup2(%s,%s): $!\n,
fileno($filehandle),fileno($writenew));
close($writenew);
defined( my $pid = fork ) or do {
my $err = $!;
unless( open $filehandle, .fileno $save ) {
my $err2 = $!;
open STDERR, $^O =~ /win/i ? con : /dev/tty
if $filehandle == \*STDERR;
die fork: $err, dup2: $err2;
}
die fork: $err;
};
# readnew, writenew, and sendresponse are automatically closed
# when we return here in the parent because they go out of scope,
# resulting in their their refcounts going to 0.
return bless [$filehandle, $save, $getresponse, $pid], $class
if $pid;
close($getresponse); # not used, so close it.
close($writenew); # MUST close this, or deadlock will occur!
# MUST close or re-open $filehandle, or deadlock will occur!
$filehandle == \*STDERR and (
open STDERR, .fileno $save or
open STDERR, $^O =~ /win/i ? con : /dev/tty
) or close $filehandle;
close $save; # not used from here on, so close it.
my ($got, $n) = ;
1 while $n = sysread $readnew, $got, 4096, length $got;
die sysread: $! unless defined $n;
print $sendresponse $got or die print: $!;
exit;
}
sub capture {
my $self = shift;
my ($fh, $saved, $get, $pid) = splice $self, 0;
unless( open $fh, . fileno $saved ) {
open $fh, $^O =~ /win/i ? con : /dev/tty
if $fh == \*STDERR;
die Couldn't restore filehandle: $!;
} else { close $saved }
my ($got, $n) = ;
while($n = sysread $get, $got, 4096, length $got) {}
defined($n) or die sysread: $!;
if( waitpid $pid, 0 ) {
warn sprintf Child exited with code 0x%04X, $? if $?;
} else { warn waitpid: $! } return $got;
}
# like using autouse.pm but even more lightweight.
sub croak {
undef croak;
require Carp;
*croak = \Carp::croak;
goto croak;
}
1;
__END__
perl -MIO::Capture
$x = IO::Capture-new(\*STDERR);
print now capturing\n;
warn qq[captured ok\n];
print captured text 'captured ok' shouldn't have appeard\n;
$y = $x-capture;
print capture didn't block\n;
print $y;
warn Restored ok\n;
__END__
now capturing
captured text 'captured ok' shouldn't have appeard
capture didn't block
captured ok
Restored ok
perl -MIO::Capture
$x = IO::Capture-new(\*STDERR);
print now capturing\n;
system(q[perl -e print STDERR qq[captured ok\n]]);
print captured text 'captured ok' shouldn't have appeard\n;
$y = $x-capture;
print capture didn't block\n;
print $y;
warn Restored ok\n;
__END__
now capturing
captured text 'captured ok' shouldn't have appeard
capture didn't block
captured ok
Restored ok
Re: Breaks in mod_perl, works in Perl
At 1:14 PM -0700 3/5/02, Mark Hazen wrote:
I am hoping there is a someone brilliant on this list that can help me A
little while ago, I posted to clpperl asking how I can capture the trace
output from DBI into a variable Since DBI is an external process, I
couldn't do it just by piping STDERR Benjamin Goldberg came up with a
module called IO::Capture (see below) It works amazingly well in standard
Perl Here is a sample script:
Maybe I'm just crazy but wouldn't this be simpler?
use DBI;
$dbh = DBI-connect (DBI:mysql:test:localhost, username, password, {
RaiseError = 0, PrintError = 0 });
$filename = /tmp/dbi_$$time()rand(1)trace;
DBI-trace( 1, $filename );
$sth = $dbh-prepare (qq{
CREATE TABLE IF NOT EXISTS test_table
(
a CHAR(15) NOT NULL,
b INT UNSIGNED NOT NULL
)
});
$sth-execute ();
$sth-finish ();
$dbh-disconnect ();
print qq{
Output is:
};
open(FILE,$filename);
print while(FILE);
close(FILE);
The problem with the module listed is that it does some filehandle
munging on what is already a munged filehandler Meaning, it looks
like a filehandle, but it's really just a hook into something apache
is going to use to output stuff to the error log
Hope that helps
Rob
--
When I used a Mac, they laughed because I had no command prompt When
I used Linux, they laughed because I had no GUI
RE: Breaks in mod_perl, works in Perl
I'm sorry I didn't explain an important component. Since I am dealing with
a few hundred requests per minute (this was got me onto mod_perl to begin
with), then using DBI's ability to write to a file would vastly overwhelm my
system.
Thanks
Mark
-Original Message-
From: Robert Landrum [mailto:[EMAIL PROTECTED]]
Sent: Tuesday, March 05, 2002 1:25 PM
To: Mark Hazen; [EMAIL PROTECTED]
Subject: Re: Breaks in mod_perl, works in Perl
At 1:14 PM -0700 3/5/02, Mark Hazen wrote:
I am hoping there is a someone brilliant on this list that can help me. A
little while ago, I posted to clp.perl asking how I can capture the trace
output from DBI into a variable. Since DBI is an external process, I
couldn't do it just by piping STDERR. Benjamin Goldberg came up with a
module called IO::Capture (see below). It works amazingly well in standard
Perl. Here is a sample script:
Maybe I'm just crazy but wouldn't this be simpler?
use DBI;
$dbh = DBI-connect (DBI:mysql:test:localhost, username, password, {
RaiseError = 0, PrintError = 0 });
$filename = /tmp/dbi_.$$.time().rand(1)..trace;
DBI-trace( 1, $filename );
$sth = $dbh-prepare (qq{
CREATE TABLE IF NOT EXISTS test_table
(
a CHAR(15) NOT NULL,
b INT UNSIGNED NOT NULL
)
});
$sth-execute ();
$sth-finish ();
$dbh-disconnect ();
print qq{
Output is:
};
open(FILE,$filename);
print while(FILE);
close(FILE);
The problem with the module listed is that it does some filehandle
munging on what is already a munged filehandler. Meaning, it looks
like a filehandle, but it's really just a hook into something apache
is going to use to output stuff to the error log.
Hope that helps...
Rob
--
When I used a Mac, they laughed because I had no command prompt. When
I used Linux, they laughed because I had no GUI.
Re: Breaks in mod_perl, works in Perl
I'm not sure if this will work, but you might override DBI's notion of
a trace function. If you look in DBI.pm you'll see this line:
*trace_msg = \DBD::_::common::trace_msg;
It appears that DBI uses the trace_msg function in the bowels of DBD
to actually do the printing. Now, you can very likely override this
with something else.. Perhaps something like this:
use DBI;
.
my $output;
my $oldhandle;
sub capture {
$output .= join('', @_);
}
*DBI::trace_msg = \capture;
$dbh = .
# etc...
In an ideal world you could just subclass DBI and redefine the trace
message, alas DBI uses this construct quite often:
DBI-trace_msg(...)
On Tue, Mar 05, 2002 at 01:14:11PM -0700, Mark Hazen wrote:
I am hoping there is a someone brilliant on this list that can help me. A
little while ago, I posted to clp.perl asking how I can capture the trace
output from DBI into a variable. Since DBI is an external process, I
couldn't do it just by piping STDERR. Benjamin Goldberg came up with a
module called IO::Capture (see below). It works amazingly well in standard
Perl. Here is a sample script:
use IO::Capture;
$capturer = IO::Capture-new(\*STDERR);
use DBI;
$dbh = DBI-connect (DBI:mysql:test:localhost, username, password, {
RaiseError = 0, PrintError = 0 });
DBI-trace( 1 );
$sth = $dbh-prepare (qq{
CREATE TABLE IF NOT EXISTS test_table
(
a CHAR(15) NOT NULL,
b INT UNSIGNED NOT NULL
)
});
$sth-execute ();
$sth-finish ();
$dbh-disconnect ();
$text = $capturer-capture;
print qq{
Output is:
$text
};
The problem is that once I try this script through mod_perl, it hangs the
child process infinitely. And then on subsequent requests, it has to create
a new process. This eventually results in the whole machine spiraling down
because hundreds of Apache children are hung. What I am hoping is that
someone will spot something that neither Ben nor I have been able to spot.
The module appears after my name.
Thanks for any help you can provide.
Mark
package IO::Capture;
use strict;
use warnings;
use Symbol qw(gensym);
sub new {
(my ($class, $filehandle) = @_) == 2
or croak(Usage: IO::Capture-new(\$filehandle));
if( ref $filehandle or ref \$filehandle eq GLOB ) {
$filehandle = \*$filehandle; # this is a sort of typecast.
} else {
$filehandle = caller() . :: . $filehandle
unless $filehandle =~ /::/ or
$filehandle =~ /^STD(?:IN|OUT|ERR)\z/;
no strict 'refs';
$filehandle = \*$filehandle;
}
defined(fileno $filehandle)
or croak(Argument to IO::Capture-new has no fileno());
my $save = gensym;
open $save, .fileno($filehandle)
or die sprintf(Couldn't dup2(%s,%s): $!\n,
fileno($save),fileno($filehandle));
my ($getresponse, $sendresponse) = (gensym, gensym);
pipe($getresponse, $sendresponse) or die pipe: $!;
my ($readnew, $writenew) = (gensym, gensym);
pipe($readnew, $writenew) or die pipe: $!;
open( $filehandle, . fileno($writenew) )
or die sprintf(Couldn't dup2(%s,%s): $!\n,
fileno($filehandle),fileno($writenew));
close($writenew);
defined( my $pid = fork ) or do {
my $err = $!;
unless( open $filehandle, .fileno $save ) {
my $err2 = $!;
open STDERR, $^O =~ /win/i ? con : /dev/tty
if $filehandle == \*STDERR;
die fork: $err, dup2: $err2;
}
die fork: $err;
};
# readnew, writenew, and sendresponse are automatically closed
# when we return here in the parent because they go out of scope,
# resulting in their their refcounts going to 0.
return bless [$filehandle, $save, $getresponse, $pid], $class
if $pid;
close($getresponse); # not used, so close it.
close($writenew); # MUST close this, or deadlock will occur!
# MUST close or re-open $filehandle, or deadlock will occur!
$filehandle == \*STDERR and (
open STDERR, .fileno $save or
open STDERR, $^O =~ /win/i ? con : /dev/tty
) or close $filehandle;
close $save; # not used from here on, so close it.
my ($got, $n) = ;
1 while $n = sysread $readnew, $got, 4096, length $got;
die sysread: $! unless defined $n;
print $sendresponse $got or die print: $!;
exit;
}
sub capture {
my $self = shift;
my ($fh, $saved, $get, $pid) = splice @$self, 0;
unless( open $fh, . fileno $saved ) {
open $fh, $^O =~ /win/i ? con : /dev/tty
if $fh == \*STDERR;
die Couldn't restore filehandle: $!;
} else { close $saved }
my ($got, $n) = ;
while($n = sysread $get, $got, 4096, length $got) {}
defined($n) or die sysread: $!;
if( waitpid $pid, 0 ) {
warn sprintf Child exited with code 0x%04X, $? if $?;
} else { warn waitpid: $! } return $got;
}
# like using autouse.pm but even more lightweight.
sub croak {
undef croak;
require Carp;
Re: Breaks in mod_perl, works in Perl
Mark Hazen wrote: I'm sorry I didn't explain an important component Since I am dealing with a few hundred requests per minute (this was got me onto mod_perl to begin with), then using DBI's ability to write to a file would vastly overwhelm my system Won't capturing that much data in RAM instantly send your system into swap? Anyway, you can probably get this to work if you can ask DBI to send to a filehandle and then use your magic IO::Capture on that filehandle You just can't use STDERR because it's already magic By the way, at one point we used this DBI trace stuff at eToys It was fairly light on a fast file system like ext2fs The trick to making it really light is to fix it so that only one child process per machine had tracing turned on, which you can do with a little fussing with a pid file and a ChildInitHandler and ChildExitHandler If you just need to see some trace output, you can use this technique On the other hand, your debugging may require seeing trace from every active process in which case this won't help - Perrin
RE: Breaks in mod_perl, works in Perl
At 1:32 PM -0700 3/5/02, Mark Hazen wrote: I'm sorry I didn't explain an important component Since I am dealing with a few hundred requests per minute (this was got me onto mod_perl to begin with), then using DBI's ability to write to a file would vastly overwhelm my system I don't get it You don't mind trying to create tables a few hundred times per minute, but creating a file is too much overhead? And writing to memory is going to really bog the system Maybe you shouldn't be asking why doesn't my capture work, but how can I debug some production code I have Just a thought, Rob -- When I used a Mac, they laughed because I had no command prompt When I used Linux, they laughed because I had no GUI
RE: Breaks in mod_perl, works in Perl
I am sorry for further confusion. I am not creating tables a few hundred times per minute. I simply used a create table call to get some trace output for my sample script. Thinking that users may try the sample script, there was a no way for me to know what tables might exist (that I could select from). So I used a CREATE TABLE. Writing to memory, if done right, shouldn't be a big deal. Having the disk seek that often would flood my IO. Thanks Mark -Original Message- From: Robert Landrum [mailto:[EMAIL PROTECTED]] Sent: Tuesday, March 05, 2002 2:14 PM To: Mark Hazen; [EMAIL PROTECTED] Subject: RE: Breaks in mod_perl, works in Perl At 1:32 PM -0700 3/5/02, Mark Hazen wrote: I'm sorry I didn't explain an important component. Since I am dealing with a few hundred requests per minute (this was got me onto mod_perl to begin with), then using DBI's ability to write to a file would vastly overwhelm my system. I don't get it You don't mind trying to create tables a few hundred times per minute, but creating a file is too much overhead? And writing to memory is going to really bog the system. Maybe you shouldn't be asking why doesn't my capture work, but how can I debug some production code I have... Just a thought, Rob -- When I used a Mac, they laughed because I had no command prompt. When I used Linux, they laughed because I had no GUI.
RE: Breaks in mod_perl, works in Perl
Paul,
You are onto something here. I used your method, and was able to get the
following:
DBI - DBI-Apache::DBI::connect(DBI:mysql:db:localhost, username, ) DBI
- connect= Apache::DBI::db=HASH(0x842d608)
into the variable. But the full trace output is:
- DBI-Apache::DBI::connect(DBI:mysql:db:localhost, username, )
- FETCH= 'mysql' ('Name' from cache) at DBI.pm line 64
- ping= 1 at DBI.pm line 112
- STORE('RaiseError' 0 ...)= 1 at DBI.pm line 451
- STORE('PrintError' 0 ...)= 1 at DBI.pm line 451
- STORE('AutoCommit' 1 ...)= 1 at DBI.pm line 451
It also would disappear between requests. In other words, as I reloaded the
script, about half the time, the variable would be completely blank, and
another half it would be what I mentioned above.
Thanks
Mark
-Original Message-
From: Paul Lindner [mailto:[EMAIL PROTECTED]]
Sent: Tuesday, March 05, 2002 1:41 PM
To: Mark Hazen
Cc: [EMAIL PROTECTED]
Subject: Re: Breaks in mod_perl, works in Perl
I'm not sure if this will work, but you might override DBI's notion of
a trace function. If you look in DBI.pm you'll see this line:
*trace_msg = \DBD::_::common::trace_msg;
It appears that DBI uses the trace_msg function in the bowels of DBD
to actually do the printing. Now, you can very likely override this
with something else.. Perhaps something like this:
use DBI;
.
my $output;
my $oldhandle;
sub capture {
$output .= join('', @_);
}
*DBI::trace_msg = \capture;
$dbh = .
# etc...
In an ideal world you could just subclass DBI and redefine the trace
message, alas DBI uses this construct quite often:
DBI-trace_msg(...)
On Tue, Mar 05, 2002 at 01:14:11PM -0700, Mark Hazen wrote:
I am hoping there is a someone brilliant on this list that can help me. A
little while ago, I posted to clp.perl asking how I can capture the trace
output from DBI into a variable. Since DBI is an external process, I
couldn't do it just by piping STDERR. Benjamin Goldberg came up with a
module called IO::Capture (see below). It works amazingly well in
standard
Perl. Here is a sample script:
use IO::Capture;
$capturer = IO::Capture-new(\*STDERR);
use DBI;
$dbh = DBI-connect (DBI:mysql:test:localhost, username, password, {
RaiseError = 0, PrintError = 0 });
DBI-trace( 1 );
$sth = $dbh-prepare (qq{
CREATE TABLE IF NOT EXISTS test_table
(
a CHAR(15) NOT NULL,
b INT UNSIGNED NOT NULL
)
});
$sth-execute ();
$sth-finish ();
$dbh-disconnect ();
$text = $capturer-capture;
print qq{
Output is:
$text
};
The problem is that once I try this script through mod_perl, it hangs the
child process infinitely. And then on subsequent requests, it has to
create
a new process. This eventually results in the whole machine spiraling
down
because hundreds of Apache children are hung. What I am hoping is that
someone will spot something that neither Ben nor I have been able to spot.
The module appears after my name.
Thanks for any help you can provide.
Mark
package IO::Capture;
use strict;
use warnings;
use Symbol qw(gensym);
sub new {
(my ($class, $filehandle) = @_) == 2
or croak(Usage: IO::Capture-new(\$filehandle));
if( ref $filehandle or ref \$filehandle eq GLOB ) {
$filehandle = \*$filehandle; # this is a sort of typecast.
} else {
$filehandle = caller() . :: . $filehandle
unless $filehandle =~ /::/ or
$filehandle =~ /^STD(?:IN|OUT|ERR)\z/;
no strict 'refs';
$filehandle = \*$filehandle;
}
defined(fileno $filehandle)
or croak(Argument to IO::Capture-new has no fileno());
my $save = gensym;
open $save, .fileno($filehandle)
or die sprintf(Couldn't dup2(%s,%s): $!\n,
fileno($save),fileno($filehandle));
my ($getresponse, $sendresponse) = (gensym, gensym);
pipe($getresponse, $sendresponse) or die pipe: $!;
my ($readnew, $writenew) = (gensym, gensym);
pipe($readnew, $writenew) or die pipe: $!;
open( $filehandle, . fileno($writenew) )
or die sprintf(Couldn't dup2(%s,%s): $!\n,
fileno($filehandle),fileno($writenew));
close($writenew);
defined( my $pid = fork ) or do {
my $err = $!;
unless( open $filehandle, .fileno $save ) {
my $err2 = $!;
open STDERR, $^O =~ /win/i ? con : /dev/tty
if $filehandle == \*STDERR;
die fork: $err, dup2: $err2;
}
die fork: $err;
};
# readnew, writenew, and sendresponse are automatically closed
# when we return here in the parent because they go out of scope,
# resulting in their their refcounts going to 0.
return bless [$filehandle, $save, $getresponse, $pid], $class
if $pid;
close($getresponse); # not used, so close it.
close($writenew); # MUST close this, or deadlock will occur!
# MUST close or re-open $filehandle, or deadlock will occur!
$filehandle == \*STDERR and (
open
Re: Breaks in mod_perl, works in Perl
Mark Hazen wrote: I am hoping there is a someone brilliant on this list that can help me. A little while ago, I posted to clp.perl asking how I can capture the trace output from DBI into a variable. Since DBI is an external process, I couldn't do it just by piping STDERR. Benjamin Goldberg came up with a module called IO::Capture (see below). It works amazingly well in standard Perl. Here is a sample script: use IO::Capture; $capturer = IO::Capture-new(\*STDERR); Doesn't IO::Scalar do the same? http://perl.apache.org/guide/porting.html#Redirecting_STDOUT_into_a_Scalar _ Stas Bekman JAm_pH -- Just Another mod_perl Hacker http://stason.org/ mod_perl Guide http://perl.apache.org/guide mailto:[EMAIL PROTECTED] http://ticketmaster.com http://apacheweek.com http://singlesheaven.com http://perl.apache.org http://perlmonth.com/
