Skip to content

anonymous /5553595.pl

syswrite does not block other writers
use strict;
use warnings;
my $blk_size = 6000;
my $num_blks = 20;
sub work {
my ($ch) = @_;
my $blk = $ch x $blk_size;
for (1..$num_blks) {
open(my $fh, '>>', 'file') or die $!;
my $rv = syswrite($fh, $blk) or die $!;
die("Partial write") if $rv != $blk_size;
}
}
sub child {
if (eval { &work; 1 }) {
exit(0);
} else {
print(STDERR $@);
exit($! || $? || 255);
}
}
waitpid($_, 0) for map { fork || child($_) } 0..9;
{
open(my $fh, '<', 'file') or die $!;
local $/ = \(1024*64);
my $last = '';
my $count = 0;
while (<$fh>) {
for (split //) {
if ($_ ne $last || $count == $blk_size) {
print("$last: $count\n") if $count;
$last = $_;
$count = 0;
}
++$count;
}
}
print("$last: $count\n") if $count;
}
__END__
$ perl a.pl | grep -v 6000
0: 4000
2: 4000
1: 4000
2: 4000
1: 4000
2: 4000
0: 2000
6: 4000
7: 4000
8: 4000
^C
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Something went wrong with that request. Please try again.