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) { };