public
anonymous / 5553595.pl
Created

syswrite does not block other writers

  • Download Gist
5553595.pl
Perl
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60
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

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.