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

View of /FigKernelPackages/FileLocking.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (download) (as text) (annotate)
Tue Aug 10 19:38:47 2010 UTC (9 years, 4 months ago) by olson
Branch: MAIN
CVS Tags: mgrast_dev_08112011, mgrast_dev_08022011, rast_rel_2014_0912, myrast_rel40, mgrast_dev_05262011, mgrast_dev_04082011, rast_rel_2010_0928, mgrast_version_3_2, mgrast_dev_12152011, mgrast_dev_06072011, rast_rel_2014_0729, mgrast_dev_02212011, rast_rel_2010_1206, mgrast_release_3_0, mgrast_dev_03252011, rast_rel_2011_0119, mgrast_release_3_0_4, mgrast_release_3_0_2, mgrast_release_3_0_3, mgrast_release_3_0_1, mgrast_dev_03312011, mgrast_release_3_1_2, mgrast_release_3_1_1, mgrast_release_3_1_0, mgrast_dev_04132011, mgrast_dev_04012011, rast_rel_2010_0827, myrast_33, rast_rel_2011_0928, mgrast_dev_04052011, mgrast_dev_02222011, mgrast_dev_10262011, HEAD
Changes since 1.3: +10 -1 lines
Changes for DesktopRast.
CVHnS: ----------------------------------------------------------------------

package FileLocking;


#
# This is a SAS component.
#
# 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/;

our $have_FcntlLock;

BEGIN {
    eval {
	require File::FcntlLock;
	$have_FcntlLock++;
    };
}

use Symbol 'qualify_to_ref';

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

require Exporter;
@ISA = qw(Exporter);

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

#
# Conditional require for FIG_Config. If not present
# (eg we're in servers client code distribution) we default to using flock.
#
eval {
    require 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 ($have_FcntlLock)
    {
	my $fs = new File::FcntlLock;
	if ($op == LOCK_EX)
	{
	    $fs->l_type( F_WRLCK );
	    $fs->l_whence( SEEK_SET );
	    $fs->l_start( 0 );
	    $fs->l_len( 0 );

	    my $rc = $fs->lock($fh, F_SETLKW);
	    return $rc;
	}
	elsif ($op == LOCK_SH)
	{
	    $fs->l_type( F_RDLCK );
	    $fs->l_whence( SEEK_SET );
	    $fs->l_start( 0 );
	    $fs->l_len( 0 );

	    my $rc = $fs->lock($fh, F_SETLKW);
	    return $rc;
	}
	elsif ($op == LOCK_UN)
	{
	    $fs->l_type( F_UNLCK );
	    $fs->l_whence( SEEK_SET );
	    $fs->l_start( 0 );
	    $fs->l_len( 0 );

	    my $rc = $fs->lock($fh, F_SETLKW);
	    return $rc;
	}
	else
	{
	    confess "flock: invalid operation $op";
	}
    }
    else
    {
    
	if ($op == LOCK_EX)
	{
	    my $arg = pack("ssl!l!", 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("ssl!l!", 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("ssl!l!", 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