Re: strange bug with DBI, Sybase, and mod_perl

[Jonathan Swartz]

Ok, take sendmail out of the equation. The bug will occur iff the  
program sends output to STDOUT (which sendmail was doing because of a  
warning).

Here's a slightly simplified version.

   our ($dbh1, $dbh2);

   sub dbconnect {
       return DBI->connect( 'DBI:Sybase:...', '...', '...',  
{ RaiseError => 1 } );
   }

   sub testdb {
       my ( $name, $dbh ) = @_;
       eval { $dbh->do("select 1") };
       print "$name - " . ($@ ? "error: $@" : "ok") . "\n";
   }

   sub handler {
       my ($r) = @_;

       # connect.pl contains one line: BEGIN { $Handler::dbh1 =  
Handler::dbconnect() }
       do "/home/jswartz/projects/unchained-transaction/connect.pl";
       $dbh2 = dbconnect();
       system(qq{perl -e 'print "hi"'});
       testdb("dbh1", $dbh1);
       testdb("dbh2", $dbh2);

       return 0;
   }

This outputs

   dbh1 - ok
   dbh2 - error: DBD::Sybase::db do failed: OpenClient message: LAYER  
= (5) ORIGIN = (3) SEVERITY = (5) NUMBER = (6)
   Server SANDBOX5, database
   Message String: ct_results(): network packet layer: internal net  
library error: Net-Library operation terminated due to disco\
   nnect
   OpenClient message: LAYER = (1) ORIGIN = (1) SEVERITY = (1) NUMBER  
= (50)
   Server SANDBOX5, database
   Message String: ct_cmd_drop(): user api layer: external error: The  
connection has been marked dead.

However, if I replace the system with

   system(qq{perl -e ''});
or
  system(qq{perl -e 'print "hi"' > /dev/null});

then it outputs

  dbh1 - ok
  dbh2 - ok

On Jan 7, 2010, at 2:20 AM, Tim Bunce wrote:

On Wed, Jan 06, 2010 at 04:08:17PM -0800, Jonathan Swartz wrote:
Thanks for your help...this bug has me feeling very isolated...

Just about everything here is necessary to generate the bug. In
particular, I cannot generate the bug...
* If I move the code from connect.pl into the handler, even as a
string eval
* If I remove the "BEGIN" from connect.pl
* If I replace sendmail with another program

That's the most interesting one to me. Try replacing it with a perl
script that reports what open file descriptors have been inherited.

Ok. What's the easiest way to do that? :) Sorry, probably dumb
question, but never did this before and scanning perlipc and
perlopentut and google didn't yield anything obvious.

I had to rummage around a bit, but this seems to work:

   $ perl -e 'open(FH, ">&=$_") and printf "$_\n" for 0..100'
   0
   1
   2

   $ perl -e 'open(FH, ">&=$_") and printf "$_\n" for 0..100' 42<&1
   0
   1
   2
   42

(Using >&= or <&= doesn't seem to matter for this simple case.)

Tim.