fix so that msg and dcc replies work

[infobot.git] / src / Modules / DebianExtra.pl

diff --git a/src/Modules/DebianExtra.pl b/src/Modules/DebianExtra.pl
index aabaf49c5107dd6a99a958d91655cde730de0148..8200d4535c322e23a43e8021b1bfad4bb9208466 100644 (file)
--- a/src/Modules/DebianExtra.pl
+++ b/src/Modules/DebianExtra.pl
@@ -7,10 +7,33 @@
 
 use strict;
 
-my $bugs_url = "http://master.debian.org/~wakkerma/bugs";
+package DebianExtra;
+
+sub Parse {
+    my($args) = @_;
+    my($msg) = '';
+
+    #&::DEBUG("DebianExtra: $args\n");
+    if (!defined $args or $args =~ /^$/) {
+       $msg = &debianBugs();
+    } elsif ($args =~ /^(\d+)$/) {
+       # package number:
+       $msg = &do_id($args);
+    } elsif ($args =~ /^(\S+\@\S+)$/) {
+       # package email maintainer.
+       $msg = &do_email($args);
+    } elsif ($args =~ /^(\S+)$/) {
+       # package name.
+       $msg = &do_pkg($args);
+    } else {
+       # invalid.
+       $msg = "error: could not parse $args";
+    }
+    &::performStrictReply($msg);
+}
 
 sub debianBugs {
-    my @results = &main::getURL($bugs_url);
+    my @results = &::getURL("http://master.debian.org/~wakkerma/bugs");
     my ($date, $rcbugs, $remove);
     my ($bugs_closed, $bugs_opened) = (0,0);
 
@@ -29,14 +52,131 @@ sub debianBugs {
                        "It's good to see " :
                        "Oh no, the bug count is rising -- ";
 
-       &main::performStrictReply(
+       &::performStrictReply(
                "Debian bugs statistics, last updated on $date... ".
                "There are \002$rcbugs\002 release-critical bugs;  $xtxt".
                "\002$bugs_closed\002 bugs closed, opening \002$bugs_opened\002 bugs.  ".
                "About \002$remove\002 packages will be removed."
        );
     } else {
-       &main::msg($main::who, "Couldn't retrieve data for debian bug stats.");
+       &::msg($::who, "Couldn't retrieve data for debian bug stats.");
+    }
+}
+
+sub do_id($){
+    my ($bug_num) = shift;
+
+    if (not $bug_num =~ /^\#?\d+$/) {
+       return "Bug is not a number!";
+    }
+    $bug_num =~ s/^\#//;
+    my @results = &::getURL("http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=$bug_num");
+    my $report = join("\n", @results);
+
+    # strip down report to relevant header information.
+    $report =~ s/\r//sig;
+    $report =~ /<BODY[^>]*>(.+?)<HR>/si;
+    $report = $1;
+    my $bug = {};
+    ($bug->{num}, $bug->{title}) = $report =~ m#\#(\d+)\<\/A\>\<BR\>(.+?)\<\/H1\>#is;
+    &::DEBUG("Bugnum: $bug->{num}\n");
+    $bug->{title} =~ s/&lt;/\</g;
+    $bug->{title} =~ s/&gt;/\>/g;
+    $bug->{title} =~ s/&quot;/\"/g;
+    &::DEBUG("Title: $bug->{title}\n");
+    $bug->{severity} = 'n'; #Default severity is normal
+    my @bug_flags = split /(?<!\&.t);/s, $report;
+    foreach my $bug_flag (@bug_flags) {
+       $bug_flag =~ s/\n//g;
+       &::DEBUG("Bug_flag: $bug_flag\n");
+       if ($bug_flag =~ /Severity:/i) {
+           ($bug->{severity}) = $bug_flag =~ /(wishlist|minor|normal|important|serious|grave)/i;
+           # Just leave the leter instead of the whole thing.
+           $bug->{severity} =~ s/^(.).+$/$1/;
+       }
+       elsif ($bug_flag =~ /Package:/) {
+           ($bug->{package}) = $bug_flag =~ /\"\>\s*([^<>]+?)\s*\<\/a\>/;
+           # take packagename out of title if it's there
+           $bug->{title} =~ s/^$bug->{package}: //;
+       }
+       elsif ($bug_flag =~ /Reported by:/) {
+           ($bug->{reporter}) = $bug_flag =~ /\"\>\s*(.+?)\s*\<\/a\>/;
+           # strip &lt; and &gt;
+           $bug->{reporter} =~ s/&lt;/\</g;
+           $bug->{reporter} =~ s/&gt;/\>/g;
+       }
+       elsif ($bug_flag =~ /Date:/) {
+           ($bug->{date}) = $bug_flag =~ /Date:\s*(\w.+?)\s*$/;
+           #ditch extra whitespace
+           $bug->{date} =~ s/\s{2,}/\ /;
+       }
+       elsif ($bug_flag =~ /Tags:/) {
+           ($bug->{tags}) = $bug_flag =~ /strong\>\s*(.+?)\s*\<\/strong\>/;
+       }
+       elsif ($bug_flag =~ /merged with /) {
+           $bug_flag =~ s/merged with\s*//;
+           $bug_flag =~ s/\<[^\>]+\>//g;
+           $bug_flag =~ s/\s//sg;
+           $bug->{merged_with} = $bug_flag;
+
+       }
+       elsif ($bug_flag =~ /\>Done:\</) {
+           $bug->{done} = 1;
+       }
+    }
+
+    # report bug
+
+    $report = '';
+    $report .= 'DONE:' if defined $bug->{done} and $bug->{done};
+    $report .= '#'.$bug->{num}.':'.uc($bug->{severity}).'['.$bug->{package}.'] '.$bug->{title};
+    $report .= ' ('.$bug->{tags}.')' if defined $bug->{tags};
+    $report .= ' ' . $bug->{date};
+    # Avoid reporting so many merged bugs.
+    $report .= ' ['.join(',',splice(@{[split(/,/,$bug->{merged_with})]},0,3)).']' if defined $bug->{merged_with};
+    if ($::DEBUG) {
+       use Data::Dumper;
+       &::DEBUG(Dumper($bug));
+    }
+    return $report;
+}
+
+sub old_do_id {
+    my($num) = @_;
+    my $url = "http://bugs.debian.org/$num";
+
+    # FIXME
+    return "do_id not supported yet.";
+
+    my @results = &::getURL($url);
+    foreach (@results) {
+       &::DEBUG("do_id: $_");
+    }
+}
+
+sub do_email {
+    my($email) = @_;
+    my $url = "http://bugs.debian.org/$email";
+
+    # FIXME
+    return "do_email not supported yet.";
+
+    my @results = &::getURL($url);
+    foreach (@results) {
+       &::DEBUG("do_email: $_");
+    }
+}
+
+sub do_pkg {
+    my($pkg) = @_;
+    my $url = "http://bugs.debian.org/$pkg";
+
+    # FIXME
+    return "do_pkg not supported yet.";
+
+    my @results = &::getURL($url);
+    foreach (@results) {
+       &::DEBUG("do_pkg: $_");
     }
 }