2 # DebianExtra.pl: Extra stuff for debian
4 # Version: v0.1 (20000520)
16 #&::DEBUG("DebianExtra: $args\n");
17 if (!defined $args or $args =~ /^$/) {
21 if ($args =~ /^\#?(\d+)$/) {
24 } elsif ($args =~ /^(\S+\@\S+)$/) {
25 # package email maintainer.
26 $msg = &do_email($args);
27 } elsif ($args =~ /^(\S+)$/) {
29 $msg = &do_pkg($args);
32 $msg = "error: could not parse $args";
34 &::performStrictReply($msg);
38 my @results = &::getURL("http://master.debian.org/~wakkerma/bugs");
39 my ($date, $rcbugs, $remove);
40 my ($bugs_closed, $bugs_opened) = (0,0);
42 if (scalar @results) {
45 $date = $1 if (/status at (.*)\s*$/);
46 $rcbugs = $1 if (/bugs: (\d+)/);
47 $remove = $1 if (/REMOVE\S+ (\d+)\s*$/);
48 if (/^(\d+) r\S+ b\S+ w\S+ c\S+ a\S+ (\d+)/) {
53 my $xtxt = ($bugs_closed >=$bugs_opened) ?
55 "Oh no, the bug count is rising -- ";
57 &::performStrictReply(
58 "Debian bugs statistics, last updated on $date... ".
59 "There are \002$rcbugs\002 release-critical bugs; $xtxt".
60 "\002$bugs_closed\002 bugs closed, opening \002$bugs_opened\002 bugs. ".
61 "About \002$remove\002 packages will be removed."
64 &::msg($::who, "Couldn't retrieve data for debian bug stats.");
69 my ($bug_num) = shift;
71 if (not $bug_num =~ /^\#?\d+$/) {
72 return "Bug is not a number!";
75 my @results = &::getURL("http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=$bug_num");
76 my $report = join("\n", @results);
78 # strip down report to relevant header information.
79 # $report =~ s/\r//sig;
80 $report =~ /<BODY[^>]*>(.+?)<HR>/si;
83 ($bug->{num},$bug->{title}) = $report =~ m#\#(\d+)\<\/A\>\<BR\>(.+?)\<\/H1\>#is;
84 &::DEBUG("Bugnum: $bug->{num}\n");
85 $bug->{title} =~ s/</\</g;
86 $bug->{title} =~ s/>/\>/g;
87 $bug->{title} =~ s/"/\"/g;
88 &::DEBUG("Title: $bug->{title}\n");
89 $bug->{severity} = 'n'; #Default severity is normal
90 my @bug_flags = split /(?<!\&.t)[;\.]\n/s, $report;
91 foreach my $bug_flag (@bug_flags) {
93 &::DEBUG("Bug_flag: $bug_flag\n");
94 if ($bug_flag =~ /Severity:/i) {
95 ($bug->{severity}) = $bug_flag =~ /(wishlist|minor|normal|important|serious|grave)/i;
96 # Just leave the leter instead of the whole thing.
97 $bug->{severity} =~ s/^(.).+$/$1/;
99 elsif ($bug_flag =~ /Package:/) {
100 ($bug->{package}) = $bug_flag =~ /\"\>\s*([^\<\>\"]+?)\s*\<\/a\>/;
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:\</) {
126 elsif ($bug_flag =~ /\>Fixed\</) {
134 $report .= 'DONE:' if defined $bug->{done} and $bug->{done};
135 $report .= '#'.$bug->{num}.':'.uc($bug->{severity}).'['.$bug->{package}.'] '.$bug->{title};
136 $report .= ' ('.$bug->{tags}.')' if defined $bug->{tags};
137 $report .= '; ' . $bug->{date};
138 # Avoid reporting so many merged bugs.
139 $report .= ' ['.join(',',splice(@{[split(/,/,$bug->{merged_with})]},0,3)).']' if defined $bug->{merged_with};
142 &::DEBUG(Dumper($bug));
149 my $url = "http://bugs.debian.org/$num";
152 return "do_id not supported yet.";
157 my $url = "http://bugs.debian.org/$email";
160 return "do_email not supported yet.";
162 my @results = &::getURL($url);
164 &::DEBUG("do_email: $_");
170 my $url = "http://bugs.debian.org/$pkg";
173 return "do_pkg not supported yet.";
175 my @results = &::getURL($url);
177 &::DEBUG("do_pkg: $_");