view release on metacpan or  search on metacpan

lib/File/NFSLock.pm  view on Meta::CPAN

#  $Id: NFSLock.pm,v 1.29 2018/11/01 14:00:00 bbb Exp $
#
#  Copyright (C) 2002, Paul T Seamons
#                      paul@seamons.com
#                      http://seamons.com/
#
#                      Rob B Brown
#                      bbb@cpan.org
#
#  This package may be distributed under the terms of either the
#  GNU General Public License
#    or the
#  Perl Artistic License
#
#  All rights reserved.
#
#  Please read the perldoc File::NFSLock
#
################################################################

package File::NFSLock;

use strict;
use warnings;

use Carp qw(croak confess);
our $errstr;
use base 'Exporter';
our @EXPORT_OK = qw(uncache);

our $VERSION = '1.29';

#Get constants, but without the bloat of
#use Fcntl qw(LOCK_SH LOCK_EX LOCK_NB);
use constant {
   LOCK_SH => 1,
   LOCK_EX => 2,
   LOCK_NB => 4,
};

### Convert lock_type to a number
our $TYPES = {
  BLOCKING    => LOCK_EX,
  BL          => LOCK_EX,
  EXCLUSIVE   => LOCK_EX,
  EX          => LOCK_EX,
  NONBLOCKING => LOCK_EX | LOCK_NB,
  NB          => LOCK_EX | LOCK_NB,
  SHARED      => LOCK_SH,
  SH          => LOCK_SH,
};
our $LOCK_EXTENSION = '.NFSLock'; # customizable extension
our $HOSTNAME = undef;
our $SHARE_BIT = 1;

###----------------------------------------------------------------###

my $graceful_sig = sub {
  print STDERR "Received SIG$_[0]\n" if @_;
  # Perl's exit should safely DESTROY any objects
  # still "alive" before calling the real _exit().
  exit 1;
};

our @CATCH_SIGS = qw(TERM INT);

sub new {
  $errstr = undef;

  my $type  = shift;
  my $class = ref($type) || $type || __PACKAGE__;
  my $self  = {};

  ### allow for arguments by hash ref or serially
  if( @_ && ref $_[0] ){
    $self = shift;
  }else{
    $self->{file}      = shift;
    $self->{lock_type} = shift;
    $self->{blocking_timeout}   = shift;
    $self->{stale_lock_timeout} = shift;
  }
  $self->{file}       ||= "";
  $self->{lock_type}  ||= 0;
  $self->{blocking_timeout}   ||= 0;
  $self->{stale_lock_timeout} ||= 0;
  $self->{lock_pid} = $$;
  $self->{unlocked} = 1;
  foreach my $signal (@CATCH_SIGS) {
    if (!$SIG{$signal} ||
        $SIG{$signal} eq "DEFAULT") {
      $SIG{$signal} = $graceful_sig;
    }
  }

  ### force lock_type to be numerical
  if( $self->{lock_type} &&
      $self->{lock_type} !~ /^\d+/ &&
      exists $TYPES->{$self->{lock_type}} ){
    $self->{lock_type} = $TYPES->{$self->{lock_type}};
  }

  ### need the hostname
  if( !$HOSTNAME ){
    require Sys::Hostname;
    $HOSTNAME = Sys::Hostname::hostname();
  }

  ### quick usage check
  croak ($errstr = "Usage: my \$f = $class->new('/pathtofile/file',\n"
         ."'BLOCKING|EXCLUSIVE|NONBLOCKING|SHARED', [blocking_timeout, stale_lock_timeout]);\n"
         ."(You passed \"$self->{file}\" and \"$self->{lock_type}\")")
    unless length($self->{file});

  croak ($errstr = "Unrecognized lock_type operation setting [$self->{lock_type}]")
    unless $self->{lock_type} && $self->{lock_type} =~ /^\d+$/;

  ### Input syntax checking passed, ready to bless
  bless $self, $class;

  ### choose a random filename