O programa abaixo funciona se o parâmetro $ crash não estiver definido:
$ 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 (?,?);
Se $ crash for definido, o bzip2 será executado através do open3, os dados serão enviados por um processo bifurcado e isso trava o 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.
Isso também é verdade, se estiver usando o 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 (?,?);
E com o conjunto $ 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.
Por quê? Existe uma solução alternativa?
Para mim, open3 e fork não estão relacionados ao 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);
}