Open-ILS/src/perlmods/lib/OpenILS/Utils/Lockfile.pm

   1 package OpenILS::Utils::Lockfile;
   2
   3 # ---------------------------------------------------------------
   4 # Copyright (C) 2010 Equinox Software, Inc
   5 # Author: Joe Atzberger <jatzberger@esilibrary.com>
   6 #
   7 # This program is free software; you can redistribute it and/or
   8 # modify it under the terms of the GNU General Public License
   9 # as published by the Free Software Foundation; either version 2
  10 # of the License, or (at your option) any later version.
  11
  12 # This program is distributed in the hope that it will be useful,
  13 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 # GNU General Public License for more details.
  16 # ---------------------------------------------------------------
  17
  18 # The purpose of this module is to consolidate
  19 # non-duplicative processing, i.e. lockfiles and lockfile checking
  20
  21 use strict;
  22 use warnings;
  23 use Carp;
  24
  25 use File::Basename qw/fileparse/;
  26
  27 sub _tempdir {
  28     return $ENV{TEMP} || $ENV{TMP} || '/tmp';
  29 }
  30
  31 our $debug =  0;
  32
  33 sub default_filename {
  34    my $tempdir = _tempdir;
  35    my $filename = fileparse($0, '.pl');
  36    return "$tempdir/$filename-LOCK";
  37 }
  38
  39 sub new {
  40     my $class    = shift;
  41     my $lockfile = @_ ? shift : default_filename;
  42
  43     croak "Script already running with lockfile $lockfile" if -e $lockfile;
  44     $debug and print "Writing lockfile $lockfile (PID: $$)\n";
  45
  46     open (F, ">$lockfile") or croak "Cannot write to lockfile '$lockfile': $!";
  47     print F $$;
  48     close F;
  49
  50     my $self = {
  51         filename => $lockfile,
  52         contents => $$,
  53     };
  54     return bless ($self, $class);
  55 }
  56
  57 sub filename {
  58     my $self = shift;
  59     return $self->{filename};
  60 }
  61 sub contents {
  62     my $self = shift;
  63     return $self->{contents};
  64 }
  65
  66 DESTROY {
  67     my $self = shift;
  68     # lockfile cleanup
  69     if (-e $self->{filename}) {
  70         open LF, $self->{filename};
  71         my $contents = <LF>;
  72         close LF;
  73         $debug and print "deleting lockfile $self->{filename}\n";
  74         if ($contents == $self->{contents}) {
  75             unlink $self->{filename} or carp "Failed to remove lockfile '$self->{filename}'";
  76         } else {
  77             carp "Lockfile contents '$contents' no longer match '$self->{contents}'.  Cannot remove $self->{filename}";
  78         }
  79
  80     }
  81 }
  82
  83 1;