2 # DebianExtra.pl: Extra stuff for debian
4 # Version: v0.1 (20000520)
16 #&::DEBUG("DebianExtra: $args\n");
17 if (!defined $args or $args =~ /^$/) {
19 } elsif ($args =~ /^(\d+)$/) {
22 } elsif ($args =~ /^(\S+\@\S+)$/) {
23 # package email maintainer.
24 $msg = &do_email($args);
25 } elsif ($args =~ /^(\S+)$/) {
27 $msg = &do_pkg($args);
30 $msg = "error: could not parse $args";
32 &::performStrictReply($msg);
36 my @results = &::getURL("http://master.debian.org/~wakkerma/bugs");
37 my ($date, $rcbugs, $remove);
38 my ($bugs_closed, $bugs_opened) = (0,0);
40 if (scalar @results) {
43 $date = $1 if (/status at (.*)\s*$/);
44 $rcbugs = $1 if (/bugs: (\d+)/);
45 $remove = $1 if (/REMOVE\S+ (\d+)\s*$/);
46 if (/^(\d+) r\S+ b\S+ w\S+ c\S+ a\S+ (\d+)/) {
51 my $xtxt = ($bugs_closed >=$bugs_opened) ?
53 "Oh no, the bug count is rising -- ";
55 &::performStrictReply(
56 "Debian bugs statistics, last updated on $date... ".
57 "There are \002$rcbugs\002 release-critical bugs; $xtxt".
58 "\002$bugs_closed\002 bugs closed, opening \002$bugs_opened\002 bugs. ".
59 "About \002$remove\002 packages will be removed."
62 &::msg($::who, "Couldn't retrieve data for debian bug stats.");
67 my ($bug_num) = shift;
69 if (not $bug_num =~ /^\#?\d+$/) {
70 return "Bug is not a number!";
73 my @results = &::getURL("http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=$bug_num");
74 my $report = join("\n", @results);
76 # strip down report to relevant header information.
78 $report =~ /<BODY[^>]*>(.+?)<HR>/si;
81 ($bug->{num}, $bug->{title}) = $report =~ m#\#(\d+)\<\/A\>\<BR\>(.+?)\<\/H1\>#is;
82 &::DEBUG("Bugnum: $bug->{num}\n");
83 $bug->{title} =~ s/</\</g;
84 $bug->{title} =~ s/>/\>/g;
85 $bug->{title} =~ s/"/\"/g;
86 &::DEBUG("Title: $bug->{title}\n");
87 $bug->{severity} = 'n'; #Default severity is normal
88 my @bug_flags = split /(?<!\&.t);/s, $report;
89 foreach my $bug_flag (@bug_flags) {
91 &::DEBUG("Bug_flag: $bug_flag\n");
92 if ($bug_flag =~ /Severity:/i) {
93 ($bug->{severity}) = $bug_flag =~ /(wishlist|minor|normal|important|serious|grave)/i;
94 # Just leave the leter instead of the whole thing.
95 $bug->{severity} =~ s/^(.).+$/$1/;
97 elsif ($bug_flag =~ /Package:/) {
98 ($bug->{package}) = $bug_flag =~ /\"\>\s*([^<>]+?)\s*\<\/a\>/;
99 # take packagename out of title if it's there
100 $bug->{title} =~ s/^$bug->{package}: //;
102 elsif ($bug_flag =~ /Reported by:/) {
103 ($bug->{reporter}) = $bug_flag =~ /\"\>\s*(.+?)\s*\<\/a\>/;
104 # strip < and >
105 $bug->{reporter} =~ s/</\</g;
106 $bug->{reporter} =~ s/>/\>/g;
108 elsif ($bug_flag =~ /Date:/) {
109 ($bug->{date}) = $bug_flag =~ /Date:\s*(\w.+?)\s*$/;
110 #ditch extra whitespace
111 $bug->{date} =~ s/\s{2,}/\ /;
113 elsif ($bug_flag =~ /Tags:/) {
114 ($bug->{tags}) = $bug_flag =~ /strong\>\s*(.+?)\s*\<\/strong\>/;
116 elsif ($bug_flag =~ /merged with /) {
117 $bug_flag =~ s/merged with\s*//;
118 $bug_flag =~ s/\<[^\>]+\>//g;
119 $bug_flag =~ s/\s//sg;
120 $bug->{merged_with} = $bug_flag;
123 elsif ($bug_flag =~ /\>Done:\</) {
131 $report .= 'DONE:' if defined $bug->{done} and $bug->{done};
132 $report .= '#'.$bug->{num}.':'.uc($bug->{severity}).'['.$bug->{package}.'] '.$bug->{title};
133 $report .= ' ('.$bug->{tags}.')' if defined $bug->{tags};
134 $report .= ' ' . $bug->{date};
135 # Avoid reporting so many merged bugs.
136 $report .= ' ['.join(',',splice(@{[split(/,/,$bug->{merged_with})]},0,3)).']' if defined $bug->{merged_with};
139 &::DEBUG(Dumper($bug));
146 my $url = "http://bugs.debian.org/$num";
149 return "do_id not supported yet.";
151 my @results = &::getURL($url);
153 &::DEBUG("do_id: $_");
159 my $url = "http://bugs.debian.org/$email";
162 return "do_email not supported yet.";
164 my @results = &::getURL($url);
166 &::DEBUG("do_email: $_");
172 my $url = "http://bugs.debian.org/$pkg";
175 return "do_pkg not supported yet.";
177 my @results = &::getURL($url);
179 &::DEBUG("do_pkg: $_");