Perl Net::Server Log Buffer cuts off at 4096 characters - perl

Question

I am using Perl Net::Server and using the built in log method like
$self->log( 1, lc( $json->encode($callInfo) ) );
The issue that I am having is sometimes the data in $callInfo is larger than 4096 characters and it writes 4096 characters to the log file and then a child writes to the log with it's $callInfo and then the rest of the original $callInfo gets logged.
Example:
Assuming abcdef is over 4096 characters.
callinfo1 -> child process tries to write 'abcdef' to log where 'abc' would be written and interrupted by the next child process
callinfo2 -> another child process writes to the log and then the remaining data 'def' from callinfo1 would get written.
I have tried adding the following and change the buffer size to 8192 but the issue remains.
sub post_configure {
94 my $self = shift;
95 my $prop = $self->{server};
96 $prop->{log_level} = 1;
97
98 if( $prop->{log_file} ){
99 local $/ = 8192;
100 open(_SERVER_LOG, ">>$prop->{log_file}") or die "Couldn't open log file \"$prop->{log_file}\" [$!].";
101 _SERVER_LOG->autoflush(1);
102 #open(our $logHandler, '>>', $prop->{log_file});
103 #$logHandler->autoflush(1);
104 $prop->{chown_log_file} = 1;
105 }
106 }
107
108 sub log {
109 my $self = shift;
110 my $prop = $self->{server};
111 my $level = shift;
112 $self->write_to_log_hook($level,#_);
113 }
114
115
116 sub write_to_log_hook {
117 my $self = shift;
118 my $prop = $self->{server};
119 my $level = shift;
120 local $_ = shift || '';
121 chomp;
122 s/([^\n\ -\~])/sprintf("%%%02X",ord($1))/eg;
123
124 if( $prop->{log_file} ){
125 #if(substr($_, 0, 1) eq '{')
126 #{
127 print _SERVER_LOG $_, "\n";
128 #print $logHandler $_, "\n";
129 #}
130 }
131 }
Any ideas on how to get the log buffer to finish before another child process logs?
Thanks in advance.

Answer 1

Perl doesn't send everything to OS at once, even with autoflush, so it's possible for a print to be interrupted by other processes.
$ strace perl -e'STDOUT->autoflush; print "x" x 9999' 2>&1 >/dev/null | grep write
write(1, "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"..., 8192) = 8192
write(1, "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"..., 1807) = 1807
That said, the OS only guarantees that writes under a certain size are atomic, so large prints could still be interrupted even if Perl sent everything to the OS at once.
This means it's up to the processes to synchronize themselves using some form of mutual exclusion (e.g. by using a lock).