[Bio] / FigKernelPackages / FileLocking.pm Repository:
ViewVC logotype

View of /FigKernelPackages/FileLocking.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (download) (as text) (annotate)
Wed Sep 5 21:00:42 2007 UTC (12 years, 5 months ago) by olson
Branch: MAIN
CVS Tags: rast_rel_2009_05_18, rast_rel_2008_06_18, rast_rel_2008_06_16, rast_rel_2008_12_18, rast_rel_2008_07_21, rast_2008_0924, rast_rel_2008_04_23, rast_rel_2008_09_30, rast_rel_2009_0925, rast_rel_2010_0118, mgrast_rel_2008_0924, mgrast_rel_2008_1110_v2, rast_rel_2009_02_05, mgrast_rel_2008_0625, rast_rel_2008_10_09, rast_release_2008_09_29, mgrast_rel_2008_0806, mgrast_rel_2008_0923, mgrast_rel_2008_0919, rast_rel_2009_07_09, mgrast_rel_2008_1110, rast_rel_2008_09_29, mgrast_rel_2008_0917, rast_rel_2008_10_29, rast_rel_2009_03_26, rast_rel_2008_11_24, rast_rel_2008_08_07
Changes since 1.1: +11 -2 lines
add shared locking

package FileLocking;

#
# Package that uses fcntl to implement flock. Use this on systems that use
# GPFS to properly implement file locking between machines.
#
# Allows for a global override of flock.
#

use Data::Dumper;
use strict;
use Carp;
use Fcntl qw/:DEFAULT :seek :flock/;
use Symbol 'qualify_to_ref';

use vars qw(@ISA @EXPORT_OK @EXPORT);

require Exporter;
@ISA = 'Exporter';

@EXPORT_OK = qw(flock lock_file unlock_file lock_file_shared);
@EXPORT = qw(lock_file unlock_file lock_file_shared);

use FIG_Config;

sub import {
    my $pkg = shift;
    return unless @_;

    my $sym = shift;
    my $where = ($sym =~ s/^GLOBAL_// ? 'CORE::GLOBAL' : caller(0));
#    print "IMPORT $pkg @_ to $where\n";
    $pkg->export($where, $sym, @_);
}

sub lock_file(*)
{
    my($fh) = @_;

    $fh = qualify_to_ref($fh, caller());

    return FileLocking::flock($fh, LOCK_EX);
}

sub lock_file_shared(*)
{
    my($fh) = @_;

    $fh = qualify_to_ref($fh, caller());

    return FileLocking::flock($fh, LOCK_SH);
}

sub unlock_file(*)
{
    my($fh) = @_;

    $fh = qualify_to_ref($fh, caller());

    return FileLocking::flock($fh, LOCK_UN);
}


sub flock(*$)
{
    my($fh, $op) = @_;

    $fh = qualify_to_ref($fh, caller());

    if ($FIG_Config::fcntl_locking)
    {
	return fcntl_flock($fh, $op);
    }
    else
    {
	return CORE::flock($fh, $op);
    }
}

sub fcntl_flock(*$)
{
    my($fh, $op) = @_;

    $fh = qualify_to_ref($fh, caller());
#    print "flock: fh='$fh' op='$op' fno=" . fileno($fh) . "\n";

    if ($op == LOCK_EX)
    {
 	my $arg = pack("ssll", F_WRLCK, SEEK_SET, 0, 0);
	my $rc = fcntl($fh, F_SETLKW, $arg);
#	print "flock: LOCK_EX returns $rc\n";
	return $rc;
    }
    elsif ($op == LOCK_SH)
    {
	my $arg = pack("ssll", F_RDLCK, SEEK_SET, 0, 0);
	my $rc = fcntl($fh, F_SETLKW, $arg);
#	print "flock: LOCK_SH returns $rc\n";
	return $rc;
    }
    elsif ($op == LOCK_UN)
    {
	my $arg = pack("ssll", F_UNLCK, SEEK_SET, 0, 0);
	my $rc = fcntl($fh, F_SETLKW, $arg);
#	print "flock: LOCK_UN returns $rc\n";
	return $rc;
    }
    else
    {
	confess "flock: invalid operation $op";
    }
}

1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3