#
# lock a file handle
#
# arg 1: reference to file handle
#
# call like this: &lockFile(\*MYFILEHANDLE);
# 
# locking/unlocking should be done in situations when a file handle is
# opened for WRITING, in this sequence:
#   
#            open (FILE, ">some_file.txt");
#            &lockFile(\*FILE);
#            .            
#            . (process your info here)
#            .
#            &unlockFile(\*FILE);
#            close (FILE);
#
#
#
#
sub lockFile
{
    my ($fh);

    $fh = shift;
    
    #
    # win 9x and some really old perls won't support flock
    # this will determine if we have flock capabilities 
    # and write to constant HAS_FLOCK
    #
    use constant HAS_FLOCK => eval { flock STDOUT, 0; 1 };
    
    if (HAS_FLOCK)
    {
        flock ($fh, 2);
    }
}

#
# unlock a filehandle
#
# arg 1: reference to file handle
#
# call like this: &unlockFile(\*MYFILEHANDLE);
# 
sub unlockFile
{
    my ($fh);

    $fh = shift;
    
    if (HAS_FLOCK) # sub lockFile already determined if 'flock' suppor
+ted
    {
        flock ($fh, 8)
    }
}


#
# this implements the storable module's store functionality with locki
+ng
# arg 1: reference to perl data object
# arg 2: filename of storable data file
#
# the latest Storable module supports store_lock, which does this, but
+ it is
# currently not available via ppm installation. So we will use this wr
+apper
# instead. The method is described in the perl cookbook, so it should 
+be
# trustworthy.
#
#
# and since we use our own lockFile and unlockFile functions, locking 
+will
# gracefully NOT be used when it's not supported.
#
sub storeWithLocking
{
    my ($reference, $fn);

    $reference = $_[0];
    $fn = $_[1];

    use Storable qw(store_fd);

    sysopen(DF, "$fn", O_RDWR|O_CREAT, 0666) 
        or die "can't open ${fn}: $!";
    
    &lockFile(\*DF);

    eval ' store_fd($reference, \*DF); ';    

    if ($@)
    {
        print "Error in store_fd call: \"$@\"<BR>\n";
    }
    
    truncate(DF, tell(DF));

    &unlockFile(\*DF);        
    
    close(DF);    
}
[download]

Edit kudra, 2002-08-05 Added a READMORE tag