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." );
79 my ($bug_num,$options) = @_;
83 if ( not $bug_num =~ /^\#?\d+$/ ) {
84 warn "Bug is not a number!" and return undef
85 if not $options->{return_warnings};
86 return "Bug is not a number!";
89 my $soap = SOAP::Lite->uri('Debbugs/SOAP/1')->
90 proxy('http://bugs.debian.org/cgi-bin/soap.cgi');
91 $soap->transport->env_proxy();
92 my $temp = $soap->get_status($bug_num);
94 # enabling this will cause amazing amounts of output
95 # &::DEBUG(Dumper($temp));
97 return "Some failure (".$temp->fault->{faultstring}.")";
99 my $result = $temp->result();
100 &::DEBUG(Dumper($result));
101 if (not defined $result) {
102 return "No such bug (or some kind of error)";
105 $bug->{num} = $result->{bug_num};
106 $bug->{title} = $result->{subject};
107 $bug->{severity} = $result->{severity}; #Default severity is normal
108 # Just leave the leter instead of the whole thing.
109 $bug->{severity} =~ s/^(.).+$/$1/;
110 $bug->{package} = $result->{package};
111 $bug->{reporter} = $result->{submitter};
112 $bug->{date} = $result->{date};
113 $bug->{tags} = $result->{keywords};
114 $bug->{done} = defined $result->{done} && length($result->{done}) > 0;
115 $bug->{merged_with} = $result->{mergedwith};
119 $report .= 'DONE:' if defined $bug->{done} and $bug->{done};
122 . uc( $bug->{severity} ) . '['
123 . $bug->{package} . '] '
125 $report .= ' (' . $bug->{tags} . ')' if defined $bug->{tags};
126 $report .= '; ' . $bug->{date};
128 # Avoid reporting so many merged bugs.
130 . join( ',', splice( @{ [ split( /,/, $bug->{merged_with} ) ] }, 0, 3 ) )
132 if defined $bug->{merged_with};
138 my $url = "http://bugs.debian.org/$num";
141 return "do_id not supported yet.";
146 my $url = "http://bugs.debian.org/$email";
149 return "do_email not supported yet.";
151 my @results = &::getURL($url);
153 &::DEBUG("do_email: $_");
159 my $url = "http://bugs.debian.org/$pkg";
162 return "do_pkg not supported yet.";
164 my @results = &::getURL($url);
166 &::DEBUG("do_pkg: $_");
172 # vim:ts=4:sw=4:expandtab:tw=80