From 22b6793ed5b6eb58337088d9e77abf6e3245be77 Mon Sep 17 00:00:00 2001 From: Kenichi Ishigaki Date: Mon, 26 Oct 2020 12:51:43 +0900 Subject: [PATCH 1/2] Fork safety --- .github/workflows/build.yml | 8 ++++---- cpanfile | 8 ++++++++ lib/Data/ObjectDriver.pm | 6 ++++++ lib/Data/ObjectDriver/Driver/DBI.pm | 25 +++++++++++++++++++++++-- t/lib/DodTestUtil.pm | 9 +++++---- 5 files changed, 46 insertions(+), 10 deletions(-) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index b633981b..0ebe468b 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -17,7 +17,7 @@ jobs: - name: perl -V run: perl -V - name: Install dependencies - run: curl -sL https://git.io/cpm | sudo perl - install -g --with-recommends --with-test --with-configure --show-build-log-on-failure --feature=test_sqlite + run: curl -sL https://git.io/cpm | sudo perl - install -g --with-recommends --with-test --with-configure --show-build-log-on-failure --feature=test_sqlite --feature=test_fork - name: Run tests run: prove -lr -j4 t @@ -31,7 +31,7 @@ jobs: - name: apt-get run: sudo apt-get update && sudo apt-get install -y libdbd-mysql-perl mysql-server - name: Install dependencies - run: curl -sL https://git.io/cpm | sudo perl - install -g --with-recommends --with-test --with-configure --show-build-log-on-failure --feature=test_mysql + run: curl -sL https://git.io/cpm | sudo perl - install -g --with-recommends --with-test --with-configure --show-build-log-on-failure --feature=test_mysql --feature=test_fork - name: Run tests run: DOD_TEST_DRIVER=MySQL prove -lr -j4 t @@ -47,7 +47,7 @@ jobs: - name: apt-get run: sudo apt-get update && sudo apt-get install -y libmariadb-dev mariadb-server - name: Install dependencies - run: curl -sL https://git.io/cpm | sudo perl - install -g --with-recommends --with-test --with-configure --show-build-log-on-failure --feature=test_mariadb + run: curl -sL https://git.io/cpm | sudo perl - install -g --with-recommends --with-test --with-configure --show-build-log-on-failure --feature=test_mariadb --feature=test_fork - name: Run tests run: DOD_TEST_DRIVER=MariaDB prove -lr -j4 t @@ -61,6 +61,6 @@ jobs: - name: apt-get run: sudo apt-get update && sudo apt-get install -y libdbd-pg-perl postgresql - name: Install dependencies - run: curl -sL https://git.io/cpm | sudo perl - install -g --with-recommends --with-test --with-configure --show-build-log-on-failure --feature=test_postgresql + run: curl -sL https://git.io/cpm | sudo perl - install -g --with-recommends --with-test --with-configure --show-build-log-on-failure --feature=test_postgresql --feature=test_fork - name: Run tests run: DOD_TEST_DRIVER=PostgreSQL prove -lr -j4 t diff --git a/cpanfile b/cpanfile index 67929d3d..14019acb 100644 --- a/cpanfile +++ b/cpanfile @@ -45,3 +45,11 @@ feature 'test_postgresql', 'Test PostgreSQL' => sub { requires 'Test::PostgreSQL'; requires 'SQL::Translator'; }; + +feature 'test_fork', 'Test Fork' => sub { + requires 'DBI', '1.614'; + requires 'Parallel::ForkManager'; + requires 'POSIX::AtFork'; + requires 'Scalar::Util'; + requires 'Test::SharedFork'; +}; diff --git a/lib/Data/ObjectDriver.pm b/lib/Data/ObjectDriver.pm index accf8341..1169b523 100644 --- a/lib/Data/ObjectDriver.pm +++ b/lib/Data/ObjectDriver.pm @@ -758,6 +758,12 @@ has been added specifically for this purpose: C. 1; +=head1 FORK SAFETY + +As of version 0.21, I resets internal database handles +after I is called, but only if L module is installed. +Otherwise, I is not fork-safe. + =head1 SUPPORTED DATABASES I is very modular and it's not very difficult to add new drivers. diff --git a/lib/Data/ObjectDriver/Driver/DBI.pm b/lib/Data/ObjectDriver/Driver/DBI.pm index 30d24096..d075789c 100644 --- a/lib/Data/ObjectDriver/Driver/DBI.pm +++ b/lib/Data/ObjectDriver/Driver/DBI.pm @@ -13,6 +13,16 @@ use Data::ObjectDriver::SQL; use Data::ObjectDriver::Driver::DBD; use Data::ObjectDriver::Iterator; +my $ForkSafe = _is_fork_safe(); +my %Handles; + +sub _is_fork_safe { + return if exists $ENV{DOD_FORK_SAFE} and !$ENV{DOD_FORK_SAFE}; + eval { require POSIX::AtFork; 1 } or return; + eval { require Scalar::Util; Scalar::Util->import('weaken'); 1 } or return; + return 1; +} + __PACKAGE__->mk_accessors(qw( dsn username password connect_options dbh get_dbh dbd prefix reuse_dbh force_no_prepared_cache)); @@ -36,6 +46,17 @@ sub init { } $driver->dbd(Data::ObjectDriver::Driver::DBD->new($type)); } + + if ($ForkSafe) { + # Purge cached handles + weaken(my $driver_weaken = $driver); + POSIX::AtFork->add_to_child(sub { + return unless $driver_weaken; + $driver_weaken->dbh(undef); + %Handles = (); + }); + } + $driver; } @@ -61,7 +82,6 @@ sub _prepare_cached { return ($driver->dbd->can_prepare_cached_statements)? $dbh->prepare_cached($sql) : $dbh->prepare($sql); } -my %Handles; sub init_db { my $driver = shift; my $dbh; @@ -72,6 +92,7 @@ sub init_db { eval { $dbh = DBI->connect($driver->dsn, $driver->username, $driver->password, { RaiseError => 1, PrintError => 0, AutoCommit => 1, + ( $ForkSafe ? ( AutoInactiveDestroy => 1 ) : () ), %{$driver->connect_options || {}} }) or Carp::croak("Connection error: " . $DBI::errstr); }; @@ -669,7 +690,7 @@ sub DESTROY { ## if we haven't created it ourself. return unless $driver->{__dbh_init_by_driver}; if (my $dbh = $driver->dbh) { - $dbh->disconnect if $dbh; + $dbh->disconnect; } } diff --git a/t/lib/DodTestUtil.pm b/t/lib/DodTestUtil.pm index eb2c04df..c5d2f55a 100755 --- a/t/lib/DodTestUtil.pm +++ b/t/lib/DodTestUtil.pm @@ -95,7 +95,8 @@ CONF return $TestDB{$dbname}->dsn; } if ( $driver eq 'SQLite' ) { - return 'dbi:SQLite:' . db_filename($dbname); + $TestDB{$dbname} ||= db_filename($dbname); + return 'dbi:SQLite:' . $TestDB{$dbname}; } } @@ -118,11 +119,11 @@ sub setup_dbs { sub teardown_dbs { my(@dbs) = @_; my $driver = driver(); + return unless $driver eq 'SQLite'; for my $db (@dbs) { - next unless $driver eq 'SQLite'; - my $file = db_filename($db); + my $file = $TestDB{$db}; next unless -e $file; - unlink $file or die "Can't teardown $db: $!"; + unlink $file or die "Can't teardown $file: $!"; } } From a1be08c0eb94146316c2b71d1ebd544bc642fc81 Mon Sep 17 00:00:00 2001 From: Kenichi Ishigaki Date: Mon, 26 Oct 2020 12:54:31 +0900 Subject: [PATCH 2/2] Add test --- t/60-fork.t | 80 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 80 insertions(+) create mode 100644 t/60-fork.t diff --git a/t/60-fork.t b/t/60-fork.t new file mode 100644 index 00000000..76dcf44c --- /dev/null +++ b/t/60-fork.t @@ -0,0 +1,80 @@ +use strict; +use warnings; +use lib 't/lib'; + +$Data::ObjectDriver::DEBUG = 0; +use Test::More; +use DodTestUtil; + +BEGIN { + my @requires = qw( + Parallel::ForkManager + Test::SharedFork + ); + + for my $module (@requires) { + eval "require $module" or plan skip_all => "requires $module"; + } + DodTestUtil->check_driver; +} + +setup_dbs({ + global => [ qw( wines ) ], +}); + +use Wine; + +my $wine = Wine->new; +$wine->name("Latour"); +ok($wine->save, 'Object saved successfully'); + +my $wine_id = $wine->id; +undef $wine; +$wine = Wine->lookup($wine_id); + +ok $wine; + +my $max = $ENV{DOD_TEST_MAX_FORK} || 10; +my $pm = Parallel::ForkManager->new( $ENV{DOD_TEST_WORKERS} || 4 ); +$pm->run_on_finish(sub { + my ($pid, $exit, $ident) = @_; + ok !$exit, "pid $pid exits $exit"; +}); +$pm->run_on_start(sub { + my ($pid, $ident) = @_; + note "pid $pid starts"; +}); +for my $id ( 1 .. $max ) { + my $pid = $pm->start and next; + my $new_wine = Wine->new; + $new_wine->name("Wine $id"); + $new_wine->begin_work; + ok $new_wine->save, "saved wine $id"; + $new_wine->commit; + + my ($result) = Wine->result({name => 'Latour'}); + ok !$result->is_finished, "not yet finished"; + ok my $latour = $result->next, "next"; + is $latour->name => 'Latour', "found Latour"; + ok !$result->next, "no more next"; + ok $result->is_finished, "finished"; + + $pm->finish; +} + +$pm->wait_all_children; + +pass("waited all children"); + +my $result = Wine->result({}); +my %seen; +while( my $wine = $result->next ) { + $seen{$wine->name} = 1; +} + +ok $seen{Latour}, "seen Latour"; +ok $seen{"Wine $_"}, "seen Wine $_" for 1 .. $max; + +done_testing; + +teardown_dbs('global');