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+)$/ ) {
26 elsif ( $args =~ /^(\S+\@\S+)$/ ) {
28 # package email maintainer.
29 $msg = &do_email($args);
31 elsif ( $args =~ /^(\S+)$/ ) {
34 $msg = &do_pkg($args);
39 $msg = "error: could not parse $args";
41 &::performStrictReply($msg);
45 my @results = &::getURL("http://master.debian.org/~wakkerma/bugs");
46 my ( $date, $rcbugs, $remove );
47 my ( $bugs_closed, $bugs_opened ) = ( 0, 0 );
49 if ( scalar @results ) {
52 $date = $1 if (/status at (.*)\s*$/);
53 $rcbugs = $1 if (/bugs: (\d+)/);
54 $remove = $1 if (/REMOVE\S+ (\d+)\s*$/);
55 if (/^(\d+) r\S+ b\S+ w\S+ c\S+ a\S+ (\d+)/) {
61 ( $bugs_closed >= $bugs_opened )
63 : "Oh no, the bug count is rising -- ";
65 &::performStrictReply(
66 "Debian bugs statistics, last updated on $date... "
67 . "There are \002$rcbugs\002 release-critical bugs; $xtxt"
68 . "\002$bugs_closed\002 bugs closed, opening \002$bugs_opened\002 bugs. "
69 . "About \002$remove\002 packages will be removed." );
72 &::msg( $::who, "Couldn't retrieve data for debian bug stats." );
77 my ($bug_num) = shift;
79 if ( not $bug_num =~ /^\#?\d+$/ ) {
80 return "Bug is not a number!";
84 &::getURL("http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=$bug_num");
85 my $report = join( "\n", @results );
87 # strip down report to relevant header information.
88 # $report =~ s/\r//sig;
89 $report =~ /<BODY[^>]*>(.+?)<HR>/si;
92 ( $bug->{num}, $bug->{title} ) =
93 $report =~ m#\#(\d+)\<\/A\>\<BR\>(.+?)\<\/H1\>#is;
94 &::DEBUG("Bugnum: $bug->{num}\n");
95 $bug->{title} =~ s/</\</g;
96 $bug->{title} =~ s/>/\>/g;
97 $bug->{title} =~ s/"/\"/g;
98 &::DEBUG("Title: $bug->{title}\n");
99 $bug->{severity} = 'n'; #Default severity is normal
100 my @bug_flags = split /(?<!\&.t)[;\.]\n/s, $report;
102 foreach my $bug_flag (@bug_flags) {
103 $bug_flag =~ s/\n//g;
104 &::DEBUG("Bug_flag: $bug_flag\n");
105 if ( $bug_flag =~ /Severity:/i ) {
106 ( $bug->{severity} ) =
107 $bug_flag =~ /(wishlist|minor|normal|important|serious|grave)/i;
109 # Just leave the leter instead of the whole thing.
110 $bug->{severity} =~ s/^(.).+$/$1/;
112 elsif ( $bug_flag =~ /Package:/ ) {
113 ( $bug->{package} ) = $bug_flag =~ /\"\>\s*([^\<\>\"]+?)\s*\<\/a\>/;
115 elsif ( $bug_flag =~ /Reported by:/ ) {
116 ( $bug->{reporter} ) = $bug_flag =~ /\"\>\s*(.+?)\s*\<\/a\>/;
118 # strip < and >
119 $bug->{reporter} =~ s/</\</g;
120 $bug->{reporter} =~ s/>/\>/g;
122 elsif ( $bug_flag =~ /Date:/ ) {
123 ( $bug->{date} ) = $bug_flag =~ /Date:\s*(\w.+?)\s*$/;
125 #ditch extra whitespace
126 $bug->{date} =~ s/\s{2,}/\ /;
128 elsif ( $bug_flag =~ /Tags:/ ) {
129 ( $bug->{tags} ) = $bug_flag =~ /strong\>\s*(.+?)\s*\<\/strong\>/;
131 elsif ( $bug_flag =~ /merged with / ) {
132 $bug_flag =~ s/merged with\s*//;
133 $bug_flag =~ s/\<[^\>]+\>//g;
134 $bug_flag =~ s/\s//sg;
135 $bug->{merged_with} = $bug_flag;
138 elsif ( $bug_flag =~ /\>Done:\</ ) {
141 elsif ( $bug_flag =~ /\>Fixed\</ ) {
149 $report .= 'DONE:' if defined $bug->{done} and $bug->{done};
152 . uc( $bug->{severity} ) . '['
153 . $bug->{package} . '] '
155 $report .= ' (' . $bug->{tags} . ')' if defined $bug->{tags};
156 $report .= '; ' . $bug->{date};
158 # Avoid reporting so many merged bugs.
160 . join( ',', splice( @{ [ split( /,/, $bug->{merged_with} ) ] }, 0, 3 ) )
162 if defined $bug->{merged_with};
165 &::DEBUG( Dumper($bug) );
172 my $url = "http://bugs.debian.org/$num";
175 return "do_id not supported yet.";
180 my $url = "http://bugs.debian.org/$email";
183 return "do_email not supported yet.";
185 my @results = &::getURL($url);
187 &::DEBUG("do_email: $_");
193 my $url = "http://bugs.debian.org/$pkg";
196 return "do_pkg not supported yet.";
198 my @results = &::getURL($url);
200 &::DEBUG("do_pkg: $_");
206 # vim:ts=4:sw=4:expandtab:tw=80