Hello,list,
I've wrote a simple package which do some socket query.The package is working
well at most time,but when I use it with mysql DBH in my main script,it'll get
the mysql connection drop.
Here is my fullhead.pm:
----
package fullhead;
use strict;
use warnings;
use IO::Socket qw(:DEFAULT :crlf);
use MIME::Base64 qw(decode_base64 encode_base64);
use Encode;
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK);
@ISA = qw(Exporter);
@EXPORT = qw(fullhead);
@EXPORT_OK = ();
sub fullhead
{
.... # some codes do the socket query using the query_ud() function below
}
sub query_ud
{
my $host=shift;
my $mbox_id=shift;
my $ref=shift;
my %msgid=%$ref;
my $port=PORT;
my $sock=IO::Socket::INET->new(PeerAddr => $host,
PeerPort => $port,
Proto => 'tcp');
my $child=fork();
die "can't fork $!" unless defined $child;
if ($child)
{
local $SIG{CHLD}=sub {return};
foreach my $msgid (keys %msgid)
{
print $sock "_getmsgxxx $mbox_id $msgid",CRLF;
}
$sock->shutdown(1);
sleep;
}else
{
open (HDW,">/tmp/fullhead_more.tmp") or die "$!";
while(<$sock>){
local $/=CRLF;
chomp;
print HDW $_;
}
close HDW;
exit 0;
}
}
1;
----
Then I use it in the main script:
----
use strict;
use DBI;
use fullhead;
my $mysql_host="192.168.3.236";
my $mysql_db="xxxx";
my $mysql_user="xxx";
my $mysql_passwd="xxxxxx";
my $mysql_table_alarm="rcptalarm";
my
$dbh=DBI->connect("dbi:mysql:$mysql_db:$mysql_host",$mysql_user,$mysql_passwd,
{PrintError => 1,RaiseError => 0});
my $query="select * from $mysql_table_alarm limit 10";
my $sth=$dbh->prepare($query);
$sth->execute;
fullhead("[EMAIL PROTECTED]");
$sth->execute;
----
When I run the main script,I'll get the errors:
DBD::mysql::st execute failed: MySQL server has gone away at test.pl line 19.
It seems that the fullhead() call from fullhead.pm has droped the mysql
connection.
Why this happen?Any suggestion is welcome,thanks.
--
Jeff Pang
NetEase AntiSpam Team
http://corp.netease.com
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
