* Actually export the lockpid function

[debbugs.git] / Debbugs / Common.pm

diff --git a/Debbugs/Common.pm b/Debbugs/Common.pm
index 60e2c3092adbb312dba3bc7c516fca748671ed4e..46788e3f574127db62aab41c98a5530b0612e691 100644 (file)
--- a/Debbugs/Common.pm
+++ b/Debbugs/Common.pm
@@ -45,7 +45,7 @@ BEGIN{
                     misc   => [qw(make_list)],
                     date   => [qw(secs_to_english)],
                     quit   => [qw(quit)],
-                    lock   => [qw(filelock unfilelock @cleanups)],
+                    lock   => [qw(filelock unfilelock @cleanups lockpid)],
                    );
      @EXPORT_OK = ();
      Exporter::export_ok_tags(qw(lock quit date util misc));
@@ -254,7 +254,7 @@ sub secs_to_english{
 
      my $days = int($seconds / 86400);
      my $years = int($days / 365);
-     $days -= $years * 365;
+     $days %= 365;
      my $result;
      my @age;
      push @age, "1 year" if ($years == 1);
@@ -263,7 +263,7 @@ sub secs_to_english{
      push @age, "$days days" if ($days > 1);
      $result .= join(" and ", @age);
 
-     return wantarray?($days,$result):$result;
+     return wantarray?(int($seconds/86400),$result):$result;
 }
 
 
@@ -341,6 +341,38 @@ sub unfilelock {
         or warn "Unable to unlink lockfile $fl{file}: $!";
 }
 
+=head2 lockpid
+
+      lockpid('/path/to/pidfile');
+
+Creates a pidfile '/path/to/pidfile' if one doesn't exist or if the
+pid in the file does not respond to kill 0.
+
+Returns 1 on success, false on failure; dies on unusual errors.
+
+=cut
+
+sub lockpid {
+     my ($pidfile) = @_;
+     if (-e $pidfile) {
+         my $pidfh = IO::File->new($pidfile, 'r') or
+              die "Unable to open pidfile $pidfile: $!"
+         local $/;
+         my $pid = <$pidfh>;
+         ($pid) = $pid =~ /(\d+)/;
+         if (defined $pid and kill(0,$pid)) {
+              return 0;
+         }
+         close $pidfh;
+         unlink $pidfile or
+              die "Unable to unlink stale pidfile $pidfile $!";
+     }
+     my $pidfh = IO::File->new($pidfile), 'w' or
+         die "Unable to open $pidfile for writing: $!";
+     print {$pidfh} $$ or die "Unable to write to $pidfile $!";
+     close $pidfh or die "Unable to close $pidfile $!";
+     return 1;
+}
 
 
 =head1 QUIT