Skip to content

Commit

Permalink
Refactor the (almost obsolete) DBD::SQLite check not to fork() within…
Browse files Browse the repository at this point in the history 
… win32
  • Loading branch information
@ribasushi
ribasushi committed Apr 27, 2009
1 parent db2b2eb commit 713cc98
Showing 1 changed file with 87 additions and 77 deletions.
164 changes: 87 additions & 77 deletions Makefile.PL
View file
Expand Up @@ -104,59 +104,57 @@ EOW
auto_install;

# Have all prerequisites, check DBD::SQLite sanity
if (! $ENV{DBICTEST_NO_SQLITE_CHECK} ) {
_check_sqlite() if (! $ENV{DBICTEST_NO_SQLITE_CHECK} );

my $pid = fork();
if (not defined $pid) {
die "Unable to fork(): $!";
}
elsif (! $pid) {
WriteAll();

# Win32 does not have real fork()s so a segfault will bring
# everything down. Warn about it.
if ($^O eq 'MSWin32') {
print <<'EOW';
if ($Module::Install::AUTHOR) {
# Need to do this _after_ WriteAll else it loses track of them
Meta->{values}{build_requires} = [ grep {
my $ok = 1;
foreach my $module (keys %force_requires_if_author) {
if ($_->[0] =~ /$module/) {
$ok = 0;
last;
}
}
$ok;
} @{Meta->{values}{build_requires}} ];

######################################################################
# #
# A short stress-testing of DBD::SQLite will follow. If you have a #
# buggy library this might very well be the last text you will see #
# before the installation silently terminates. If this happens it #
# would mean that you are running a buggy version of DBD::SQLite #
# known to randomly segfault on errors. Even if you have the latest #
# CPAN module version, the system sqlite3 dynamic library might have #
# been compiled against an older buggy sqlite3 dev library (oddly #
# DBD::SQLite will prefer the system library against the one bundled #
# with it). You are strongly advised to resolve this issue before #
# proceeding. #
# #
# If this happens to you (this text is the last thing you see), and #
# you just want to install this module without worrying about the #
# tests (which will almost certainly fail) - set the environment #
# variable DBICTEST_NO_SQLITE_CHECK to a true value and try again. #
# #
######################################################################
my @scalar_keys = Module::Install::Metadata::Meta_TupleKeys();
my $cr = Module::Install::Metadata->can("Meta_TupleKeys");
{
no warnings 'redefine';
*Module::Install::Metadata::Meta_TupleKeys = sub {
return $cr->(@_), 'resources';
};
}
Meta->{values}{resources} = [
[ 'MailingList', 'http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/dbix-class' ],
[ 'IRC', 'irc://irc.perl.org/#dbix-class' ],
[ 'license', 'http://dev.perl.org/licenses/' ],
[ 'repository', 'http://dev.catalyst.perl.org/svnweb/bast/browse/DBIx-Class/' ],
];
Meta->write;
}

EOW
}

require DBI;
for (1 .. 100) {
my $dbh;
$dbh = DBI->connect ('dbi:SQLite::memory:', undef, undef, {
AutoCommit => 1,
RaiseError => 0,
PrintError => 0,
})
or die "Unable to connect to database: $@";
$dbh->do ('CREATE TABLE name_with_no_columns'); # a subtle syntax error
$dbh->do ('COMMIT'); # followed by commit
$dbh->disconnect;
}
# This is legacy code. Latest DBD::SQLite developments fixed all known bugs
# in this area. Remove before some arbitrary next version
sub _check_sqlite {

exit 0;
}
else {
# Win32 does not have real fork()s so a segfault will bring
# everything down. Warn about it below, and don't try fork()
if ($^O ne 'MSWin32') {

my $pid = fork();
if (not defined $pid) {
die "Unable to fork(): $!";
}
elsif (! $pid) {
_torture_sqlite();
}
else {
eval {
local $SIG{ALRM} = sub { die "timeout\n" };
alarm 5;
Expand All @@ -167,7 +165,7 @@ EOW

my $sig = $? & 127;

# make sure process actually dies
# make sure process actually dies
$exception && kill POSIX::SIGKILL(), $pid;

if ($exception || $sig == POSIX::SIGSEGV() || $sig == POSIX::SIGABRT()
Expand All @@ -193,40 +191,52 @@ EOE
);
exit 0 unless ($ans =~ /^y(es)?$/i);
}
}
}
}

else { # the win32 version

WriteAll();

print <<'EOW';
######################################################################
# #
# A short stress-testing of DBD::SQLite will follow. If you have a #
# buggy library this might very well be the last text you will see #
# before the installation silently terminates. If this happens it #
# would mean that you are running a buggy version of DBD::SQLite #
# known to randomly segfault on errors. Even if you have the latest #
# CPAN module version, the system sqlite3 dynamic library might have #
# been compiled against an older buggy sqlite3 dev library (oddly #
# DBD::SQLite will prefer the system library against the one bundled #
# with it). You are strongly advised to resolve this issue before #
# proceeding. #
# #
# If this happens to you (this text is the last thing you see), and #
# you just want to install this module without worrying about the #
# tests (which will almost certainly fail) - set the environment #
# variable DBICTEST_NO_SQLITE_CHECK to a true value and try again. #
# #
######################################################################
if ($Module::Install::AUTHOR) {
# Need to do this _after_ WriteAll else it loses track of them
Meta->{values}{build_requires} = [ grep {
my $ok = 1;
foreach my $module (keys %force_requires_if_author) {
if ($_->[0] =~ /$module/) {
$ok = 0;
last;
}
}
$ok;
} @{Meta->{values}{build_requires}} ];
EOW

my @scalar_keys = Module::Install::Metadata::Meta_TupleKeys();
my $cr = Module::Install::Metadata->can("Meta_TupleKeys");
{
no warnings 'redefine';
*Module::Install::Metadata::Meta_TupleKeys = sub {
return $cr->(@_), 'resources';
};
_torture_sqlite();
}
Meta->{values}{resources} = [
[ 'MailingList', 'http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/dbix-class' ],
[ 'IRC', 'irc://irc.perl.org/#dbix-class' ],
[ 'license', 'http://dev.perl.org/licenses/' ],
[ 'repository', 'http://dev.catalyst.perl.org/svnweb/bast/browse/DBIx-Class/' ],
];
Meta->write;
}

sub _torture_sqlite {
require DBI;

for (1 .. 100) {
my $dbh = DBI->connect ('dbi:SQLite::memory:', undef, undef, {
AutoCommit => 1,
RaiseError => 0,
PrintError => 0,
}) or die "Unable to connect to database: $@";

$dbh->do ('CREATE TABLE name_with_no_columns'); # a subtle syntax error
$dbh->do ('COMMIT'); # followed by commit
$dbh->disconnect;
}

exit 0;
}

0 comments on commit 713cc98

Please sign in to comment.