src/Modules/DebianExtra.pl

   1 #
   2 #  DebianExtra.pl: Extra stuff for debian
   3 #          Author: dms
   4 #         Version: v0.1 (20000520)
   5 #         Created: 20000520
   6 #
   7
   8 use strict;
   9
  10 package DBugs;
  11
  12 sub Parse {
  13     my($args) = @_;
  14
  15     if (!defined $args or $args =~ /^$/) {
  16         &debianBugs();
  17     }
  18
  19     if ($args =~ /^(\d+)$/) {
  20         # package number:
  21         &do_id($args);
  22
  23     } elsif ($args =~ /^(\S+\@\S+)$/) {
  24         # package email maintainer.
  25         &do_email($args);
  26
  27     } elsif ($args =~ /^(\S+)$/) {
  28         # package name.
  29         &do_pkg($args);
  30
  31     } else {
  32         # invalid.
  33         &::msg($::who, "error: could not parse $args");
  34     }
  35 }
  36
  37 sub debianBugs {
  38     my @results = &::getURL("http://master.debian.org/~wakkerma/bugs");
  39     my ($date, $rcbugs, $remove);
  40     my ($bugs_closed, $bugs_opened) = (0,0);
  41
  42     if (scalar @results) {
  43         foreach (@results) {
  44             s/<.*?>//g;
  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+)/) {
  49                 $bugs_closed = $1;
  50                 $bugs_opened = $2;
  51             }
  52         }
  53         my $xtxt = ($bugs_closed >=$bugs_opened) ?
  54                         "It's good to see " :
  55                         "Oh no, the bug count is rising -- ";
  56
  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."
  62         );
  63     } else {
  64         &::msg($::who, "Couldn't retrieve data for debian bug stats.");
  65     }
  66 }
  67
  68 sub do_id {
  69     my($num)    = @_;
  70     my $url     = "http://bugs.debian.org/$num";
  71
  72     if (1) {
  73         &::msg($::who, "do_id not supported yet.");
  74         return;
  75     }
  76
  77     my @results = &::getURL($url);
  78     foreach (@results) {
  79         &::DEBUG("do_id: $_");
  80     }
  81 }
  82
  83 sub do_email {
  84     my($email)  = @_;
  85     my $url     = "http://bugs.debian.org/$email";
  86
  87     if (1) {
  88         &::msg($::who, "do_email not supported yet.");
  89         return;
  90     }
  91
  92     my @results = &::getURL($url);
  93     foreach (@results) {
  94         &::DEBUG("do_email: $_");
  95     }
  96 }
  97
  98 sub do_pkg {
  99     my($pkg)    = @_;
 100     my $url     = "http://bugs.debian.org/$pkg";
 101
 102     my @results = &::getURL($url);
 103     foreach (@results) {
 104         &::DEBUG("do_pkg: $_");
 105     }
 106 }
 107
 108 1;