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;