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 - co...@suse.com
+
+- 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 - co...@suse.com
+
+- 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;
+}


Reply via email to