vsespb has asked for the wisdom of the Perl Monks concerning the following question:
outputs the following (tested on Linux, perl 5.10 and 5.18):use strict; use warnings; use Carp; use File::Copy; use Fcntl qw/LOCK_SH LOCK_EX LOCK_NB LOCK_UN/; sub x_copy # NOT USED { my ($src, $dst) = @_; open (my $f, "<", $src) or confess; binmode $f; read $f, my $buf, -s $f or confess ; close $f; open (my $o, ">", $dst) or confess; binmode $o; print $o $buf; close $o; } sub getlock { open my $f, ">", "lock.tmp" or confess; flock $f, LOCK_EX or confess; shift->(); flock $f, LOCK_UN or confess; close $f; } for (1..5) { unless (fork()) { for (1..5) { my $filename = "somefile$_.tmp"; my $f=undef; getlock sub { unless (-e $filename) { open ($f, ">", $filename) or confess; binmode $f; } }; if ($f) { print ($f "x") for (1..40_000_000); close $f; } my $newfilename = "c_${$}_$filename"; unless (-e $newfilename) { copy($filename, $newfilename) or confess; die if -s $filename != -s $newfilename; } } exit; } } while (wait != -1) { };
-rw-r--r-- 1 vse vse 40000000 2013-09-28 19:10 c_24171_somefile1.tmp -rw-r--r-- 1 vse vse 40000000 2013-09-28 19:10 c_24171_somefile2.tmp -rw-r--r-- 1 vse vse 40000000 2013-09-28 19:10 c_24171_somefile3.tmp -rw-r--r-- 1 vse vse 32288768 2013-09-28 19:10 c_24171_somefile4.tmp -rw-r--r-- 1 vse vse 40000000 2013-09-28 19:10 c_24171_somefile5.tmp -rw-r--r-- 1 vse vse 0 2013-09-28 19:10 c_24172_somefile1.tmp -rw-r--r-- 1 vse vse 40000000 2013-09-28 19:10 c_24172_somefile2.tmp -rw-r--r-- 1 vse vse 40000000 2013-09-28 19:10 c_24172_somefile3.tmp -rw-r--r-- 1 vse vse 28540928 2013-09-28 19:10 c_24172_somefile4.tmp -rw-r--r-- 1 vse vse 40000000 2013-09-28 19:10 c_24172_somefile5.tmp -rw-r--r-- 1 vse vse 0 2013-09-28 19:10 c_24173_somefile1.tmp -rw-r--r-- 1 vse vse 0 2013-09-28 19:10 c_24173_somefile2.tmp -rw-r--r-- 1 vse vse 40000000 2013-09-28 19:10 c_24173_somefile3.tmp -rw-r--r-- 1 vse vse 21893120 2013-09-28 19:10 c_24173_somefile4.tmp -rw-r--r-- 1 vse vse 40000000 2013-09-28 19:10 c_24173_somefile5.tmp -rw-r--r-- 1 vse vse 0 2013-09-28 19:10 c_24174_somefile1.tmp -rw-r--r-- 1 vse vse 0 2013-09-28 19:10 c_24174_somefile2.tmp -rw-r--r-- 1 vse vse 0 2013-09-28 19:10 c_24174_somefile3.tmp -rw-r--r-- 1 vse vse 40000000 2013-09-28 19:10 c_24174_somefile4.tmp -rw-r--r-- 1 vse vse 40000000 2013-09-28 19:10 c_24174_somefile5.tmp -rw-r--r-- 1 vse vse 0 2013-09-28 19:10 c_24175_somefile1.tmp -rw-r--r-- 1 vse vse 0 2013-09-28 19:10 c_24175_somefile2.tmp -rw-r--r-- 1 vse vse 0 2013-09-28 19:10 c_24175_somefile3.tmp -rw-r--r-- 1 vse vse 0 2013-09-28 19:10 c_24175_somefile4.tmp -rw-r--r-- 1 vse vse 40000000 2013-09-28 19:10 c_24175_somefile5.tmp -rw-r--r-- 1 vse vse 0 2013-09-28 19:10 lock.tmp -rw-r--r-- 1 vse vse 40000000 2013-09-28 19:10 somefile1.tmp -rw-r--r-- 1 vse vse 40000000 2013-09-28 19:10 somefile2.tmp -rw-r--r-- 1 vse vse 40000000 2013-09-28 19:10 somefile3.tmp -rw-r--r-- 1 vse vse 40000000 2013-09-28 19:10 somefile4.tmp -rw-r--r-- 1 vse vse 40000000 2013-09-28 19:10 somefile5.tmpSo:
die if -s $filename != -s $newfilename;
read $f, my $buf, -s $f or confess ;
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re: Strange IO + concurrency issue
by davido (Cardinal) on Sep 28, 2013 at 16:39 UTC | |
by vsespb (Chaplain) on Sep 28, 2013 at 17:11 UTC | |
by ig (Vicar) on Sep 30, 2013 at 05:50 UTC | |
by vsespb (Chaplain) on Sep 30, 2013 at 08:28 UTC | |
|
Re: Strange IO + concurrency issue
by RichardK (Parson) on Sep 28, 2013 at 16:44 UTC | |
by vsespb (Chaplain) on Sep 28, 2013 at 17:16 UTC |