#! /usr/local/bin/perl
eval 'exec perl -S $0 ${1+"$@"} ;' unless 1;

# This code forces a perl filehandle to be opened with O_APPEND so
# proper atomic appending can be done from perl.  The normal perl open
# just seeks to what the end of the file is when the open happens and
# is not safe for multiple writers of logfiles.
#
# Corey Satten, corey @ cac.washington.edu, 3/21/96
# http://staff.washington.edu/corey

#require("syscall.ph");			# inline for speed, may lose portability
    sub SYS_write {4;}
    sub SYS_open {5;}
    sub SYS_close {6;}
    sub SYS_dup2 {90;}

#require("sys/file.ph");		# inline for speed, may lose portability
    sub O_WRONLY {001;}
    sub O_APPEND {010;}

#===============================================================================
# usage example: open the file, have another process append, then we append.
# if one were to use open(LOGFILE, ">>outfile"), the shell output would be lost.
#===============================================================================

$demonstrate_problem = 0;		# change this to 1 to see the problem
if ($demonstrate_problem) {
    open(LOGFILE, ">>outfile");		# this shows the problem
    }
else {
    &open_append(LOGFILE, "outfile");	# this fixes the problem
    }
system("echo this is from a shell >> outfile");
print LOGFILE "this is from perl\n";
close(LOGFILE);

#args: filehandle to create, filename to open
sub open_append {
    local(*HANDLE, $path) = @_;
    local($fd, $rv);
    open(HANDLE, ">>$path");		# to create a handle
    $fd = syscall(&SYS_open, "$path", &O_WRONLY + &O_APPEND, 0666);
    if ($fd < 0 ) {
	close(HANDLE); warn("couldn't syscall O_APPEND");
	return(0);
	}
    $rv = syscall(&SYS_dup2, $fd, fileno(HANDLE));
    if ($rv < 0 ) {
	close(HANDLE); warn("couldn't dup2 in open_append");
	return(0);
	}
    syscall(&SYS_close, $fd);
    return(1);
    }