如果未设置 $crash 参数，以下程序将运行：
$ perl example mysql://:tange@/tange/mytable
dburl mysql://:tange@/tange/mytable
databasedriver mysql user password tange host port database tange table mytable query
run DROP TABLE IF EXISTS mytable;
run CREATE TABLE mytable
(Seq INT,
Exitval INT
);
run INSERT INTO mytable (Seq,Exitval) VALUES (?,?);
run INSERT INTO mytable (Seq,Exitval) VALUES (?,?);
如果设置了 $crash，则 bzip2 通过 open3 运行，通过分叉进程发送数据，这会导致 DBD/DBI 崩溃：
$ perl example mysql://:tange@/tange/mytable 1
dburl mysql://:tange@/tange/mytable
databasedriver mysql user password tange host port database tange table mytable query
run DROP TABLE IF EXISTS mytable;
run CREATE TABLE mytable
(Seq INT,
Exitval INT
);
run INSERT INTO mytable (Seq,Exitval) VALUES (?,?);
Orig:
As bzip2:BZh9rE8P�
1
run INSERT INTO mytable (Seq,Exitval) VALUES (?,?);
DBD::mysql::st execute failed: MySQL server has gone away at example line 157.
DBD::mysql::st execute failed: MySQL server has gone away at example line 157.
如果使用 Postgresql，这也是正确的：
$ perl example pg:////mytable
dburl pg:////mytable
databasedriver pg user password host port database table mytable query
run DROP TABLE IF EXISTS mytable;
run CREATE TABLE mytable
(Seq INT,
Exitval INT
);
run INSERT INTO mytable (Seq,Exitval) VALUES (?,?);
run INSERT INTO mytable (Seq,Exitval) VALUES (?,?);
并设置 $crash ：
$ perl example pg:////mytable 1
dburl pg:////mytable
databasedriver pg user password host port database table mytable query
run DROP TABLE IF EXISTS mytable;
run CREATE TABLE mytable
(Seq INT,
Exitval INT
);
run INSERT INTO mytable (Seq,Exitval) VALUES (?,?);
Orig:
As bzip2:BZh9rE8P�
1
run INSERT INTO mytable (Seq,Exitval) VALUES (?,?);
DBD::Pg::st execute failed: server closed the connection unexpectedly
This probably means the server terminated abnormally
before or while processing the request. at example line 157.
DBD::Pg::st execute failed: server closed the connection unexpectedly
This probably means the server terminated abnormally
before or while processing the request. at example line 157.
为什么？有解决方法吗？
对我来说 open3 和 fork 与 DBD/DBI 完全无关。
#!/usr/bin/perl
use IPC::Open3;
my $sql = SQL->new(shift);
my $crash = shift;
$Global::debug = "all";
$sql->create_table();
$sql->insert_records(2);
$crash and print length string_zip("abc"),"\n";
$sql->insert_records(3);
sub string_zip {
# Pipe string through 'cmd'
my $cmd = shift;
my($zipin_fh, $zipout_fh,@base64);
::open3($zipin_fh,$zipout_fh,">&STDERR","bzip2 -9");
if(fork) {
close $zipin_fh;
@base64 = <$zipout_fh>;
close $zipout_fh;
} else {
close $zipout_fh;
print $zipin_fh @_;
close $zipin_fh;
exit;
}
::debug("zip","Orig:@_\nAs bzip2:@base64\n");
return @base64;
}
sub undef_if_empty {
if(defined($_[0]) and $_[0] eq "") {
return undef;
}
return $_[0];
}
sub debug {
# Uses:
# $Global::debug
# %Global::fd
# Returns: N/A
print @_[1..$#_];
}
package SQL;
sub new {
my $class = shift;
my $dburl = shift;
$Global::use{"DBI"} ||= eval "use DBI; 1;";
my %options = parse_dburl($dburl);
my %driveralias = ("sqlite" => "SQLite",
"sqlite3" => "SQLite",
"pg" => "Pg",
"postgres" => "Pg",
"postgresql" => "Pg");
my $driver = $driveralias{$options{'databasedriver'}} || $options{'databasedriver'};
my $database = $options{'database'};
my $host = $options{'host'} ? ";host=".$options{'host'} : "";
my $port = $options{'port'} ? ";port=".$options{'port'} : "";
my $dsn = "DBI:$driver:dbname=$database$host$port";
my $userid = $options{'user'};
my $password = $options{'password'};;
my $dbh = DBI->connect($dsn, $userid, $password, { RaiseError => 1 })
or die $DBI::errstr;
return bless {
'dbh' => $dbh,
'max_number_of_args' => undef,
'table' => $options{'table'},
}, ref($class) || $class;
}
sub parse_dburl {
my $url = shift;
my %options = ();
# sql:mysql://[[user][:password]@][host][:port]/[database[/table][?sql query]]
if($url=~m!(?:sql:)? # You can prefix with 'sql:'
((?:oracle|ora|mysql|pg|postgres|postgresql)(?:s|ssl|)|
(?:sqlite|sqlite2|sqlite3)):// # Databasedriver ($1)
(?:
([^:@/][^:@]*|) # Username ($2)
(?:
:([^@]*) # Password ($3)
)?
@)?
([^:/]*)? # Hostname ($4)
(?:
:
([^/]*)? # Port ($5)
)?
(?:
/
([^/?]*)? # Database ($6)
)?
(?:
/
([^?]*)? # Table ($7)
)?
(?:
\?
(.*)? # Query ($8)
)?
!ix) {
$options{databasedriver} = ::undef_if_empty(lc(uri_unescape($1)));
$options{user} = ::undef_if_empty(uri_unescape($2));
$options{password} = ::undef_if_empty(uri_unescape($3));
$options{host} = ::undef_if_empty(uri_unescape($4));
$options{port} = ::undef_if_empty(uri_unescape($5));
$options{database} = ::undef_if_empty(uri_unescape($6));
$options{table} = ::undef_if_empty(uri_unescape($7));
$options{query} = ::undef_if_empty(uri_unescape($8));
::debug("sql","dburl $url\n");
::debug("sql","databasedriver ",$options{databasedriver}, " user ", $options{user},
" password ", $options{password}, " host ", $options{host},
" port ", $options{port}, " database ", $options{database},
" table ",$options{table}," query ",$options{query}, "\n");
} else {
::error("$url is not a valid DBURL");
exit 255;
}
return %options;
}
sub uri_unescape {
# Copied from http://cpansearch.perl.org/src/GAAS/URI-1.55/URI/Escape.pm
# to avoid depending on URI::Escape
# This section is (C) Gisle Aas.
# Note from RFC1630: "Sequences which start with a percent sign
# but are not followed by two hexadecimal characters are reserved
# for future extension"
my $str = shift;
if (@_ && wantarray) {
# not executed for the common case of a single argument
my @str = ($str, @_); # need to copy
foreach (@str) {
s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
}
return @str;
}
$str =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg if defined $str;
$str;
}
sub run {
my $self = shift;
my $stmt = shift;
my $dbh = $self->{'dbh'};
::debug("sql","run $stmt\n");
# Execute with the rest of the args - if any
my $rv;
my $sth;
$sth = $dbh->prepare($stmt);
$rv = $sth->execute(@_);
return $sth;
}
sub table {
my $self = shift;
return $self->{'table'};
}
sub create_table {
my $self = shift;
my $table = $self->table();
$self->run(qq(DROP TABLE IF EXISTS $table;));
$self->run(qq{CREATE TABLE $table
(Seq INT,
Exitval INT
}.
qq{);});
}
sub insert_records {
my $self = shift;
my $seq = shift;
my $record_ref = shift;
my $table = $self->table();
$self->run("INSERT INTO $table (Seq,Exitval) ".
"VALUES (?,?);", $seq, -1000);
}
答案1
当子进程或父进程退出时，它会关闭其数据库句柄和关联的套接字，并且在服务器端，相应的后端也会退出。
从那时起，如果其他（仍然存在）客户端进程尝试使用数据库句柄，发送查询将失败并显示MySQL服务器消失了或使用 postgres服务器意外关闭连接。这些消息似乎非常正确地描述了所发生的事情。
主要的解决方法是在进程之间调用DBI->connect()而不fork是以任何方式共享数据库句柄。
如果数据库活动仅限于父级，您可以AutoInactiveDestroy提前设置数据库句柄（自 DBI 1.614 起）。这应该InactiveDestroy在孩子中自动设置并解决问题。请InactiveDestroy参阅 DBI 文档：
对于数据库句柄，此属性不会禁用对断开连接方法的显式调用，仅禁用在句柄仍标记为“活动”时发生的 DESTROY 隐式调用。
该属性专门设计用于“分叉”子进程的 Unix 应用程序。对于某些驱动程序，当子进程退出时，继承的句柄的销毁会导致父进程中相应的句柄停止工作。
父进程或子进程（但不能同时）都应在其所有共享句柄上将 InactiveDestroy 设置为 true。或者，并且优选地，可以在连接时在父级中设置“AutoInactiveDestroy”。