Hello community,
here is the log from the commit of package perl-Log-Dispatch-FileRotate for
openSUSE:Factory checked in at 2017-08-28 15:10:21
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/perl-Log-Dispatch-FileRotate (Old)
and /work/SRC/openSUSE:Factory/.perl-Log-Dispatch-FileRotate.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-Log-Dispatch-FileRotate"
Mon Aug 28 15:10:21 2017 rev:23 rq:516824 version:1.29
Changes:
--------
---
/work/SRC/openSUSE:Factory/perl-Log-Dispatch-FileRotate/perl-Log-Dispatch-FileRotate.changes
2017-07-21 22:47:19.586272093 +0200
+++
/work/SRC/openSUSE:Factory/.perl-Log-Dispatch-FileRotate.new/perl-Log-Dispatch-FileRotate.changes
2017-08-28 15:10:35.276207103 +0200
@@ -1,0 +2,28 @@
+Thu Aug 3 05:43:55 UTC 2017 - [email protected]
+
+- updated to 1.29
+ see /usr/share/doc/packages/perl-Log-Dispatch-FileRotate/Changes
+
+ 1.29 Fri Jul 28 2017
+ - Fix deadlock on Windows due to the fact that stat() on a filehandle vs
a
+ path doesn't return the same device field on Windows.
+
+-------------------------------------------------------------------
+Fri Jul 28 05:46:28 UTC 2017 - [email protected]
+
+- updated to 1.28
+ see /usr/share/doc/packages/perl-Log-Dispatch-FileRotate/Changes
+
+ 1.28 Thu Jul 27 2017
+ *** Multiple fixes to locking code:
+ - flock() can be interrupted by a syscall. work around by using a
+ safe_flock() wrapper that retries if errno is EAGAIN (and also
+ EWOULDBLOCK).
+ - handle several possible race conditions between open() and flock().
+ - DESTROY() was unlinking the lockfile (.logfile.LCK). This was the
cause
+ of a race condition where multiple processes could enter the critical
+ seciton at the same time. Avoided by leaving .LCK files in place.
+ Probably fixes #77075 (Thanks Emanuele Tomasi).
+ - add author test for DESTROY lockfile race condition.
+
+-------------------------------------------------------------------
Old:
----
Log-Dispatch-FileRotate-1.27.tar.gz
New:
----
Log-Dispatch-FileRotate-1.29.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ perl-Log-Dispatch-FileRotate.spec ++++++
--- /var/tmp/diff_new_pack.WTWHe2/_old 2017-08-28 15:10:36.468039443 +0200
+++ /var/tmp/diff_new_pack.WTWHe2/_new 2017-08-28 15:10:36.472038880 +0200
@@ -17,7 +17,7 @@
Name: perl-Log-Dispatch-FileRotate
-Version: 1.27
+Version: 1.29
Release: 0
%define cpan_name Log-Dispatch-FileRotate
Summary: Log to Files that Archive/Rotate Themselves
++++++ Log-Dispatch-FileRotate-1.27.tar.gz ->
Log-Dispatch-FileRotate-1.29.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Log-Dispatch-FileRotate-1.27/Changes
new/Log-Dispatch-FileRotate-1.29/Changes
--- old/Log-Dispatch-FileRotate-1.27/Changes 2017-07-06 17:48:44.000000000
+0200
+++ new/Log-Dispatch-FileRotate-1.29/Changes 2017-07-28 17:15:44.000000000
+0200
@@ -1,5 +1,21 @@
Revision history for Perl extension Log::Dispatch::FileRotate.
+1.29 Fri Jul 28 2017
+ - Fix deadlock on Windows due to the fact that stat() on a filehandle vs a
+ path doesn't return the same device field on Windows.
+
+1.28 Thu Jul 27 2017
+ *** Multiple fixes to locking code:
+ - flock() can be interrupted by a syscall. work around by using a
+ safe_flock() wrapper that retries if errno is EAGAIN (and also
+ EWOULDBLOCK).
+ - handle several possible race conditions between open() and flock().
+ - DESTROY() was unlinking the lockfile (.logfile.LCK). This was the cause
+ of a race condition where multiple processes could enter the critical
+ seciton at the same time. Avoided by leaving .LCK files in place.
+ Probably fixes #77075 (Thanks Emanuele Tomasi).
+ - add author test for DESTROY lockfile race condition.
+
1.27 Thu Jul 06 2017
- add "check_both" configuration option which allows the use of both time
and
size based rotation at the same time. If either conditions require a
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Log-Dispatch-FileRotate-1.27/MANIFEST
new/Log-Dispatch-FileRotate-1.29/MANIFEST
--- old/Log-Dispatch-FileRotate-1.27/MANIFEST 2017-07-06 17:48:44.000000000
+0200
+++ new/Log-Dispatch-FileRotate-1.29/MANIFEST 2017-07-28 17:15:44.000000000
+0200
@@ -9,6 +9,7 @@
README
SIGNATURE
lib/Log/Dispatch/FileRotate.pm
+t/author-lockfile-race-condition.t
t/author-pod-syntax.t
t/author-signature.t
t/basic.t
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Log-Dispatch-FileRotate-1.27/META.json
new/Log-Dispatch-FileRotate-1.29/META.json
--- old/Log-Dispatch-FileRotate-1.27/META.json 2017-07-06 17:48:44.000000000
+0200
+++ new/Log-Dispatch-FileRotate-1.29/META.json 2017-07-28 17:15:44.000000000
+0200
@@ -61,7 +61,7 @@
"web" : "https://github.com/mschout/perl-log-dispatch-filerotate";
}
},
- "version" : "1.27",
+ "version" : "1.29",
"x_serialization_backend" : "Cpanel::JSON::XS version 3.0217"
}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Log-Dispatch-FileRotate-1.27/META.yml
new/Log-Dispatch-FileRotate-1.29/META.yml
--- old/Log-Dispatch-FileRotate-1.27/META.yml 2017-07-06 17:48:44.000000000
+0200
+++ new/Log-Dispatch-FileRotate-1.29/META.yml 2017-07-28 17:15:44.000000000
+0200
@@ -32,5 +32,5 @@
bugtracker:
http://rt.cpan.org/Public/Dist/Display.html?Name=Log-Dispatch-FileRotate
homepage: http://search.cpan.org/dist/Log-Dispatch-FileRotate/
repository: git://github.com/mschout/perl-log-dispatch-filerotate.git
-version: '1.27'
+version: '1.29'
x_serialization_backend: 'YAML::Tiny version 1.69'
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Log-Dispatch-FileRotate-1.27/Makefile.PL
new/Log-Dispatch-FileRotate-1.29/Makefile.PL
--- old/Log-Dispatch-FileRotate-1.27/Makefile.PL 2017-07-06
17:48:44.000000000 +0200
+++ new/Log-Dispatch-FileRotate-1.29/Makefile.PL 2017-07-28
17:15:44.000000000 +0200
@@ -34,7 +34,7 @@
"Test::Warn" => 0,
"warnings" => 0
},
- "VERSION" => "1.27",
+ "VERSION" => "1.29",
"test" => {
"TESTS" => "t/*.t"
}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Log-Dispatch-FileRotate-1.27/README
new/Log-Dispatch-FileRotate-1.29/README
--- old/Log-Dispatch-FileRotate-1.27/README 2017-07-06 17:48:44.000000000
+0200
+++ new/Log-Dispatch-FileRotate-1.29/README 2017-07-28 17:15:44.000000000
+0200
@@ -1,7 +1,7 @@
This archive contains the distribution Log-Dispatch-FileRotate,
-version 1.27:
+version 1.29:
Log to Files that Archive/Rotate Themselves
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Log-Dispatch-FileRotate-1.27/SIGNATURE
new/Log-Dispatch-FileRotate-1.29/SIGNATURE
--- old/Log-Dispatch-FileRotate-1.27/SIGNATURE 2017-07-06 17:48:44.000000000
+0200
+++ new/Log-Dispatch-FileRotate-1.29/SIGNATURE 2017-07-28 17:15:44.000000000
+0200
@@ -14,15 +14,16 @@
-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA256
-SHA1 5f2848a7a136999809d69d575eaa048911150c01 Changes
+SHA1 117fb6a8ebe95e7bc99da90302d2ab6c601a658a Changes
SHA1 bab88f54ea8c7c2588e407bd69fad8bf7cb47c1b LICENSE
-SHA1 e8eda729f34b53e40683914c05a4f2514b7aa8c2 MANIFEST
+SHA1 4a7726f10a2d40e2ddf0907f67e92453f03e466a MANIFEST
SHA1 eb174e472fc75cb6a5a5f04e1dc740d569ad310b MANIFEST.SKIP
-SHA1 78eb2037a7f576b64612717a38021a7c732af909 META.json
-SHA1 92e3bb780fee17927d31cd6e109f59e2ad43406e META.yml
-SHA1 a444aa6dd3aa9efa9f9fdfc3fb308237a379a74e Makefile.PL
-SHA1 a9d40c8b3367a8e65c0e47bfda1350eb903928ed README
-SHA1 904fc63cbfc4c402cfe493f6173ef8c36fd4ea19 lib/Log/Dispatch/FileRotate.pm
+SHA1 b80a323a6a0a20509667e20879f6e3809010e9ff META.json
+SHA1 8ab48a984f989b1e156c1543f53f0cf4a9ec7878 META.yml
+SHA1 95b3d9dfc8f9c0522d58d0626377b26365372ba8 Makefile.PL
+SHA1 4f55a0709453c16ee46a1f7ede1de6c4f6ce83d4 README
+SHA1 6baf938139d4ed75d632f2b1d68e100991c5d766 lib/Log/Dispatch/FileRotate.pm
+SHA1 468e2f4cfd487b11e031a13ac79a56b2cc502d23
t/author-lockfile-race-condition.t
SHA1 8efad25309730a4d501fb40fc03eda4697303372 t/author-pod-syntax.t
SHA1 c985a5f343adfd44c02ddf90efa70d3601d1c34b t/author-signature.t
SHA1 1b0ff3264a10a8bbb678cc7cbec943d838fc7677 t/basic.t
@@ -33,17 +34,17 @@
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v2
-iQIVAwUBWV5b3KQl27WkM10aAQh0PRAA4F/P6I8FUjNf0xODcHyMVwjvFIEsmrKi
-B1NW+Gjfm19KCfop3O236TjqGXM9s5vokQU9X6dRWwCjsB2SfXHsBauJwE5UV5au
-yR3EKeiarii1/L8uy8nCHtTwNQWaO7V31zE6QYDq3Dtfz/pwKC6Qp/qrLeYgPKMM
-ZKo2ZLVW72uCZgzS9d71c7HtyiPQr6tb/puvSzIZ/3vf523WHKCQzdR6LciHxqbp
-ZvWju6j19idDX5oCKRlw274/AwWsiAq+OSpJNi2xCRXAszjVlvK4WYbKVS3ZRqeR
-AGuW4/gQi+SQPlRp9UgQHBNUUaOfwif6BDXWA89V/SnRVdAr9j+VbS5NIy2f/CRG
-Rm2NXLyj5AiegWkt7LFxI1p2vHkkIGbveq4HRJrVsXMScJAl0qGfDV9kX13TqMCN
-cQLHB9og7vkZ3F0OajRZetvlEeUipDLEY7jRtIBQAS+Emc+JjTD0LwToW1siCky4
-4ZM5VmtEmqxgj+qF/ILp5IzCscui6V+vNuMFXK1yBAb+N9TyHMe5yfmxzgNWKJdQ
-xYgf8+W3PDUCXhhdGlynsonQdIPcJrkJ+E8JJSQ64agGyEAD/eSKphD8WOSZU6I1
-jvG88WeLAl5pZDOoFoLY2pm0A268wwO6Q3KNzykl1mAX1cPnQdQXv0Oet6jrJzTP
-+JuANW5xGms=
-=eNkv
+iQIVAwUBWXtVIKQl27WkM10aAQhqkg//Znl8z8bxvhcA1NcdSGRT6n0eSqkh4RTx
+ag86+NcSFIMBrKf8I49T3zGJpUSgYvafT2PFhGvRlpL74yaAQmfS6nLa+tJv/ZsX
+fj2TL6U9Oi+KpppkWXSPvbHL5mCwJq576lnVzLec8AcbfRLKJVungzCLOd3DZxdM
+dA6PbYyA9QIUlt3iVhY8U3m4OYGB9Exu2Odb9I5oMDiIRPA6TMkOpCQcBXVjWXqn
+Qlbf9RaqsOMAPRgivYEk/74NFbgZkmzKRcp7yjnzg56s+xAJfV3StrpIwrjv850q
+hPxsnXC9R4rq1n2d1Bz1JZXfuqOb/Q9QIPtgGdov5ySxoy1Hxh8LZNv8zLqcb/i1
+Md6s6jLcC0MxkhJE7oALLXgHLTYg8jCqPyu3COSz8PSeTZKfsnRzmtH31X4Qou2j
+zsFdJKYq/mT+GD03RmwR+4BhV+MyHOnY0pHYT58xkXxvHU7jM0xQ9nQ+BZBsscx9
+yN0pPKERMK9Yt7IHq3sISuMZdkKBFtn2qVT/TQ96BqYhDA54QH9O3R3QIqUfr23o
+NNcJtLQMVxOHn5C+XEBwAYYR9Gz8SdSnhyVhofllj0CzLv6yVYwXT3WvhA8O19jT
+tgQlTOoOlskqqKyG6x4gwlUZsTR2wnPnpclCPFN5o3PvtSEfFHWayjXSWmAipJ0b
+htiV0L/Mn+A=
+=g55+
-----END PGP SIGNATURE-----
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/Log-Dispatch-FileRotate-1.27/lib/Log/Dispatch/FileRotate.pm
new/Log-Dispatch-FileRotate-1.29/lib/Log/Dispatch/FileRotate.pm
--- old/Log-Dispatch-FileRotate-1.27/lib/Log/Dispatch/FileRotate.pm
2017-07-06 17:48:44.000000000 +0200
+++ new/Log-Dispatch-FileRotate-1.29/lib/Log/Dispatch/FileRotate.pm
2017-07-28 17:15:44.000000000 +0200
@@ -1,5 +1,5 @@
package Log::Dispatch::FileRotate;
-$Log::Dispatch::FileRotate::VERSION = '1.27';
+$Log::Dispatch::FileRotate::VERSION = '1.29';
# ABSTRACT: Log to Files that Archive/Rotate Themselves
require 5.005;
@@ -13,6 +13,7 @@
use Date::Manip; # For time based recurring rotations
use File::Spec; # For file-names
+use Fcntl ':flock'; # import LOCK_* constants
use Params::Validate qw(validate SCALAR BOOLEAN);
Params::Validate::validation_options( allow_extra => 1 );
@@ -63,7 +64,7 @@
my $lockfile = File::Spec->catpath($vol, $dir, ".".$f.".LCK");
warn "Lock file is $lockfile\n" if $self->{'debug'};
- $self->{'lf'} = $lockfile;
+ $self->{lf} = $lockfile;
# Have we been called with a time based rotation pattern then setup
# timebased stuff. TZ is important and must match current TZ or all
@@ -203,18 +204,17 @@
# Prime our time based data outside the critical code area
my ($in_time_mode,$time_to_rotate) = $self->time_to_rotate();
- # Handle critical code for logging. No changes if someone else is in
- if( !$self->lfhlock_test() )
- {
- warn "$$ waiting on lock\n" if $self->{debug};
- unless($self->lfhlock())
- {
- warn "$$ Log::Dispatch::FileRotate failed to get lock:
", $self->{_lfhlock_test_err}, ". Not logging.\n";
- return;
- }
- warn "$$ got lock after wait\n" if $self->{debug};
+ # Handle critical code for logging. No changes if someone else is in.
We
+ # lock a lockfile, not the actual log filehandle because locking doesn't
+ # work properly if the logfile was opened in a parent process for
example.
+ my $lfh;
+ unless ($lfh = flopen($self->{lf})) {
+ warn "$$ Log::Dispatch::FileRotate failed to get lock: $!. Not
logging.\n";
+ return;
}
+ warn "$$ got lock\n" if $self->{debug};
+
my $have_to_rotate = 0;
my $size = (stat($fh))[7]; # Stat the handle to get real size
my $inode = (stat($fh))[1]; # get real inode
@@ -282,7 +282,8 @@
}
$self->logit($p{message});
- $self->lfhunlock();
+
+ safe_flock($lfh, LOCK_UN);
}
sub DESTROY
@@ -293,10 +294,6 @@
{
delete $self->{LDF}; # Should get rid of current LDF
}
-
- # Clean up locks
- close $self->{lfh} if $self->{lfh};
- unlink $self->{lf} if $self->{lf} && -f $self->{lf};
}
sub logit
@@ -581,15 +578,12 @@
return( shift(@{$self->{'dates'}{$pat}}) );
}
-
# Lock and unlock routines. For when we need to write a message.
-use Fcntl ':flock'; # import LOCK_* constants
-
sub lock
{
my $self = shift;
- flock($self->{LDF}->{fh},LOCK_EX);
+ safe_flock($self->{LDF}->{fh},LOCK_EX);
# Make sure we are at the EOF
seek($self->{LDF}->{fh}, 0, 2);
@@ -601,67 +595,76 @@
sub unlock
{
my $self = shift;
- flock($self->{LDF}->{fh},LOCK_UN);
+ safe_flock($self->{LDF}->{fh},LOCK_UN);
warn localtime() . " $$ unLocked\n" if $self->{debug};
}
-# Lock and unlock routines. For when we need to roll the logs.
-#
-# Note: On May 1, Dan Waldheim's good news was:
-# I discovered something interesting about forked processes and locking.
-# If the parent "open"s the filehandle and then forks, exclusive locks
-# don't work properly between the parent and children. Anyone can grab a
-# lock while someone else thinks they have it. To work properly the
-# "open" has to be done within each process.
-#
-# Thanks Dan
-sub lfhlock_test
-{
- my $self = shift;
+# Inspired by BSD's flopen(), returns filehandle on success
+sub flopen {
+ my $path = shift;
- if (open(LFH, ">>$self->{lf}"))
- {
- $self->{lfh} = *LFH;
- if (flock($self->{lfh}, LOCK_EX | LOCK_NB))
- {
- warn "$$ got lock on Lock File ".$self->{lfh}."\n" if
$self->{debug};
- return 1;
+ my $flags = LOCK_EX;
+
+ my $fh;
+
+ while (1) {
+ unless (open $fh, '>>', $path) {
+ return;
}
- }
- else
- {
- $self->{_lfhlock_test_err} = "couldn't lock $self->{lf}: $!";
- $self->{lfh} = 0;
- warn "$$ couldn't get lock on Lock File\n" if $self->{debug};
- return 0;
- }
-}
-sub lfhlock
-{
- my $self = shift;
+ unless (safe_flock($fh, $flags)) {
+ return;
+ }
- if (!$self->{lfh})
- {
- if (!open(LFH, ">>$self->{lf}"))
+ my @path_stat = stat $path;
+
+ unless (@path_stat) {
+ # file disappeared fron under our feet
+ close $fh;
+ next;
+ }
+
+ my @fh_stat = stat $fh;
+ unless (@fh_stat) {
+ # This should never happen
+ return;
+ }
+
+ unless ($^O =~ /^MSWin/) {
+ # stat on a filehandle and path return different "dev"
and "rdev"
+ # fields on windows
+ if ($path_stat[0] != $fh_stat[0]) {
+ # file was changed under our feet. try again;
+ close $fh;
+ next;
+ }
+ }
+
+ # check that device and inode are the same for the path and fh
+ if ($path_stat[1] != $fh_stat[1])
{
- return 0;
+ # file was changed under our feet. try again;
+ close $fh;
+ next;
}
- $self->{lfh} = *LFH;
- }
- flock($self->{lfh},LOCK_EX);
+ return $fh;
+ }
}
-sub lfhunlock
-{
- my $self = shift;
+sub safe_flock {
+ my ($fh, $flags) = @_;
- if($self->{lfh})
- {
- flock($self->{lfh},LOCK_UN);
- close $self->{lfh};
- $self->{lfh} = 0;
+ while (1) {
+ unless (flock $fh, $flags) {
+ # retry if we were interrupted or we are in
non-blocking and the file is locked
+ next if $!{EAGAIN} or $!{EWOULDBLOCK};
+
+ return 0;
+ }
+ else {
+ return 1;
+ }
}
}
@@ -670,8 +673,6 @@
$_[0]->{'debug'} = $_[1];
}
-__END__
-
=pod
=head1 NAME
@@ -680,7 +681,7 @@
=head1 VERSION
-version 1.27
+version 1.29
=head1 SYNOPSIS
@@ -963,3 +964,8 @@
the same terms as the Perl 5 programming language system itself.
=cut
+
+__END__
+
+
+# vim: noet
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/Log-Dispatch-FileRotate-1.27/t/author-lockfile-race-condition.t
new/Log-Dispatch-FileRotate-1.29/t/author-lockfile-race-condition.t
--- old/Log-Dispatch-FileRotate-1.27/t/author-lockfile-race-condition.t
1970-01-01 01:00:00.000000000 +0100
+++ new/Log-Dispatch-FileRotate-1.29/t/author-lockfile-race-condition.t
2017-07-28 17:15:44.000000000 +0200
@@ -0,0 +1,129 @@
+#!/usr/bin/perl -w
+
+BEGIN {
+ unless ($ENV{AUTHOR_TESTING}) {
+ print qq{1..0 # SKIP these tests are for testing by the author\n};
+ exit
+ }
+}
+
+
+# test case for regression where the .LCK file was unlinked in DESTROY(),
+# allowing multiple processes to enter the critical section at the same time.
+
+use strict;
+use warnings;
+use Path::Tiny;
+use IO::Handle;
+use Test::More;
+
+my $pid = fork;
+if (!defined $pid) {
+ plan skip_all => 'fork() does not work on this platform';
+}
+elsif ($pid == 0) {
+ # child
+ exit;
+}
+else {
+ # parent
+ waitpid $pid, 0;
+}
+
+plan tests => 2;
+
+use_ok 'Log::Dispatch::FileRotate' or exit 1;
+
+shim_logit_delay();
+
+my $tempdir = Path::Tiny->tempdir;
+my $warnings_file = $tempdir->child('warnings.txt')->stringify;
+
+$pid = fork;
+if (!defined $pid) {
+ die "fork failed: $!\n";
+}
+if ($pid == 0) {
+ run_processes();
+ exit;
+}
+else {
+ waitpid($pid, 0);
+}
+
+my $output = read_warnings($warnings_file);
+
+is $output, 'got lock:exiting:got lock:exiting:got lock:exiting';
+
+# shim a delay in before logit() so that it will wait for the child process
+# to enter the critical section
+sub shim_logit_delay {
+ no warnings 'redefine';
+
+ my $orig_logit = \&Log::Dispatch::FileRotate::logit;
+ *Log::Dispatch::FileRotate::logit = sub {
+ sleep 3;
+ &$orig_logit(@_);
+ };
+}
+
+sub run_processes {
+ open my $warnfh, '+>', $warnings_file
+ or die "Failed to open warnings file: $!";
+
+ $warnfh->autoflush(1);
+
+ $SIG{__WARN__} = sub {
+ my $msg = shift;
+
+ # we only want the "got lock" and "exiting" lines
+ if ($msg =~ /got lock/ or $msg =~ /exiting/) {
+ # strip off pid numbers from front of message
+ $msg =~ s/^[0-9]+ //;
+
+ # save in the warnings file
+ print $warnfh $msg;
+ }
+ };
+
+ my $file = Log::Dispatch::FileRotate->new(
+ filename => $tempdir->child('test.log')->stringify,
+ min_level => 'info',
+ DEBUG => 1);
+
+ my $child1_pid = fork;
+ if ($child1_pid == 0) {
+ $file->log(level => 'info', message => "first_child\n");
+ }
+ else {
+ sleep 1;
+ my $child2_pid = fork;
+ if ($child2_pid == 0) {
+ $file->log(level => 'info', message => "second_child\n");
+ }
+ else {
+ waitpid($child1_pid, 0);
+ $file->log(level => 'info', message => "parent\n");
+ }
+ }
+
+ warn "$$ exiting\n";
+
+ delete $SIG{__WARN__};
+ close $warnfh;
+}
+
+sub read_warnings {
+ my $file = shift;
+
+ local $/ = undef;
+
+ open my $fh, '<', $file;
+
+ my $content = <$fh>;
+
+ $content =~ s/[\r\n]+$//s;
+ $content =~ s/[\r\n]+/:/sg;
+
+ return $content;
+}
