From: Peter Rabbitson Date: Mon, 27 Apr 2009 08:03:58 +0000 (+0000) Subject: Refactor the (almost obsolete) DBD::SQLite check not to fork() within win32 X-Git-Tag: v0.08101~3 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=713cc98e8bc591cee3d64178021555fc7902c876;p=dbsrgits%2FDBIx-Class.git Refactor the (almost obsolete) DBD::SQLite check not to fork() within win32 --- diff --git a/Makefile.PL b/Makefile.PL index b4e9210..fe4136a 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -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; @@ -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() @@ -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; +}