* Actually export the lockpid function

[debbugs.git] / Debbugs / Common.pm

diff --git a/Debbugs/Common.pm b/Debbugs/Common.pm
index 86f9abc8344599c8180920d2fd2291b07b598942..46788e3f574127db62aab41c98a5530b0612e691 100644 (file)
--- a/Debbugs/Common.pm
+++ b/Debbugs/Common.pm
@@ -1,3 +1,11 @@
+# This module is part of debbugs, and is released
+# under the terms of the GPL version 2, or any later
+# version at your option.
+# See the file README and COPYING for more information.
+#
+# [Other people have contributed to this file; their copyrights should
+# go here too.]
+# Copyright 2007 by Don Armstrong <don@donarmstrong.com>.
 
 package Debbugs::Common;
 
@@ -34,11 +42,13 @@ BEGIN{
                                qw(appendfile buglog getparsedaddrs getmaintainers),
                                qw(getmaintainers_reverse)
                               ],
+                    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 util));
+     Exporter::export_ok_tags(qw(lock quit date util misc));
      $EXPORT_TAGS{all} = [@EXPORT_OK];
 }
 
@@ -180,7 +190,7 @@ sub appendfile {
 =head2 getparsedaddrs
 
      my $address = getparsedaddrs($address);
-     my @address = getpasredaddrs($address);
+     my @address = getparsedaddrs($address);
 
 Returns the output from Mail::Address->parse, or the cached output if
 this address has been parsed before. In SCALAR context returns the
@@ -189,7 +199,7 @@ first address parsed.
 =cut
 
 
-my %_parsedaddrs;
+our %_parsedaddrs;
 sub getparsedaddrs {
     my $addr = shift;
     return () unless defined $addr;
@@ -199,8 +209,8 @@ sub getparsedaddrs {
     return wantarray?@{$_parsedaddrs{$addr}}:$_parsedaddrs{$addr}[0];
 }
 
-my $_maintainer;
-my $_maintainer_rev;
+our $_maintainer;
+our $_maintainer_rev;
 sub getmaintainers {
     return $_maintainer if $_maintainer;
     my %maintainer;
@@ -230,6 +240,32 @@ sub getmaintainers_reverse{
      return $_maintainer_rev;
 }
 
+=head1 DATE
+
+    my $english = secs_to_english($seconds);
+    my ($days,$english) = secs_to_english($seconds);
+
+XXX This should probably be changed to use Date::Calc
+
+=cut
+
+sub secs_to_english{
+     my ($seconds) = @_;
+
+     my $days = int($seconds / 86400);
+     my $years = int($days / 365);
+     $days %= 365;
+     my $result;
+     my @age;
+     push @age, "1 year" if ($years == 1);
+     push @age, "$years years" if ($years > 1);
+     push @age, "1 day" if ($days == 1);
+     push @age, "$days days" if ($days > 1);
+     $result .= join(" and ", @age);
+
+     return wantarray?(int($seconds/86400),$result):$result;
+}
+
 
 =head1 LOCK
 
@@ -243,7 +279,7 @@ FLOCKs the passed file. Use unfilelock to unlock it.
 
 =cut
 
-my @filelocks;
+our @filelocks;
 our @cleanups;
 
 sub filelock {
@@ -305,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
@@ -329,6 +397,25 @@ sub quit {
     die "*** $_[0]\n";
 }
 
+=head1 MISC
+
+These functions are exported with the :misc tag
+
+=head2 make_list
+
+     LIST = make_list(@_);
+
+Turns a scalar or an arrayref into a list; expands a list of arrayrefs
+into a list.
+
+That is, make_list([qw(a b c)]); returns qw(a b c); make_list([qw(a
+b)],[qw(c d)] returns qw(a b c d);
+
+=cut
+
+sub make_list {
+     return map {(ref($_) eq 'ARRAY')?@{$_}:$_} @_;
+}