<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package Parp::Locking;

=head1 NAME

Parp::Locking - advisory file locking routines

=head1 SYNOPSIS

Used internally.

=head1 DESCRIPTION

Routines for performing advisory locking on file names and handles.

=cut

use strict;
use warnings;

use Fcntl qw(:DEFAULT :flock);

use Parp::Config qw(config);
use Parp::Utils qw(check_file_dir vprint);

use base 'Exporter';
our @EXPORT = qw(lock_ident unlock_ident lock_file unlock_file);

# The file handles have to stay in scope somewhere, otherwise they
# get closed, releasing the lock.
my %handles = ();

sub _get_lock_name {
  my ($ident) = @_;

  my $lock_dir = config-&gt;lock_dir;
  die "No lock_dir specified in config\n" unless $lock_dir;
  my $lock_file = "$lock_dir/$ident";
  check_file_dir($lock_file);

  if (! -e $lock_file) {
    open(my $fh, "&gt;$lock_file")
      or fatal(3, "Couldn't create lock file $lock_file: $!");
  }

  return $lock_file;
}

sub _get_fh {
  my ($lock_file) = @_;
  open($handles{$lock_file}, $lock_file) 
    or fatal(4, "Couldn't open lock file $lock_file: $!");
  return $handles{$lock_file};
}

sub lock_ident {
  my ($ident) = @_;
  lock_file(_get_lock_name($ident));
}

sub unlock_ident {
  my ($ident) = @_;
  unlock_file(_get_lock_name($ident));
}

sub lock_file {
  my ($lock_file, $fh) = @_;
  $fh ||= _get_fh($lock_file);
  my $wait = 0;
  until (flock $fh, LOCK_EX | LOCK_NB) {
    vprint "\n" if $wait;
    vprint "Waiting for exclusive lock on $lock_file ... ";
    $wait++;
    sleep 1;
  }
  vprint "got it!\n" if $wait;
}

sub unlock_file {
  my ($lock_file, $fh) = @_;
  $fh ||= _get_fh($lock_file);
  flock($fh, LOCK_UN) or die "Failed to unlock $lock_file\n";
}

1;
</pre></body></html>