pidfile.pm - Maintain PID files as guards for long running processes
#!/usr/bin/perl

package pidfile;

use strict;
use Fcntl;
use Exporter ();

@pidfile::ISA = qw(Exporter);
@pidfile::EXPORT = qw(create_pidfile active_pidfile remove_pidfile get_pid cleanup);

%pidfile::active_locks = ();
$pidfile::debug = 0;

local $lock_index;

sub create_pidfile($)
{
  my ($lockfile) = @_;
  my $i;
  my $pid = 0;

RETRY:

  if (sysopen(LOCK, $lockfile, O_CREAT|O_RDWR|O_EXCL)) 
  {
    $pidfile::activelocks{$lockfile} = $$;
    print(LOCK "$$\n");
    close(LOCK);
    return 1;
  }

  if ($pid = &active_pidfile($lockfile))
  {
    print "Aborting due to active lockfile $lockfile process $pid\n";
    return 0;
  }

  print "pidfile::create_pidfile - Stale PID found - trying to remove $lockfile\n";

  &remove_lockfile($lockfile) ? goto RETRY : return 0;
}

sub active_pidfile($)
{
  my ($lockfile) = @_;
  my $pid = &get_pid($lockfile);

  if (kill 0 => $pid)
  {
    return $pid;
  }
  return 0;
}

sub remove_lockfile($)
{
  my ($lockfile) = @_;

  if(unlink $lockfile)
  {
    delete $pidfile::activelocks{$lockfile};
    print "pidfile::remove_lockfile - Removed lockfile $lockfile\n" if $pidfile::debug;
    return 1;
  }
  else
  {
    print "pidfile::remove_lockfile() - Cannot remove inactive lock file $lockfile with pid " . &get_pid($lockfile) . "\n";
    return 0;
  }
}

sub get_pid($)
{
  my ($lockfile) = @_;
  my $pid = 0;

  open(LOCK, $lockfile);
  $pid = <LOCK>;
  close(LOCK);


  if ($pid ne "" && $pid =~ /[0-9][0-9]*/)
  {
    return $pid;
  }
  print STDERR "\npidfile::get_pid - null/non-numeric pid [$pid] from $lockfile\n" if $pidfile::debug;
  return 0;
}

sub cleanup
{
  my $file;

  foreach $file (keys %pidfile::activelocks)
  {
    print STDERR "\npidfile::cleanup - removed lock file $file\n" if $pidfile::debug;
    unlink($file);
  }
}

1;