[project @ 2002-10-06 22:54:48 by cjwatson]

[debbugs.git] / scripts / errorlib.in

diff --git a/scripts/errorlib.in b/scripts/errorlib.in
index fc775643d0f38e8ae58a881a2405dce0878dfed2..85250b995c71ddf40441c9da7f833a57d0cad463 100755 (executable)
--- a/scripts/errorlib.in
+++ b/scripts/errorlib.in
@@ -1,9 +1,14 @@
 # -*- perl -*-
-# $Id: errorlib.in,v 1.3 1999/12/01 18:04:01 gecko Exp $
+# $Id: errorlib.in,v 1.7 2002/10/06 22:54:48 cjwatson Exp $
 
 sub F_SETLK { 6; } sub F_WRLCK{ 1; }
 $flockstruct= 'sslll'; # And there ought to be something for this too.
 
+sub get_hashname {
+    return "" if ( $_[ 0 ] < 0 );
+    return sprintf "%02d", $_[ 0 ] % 100;
+}
+
 sub unlockreadbugmerge {
     local ($rv) = @_;
     &unfilelock if $rv >= 2;
@@ -97,6 +102,79 @@ sub sani {
     $out;
 }
 
+sub bughook {
+       my ( $type, $ref ) = ( shift, shift );
+       &filelock("debbugs.trace.lock");
+       &appendfile("debbugs.trace","$type $ref\n",@_);
+       my @stuff=split/\n/, "$_[0]\n\n\n\n\n\n\n";
+       # XXX: bug: this'll only keep the most recent update until index.db
+       #      starts getting overwritten by index.db.realtime after update
+       my $hash = get_hashname($ref);
+       unlink("$gSpoolDir/db/$ref.status.new");
+       link("$gSpoolDir/db-h/$hash/$ref.status", "$gSpoolDir/db/$ref.status.new");
+       rename("$gSpoolDir/db/$ref.status.new", "$gSpoolDir/db/$ref.status");
+       open(IDXDB, "</org/bugs.debian.org/spool/index.db.realtime")
+               or open(IDXDB, "</org/bugs.debian.org/spool/index.db");
+       open(IDXNEW, ">/org/bugs.debian.org/spool/index.db.realtime.new");
+       while(my $line = <IDXDB>) {
+               @line = split /\s/, $line;
+               last if ($line[1] == $ref);
+               print IDXNEW $line;
+       }
+       my $firstpkg;
+       my $whendone = "open";
+       my $severity = $gDefaultSeverity;
+       ($firstpkg = $stuff[4]) =~ s/[,\s].*$//;
+       $whendone = "forwarded" if length $stuff[7];
+       $whendone = "done" if length $stuff[6];
+       $severity = $stuff[9] if length $stuff[9];
+
+       printf IDXNEW "%s %d %d %s [%s] %s %s\n",
+                       $firstpkg, $ref, $stuff[1], $whendone, $stuff[0],
+                       $severity, $stuff[5];
+       print IDXNEW while(<IDXDB>);
+       close(IDXNEW);
+       close(IDXDB);
+       rename("/org/bugs.debian.org/spool/index.db.realtime.new",
+               "/org/bugs.debian.org/spool/index.db.realtime");
+       &unfilelock;
+}
+
+sub appendfile {
+       my $file = shift;
+       if (!open(AP,">>$file")) {
+               print DEBUG "failed open log<\n";
+               print DEBUG "failed open log err $!<\n";
+               &quit("opening $file (appendfile): $!");
+       }
+       print(AP @_) || &quit("writing $file (appendfile): $!");
+       close(AP) || &quit("closing $file (appendfile): $!");
+}
+
+sub getmailbody {
+       my $entity = shift;
+       my $type = $entity->effective_type;
+       if ($type eq 'text/plain' or
+           ($type =~ m#text/# and $type ne 'text/html')) {
+               return $entity->bodyhandle;
+       } elsif ($type eq 'multipart/alternative') {
+               # RFC 2046 says we should use the last part we recognize.
+               for my $part (reverse $entity->parts) {
+                       my $ret = getmailbody($part);
+                       return $ret if $ret;
+               }
+       } else {
+               # For other multipart types, we just pretend they're
+               # multipart/mixed and run through in order.
+               for my $part ($entity->parts) {
+                       my $ret = getmailbody($part);
+                       return $ret if $ret;
+               }
+       }
+       return undef;
+}
+
+
 @severities= @gSeverityList;
 @showseverities= @severities;
 grep ($_= $_ eq '' ? $gDefaultSeverity : $_, @showseverities);