* Move code from bugreport.cgi to Debbugs::CGI::Bugreport

[debbugs.git] / Debbugs / Common.pm

diff --git a/Debbugs/Common.pm b/Debbugs/Common.pm
index 9776392eef2c7fc307f4fc442a18c233d46a4f15..8d837291274afee68326b54a2ca1cab4b98364ce 100644 (file)
--- a/Debbugs/Common.pm
+++ b/Debbugs/Common.pm
@@ -40,14 +40,16 @@ BEGIN{
      @EXPORT = ();
      %EXPORT_TAGS = (util   => [qw(getbugcomponent getbuglocation getlocationpath get_hashname),
                                qw(appendfile buglog getparsedaddrs getmaintainers),
-                               qw(getmaintainers_reverse)
+                               qw(getmaintainers_reverse),
+                               qw(getpseudodesc),
                               ],
                     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 misc));
+     Exporter::export_ok_tags(qw(lock quit date util misc));
      $EXPORT_TAGS{all} = [@EXPORT_OK];
 }
 
@@ -204,7 +206,11 @@ sub getparsedaddrs {
     return () unless defined $addr;
     return wantarray?@{$_parsedaddrs{$addr}}:$_parsedaddrs{$addr}[0]
         if exists $_parsedaddrs{$addr};
-    @{$_parsedaddrs{$addr}} = Mail::Address->parse($addr);
+    {
+        # don't display the warnings from Mail::Address->parse
+        local $SIG{__WARN__} = sub { };
+        @{$_parsedaddrs{$addr}} = Mail::Address->parse($addr);
+    }
     return wantarray?@{$_parsedaddrs{$addr}}:$_parsedaddrs{$addr}[0];
 }
 
@@ -214,7 +220,7 @@ sub getmaintainers {
     return $_maintainer if $_maintainer;
     my %maintainer;
     my %maintainer_rev;
-    for my $file (@config{qw(maintainer_file maintainer_file_override)}) {
+    for my $file (@config{qw(maintainer_file maintainer_file_override pseduo_maint_file)}) {
         next unless defined $file;
         my $maintfile = new IO::File $file,'r' or
              &quitcgi("Unable to open $file: $!");
@@ -239,6 +245,66 @@ sub getmaintainers_reverse{
      return $_maintainer_rev;
 }
 
+=head2 getpseudodesc
+
+     my $pseudopkgdesc = getpseudodesc(...);
+
+Returns the entry for a pseudo package from the
+$config{pseudo_desc_file}. In cases where pseudo_desc_file is not
+defined, returns an empty arrayref.
+
+This function can be used to see if a particular package is a
+pseudopackage or not.
+
+=cut
+
+our $_pseudodesc;
+sub getpseudodesc {
+    return $_pseudodesc if $_pseudodesc;
+    my %pseudodesc;
+
+    if (not defined $config{pseudo_desc_file}) {
+        $_pseudodesc = {};
+        return $_pseudodesc;
+    }
+    my $pseudo = IO::File->new($config{pseudo_desc_file},'r')
+        or die "Unable to open $config{pseudo_desc_file}: $!";
+    while(<$pseudo>) {
+       next unless m/^(\S+)\s+(\S.*\S)\s*$/;
+       $pseudodesc{lc $1} = $2;
+    }
+    close($pseudo);
+    $_pseudodesc = \%pseudodesc;
+    return $_pseudodesc;
+}
+
+
+=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
 
@@ -314,6 +380,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
@@ -332,7 +430,7 @@ instead. (Or possibly a die handler, if the cleanups are important)
 =cut
 
 sub quit {
-    print $DEBUG_FH "quitting >$_[0]<\n" if $DEBUG;
+    print {$DEBUG_FH} "quitting >$_[0]<\n" if $DEBUG;
     my ($u);
     while ($u= $cleanups[$#cleanups]) { &$u; }
     die "*** $_[0]\n";