src/Modules/DebianBugs.pm

   1 # This module is a plugin for WWW::Scraper, and allows one to search
   2 # google, and is released under the terms of the GPL version 2, or any
   3 # later version. See the file README and COPYING for more
   4 # information. Copyright 2002 by Don Armstrong <don@donarmstrong.com>.
   5
   6 # $Id:  $
   7
   8 package DebianBugs;
   9
  10 use warnings;
  11 use strict;
  12
  13 use vars qw($VERSION $DEBUG);
  14
  15 use LWP::UserAgent;
  16
  17 $VERSION = q($Rev: $);
  18 $DEBUG ||= 0;
  19
  20 sub get_url($){
  21      my $url = shift;
  22
  23      my $ua = LWP::UserAgent->new;
  24      $ua->agent("blootbug_debbugs/$VERSION");
  25
  26      # Create a request
  27      my $req = HTTP::Request->new(GET => $url);
  28      # Pass request to the user agent and get a response back
  29      my $res = $ua->request($req);
  30      # Check the outcome of the response
  31      if ($res->is_success) {
  32           return $res->content;
  33      } else {
  34           return undef;
  35      }
  36 }
  37
  38 sub bug_info($;$){
  39      my $bug_num = shift;
  40      my $options = shift || {};
  41
  42      if (not $bug_num =~ /^\#?\d+$/) {
  43           warn "Bug is not a number!" and return undef if not $options->{return_warnings};
  44           return "Bug is not a number!";
  45      }
  46      $bug_num =~ s/^\#//;
  47      my $report = get_url("http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=$bug_num");
  48
  49      # strip down report to relevant header information.
  50      $report =~ /<HEAD>(.+?)<HR>/s;
  51      $report = $1;
  52      my $bug = {};
  53      ($bug->{num},$bug->{title}) = $report =~ m#\#(\d+)\<\/A\>\<BR\>(.+?)\<\/H1\>#is;
  54      if ($DEBUG) {
  55           print "Bugnum: $bug->{num}\nTitle: $bug->{title}\nReport: $report\n";
  56      }
  57      $bug->{title} =~ s/&lt;/\</g;
  58      $bug->{title} =~ s/&gt;/\>/g;
  59      $bug->{title} =~ s/&quot;/\"/g;
  60      $bug->{severity} = 'n'; #Default severity is normal
  61      my @bug_flags = split /(?<!\&.t)[;\.]\n/s, $report;
  62      foreach my $bug_flag (@bug_flags) {
  63           print "Bug_flag: $bug_flag\n" if $DEBUG;
  64           if ($bug_flag =~ /Severity:/i) {
  65                ($bug->{severity}) = $bug_flag =~ /(wishlist|minor|normal|important|serious|grave)/i;
  66                # Just leave the leter instead of the whole thing.
  67                $bug->{severity} =~ s/^(.).+$/$1/;
  68           }
  69           elsif ($bug_flag =~ /Package:/) {
  70                ($bug->{package}) = $bug_flag =~ /\"\>\s*([^\<\>\"]+?)\s*\<\/a\>/;
  71           }
  72           elsif ($bug_flag =~ /Reported by:/) {
  73                ($bug->{reporter}) = $bug_flag =~ /\"\>\s*(.+?)\s*\<\/a\>/;
  74                # strip &lt; and &gt;
  75                $bug->{reporter} =~ s/&lt;/\</g;
  76                $bug->{reporter} =~ s/&gt;/\>/g;
  77           }
  78           elsif ($bug_flag =~ /Date:/) {
  79                ($bug->{date}) = $bug_flag =~ /Date:\s*(\w.+?)\s*$/;
  80                #ditch extra whitespace
  81                $bug->{date} =~ s/\s{2,}/\ /;
  82           }
  83           elsif ($bug_flag =~ /Tags:/) {
  84                ($bug->{tags}) = $bug_flag =~ /strong\>\s*(.+?)\s*\<\/strong\>/;
  85           }
  86           elsif ($bug_flag =~ /merged with /) {
  87                $bug_flag =~ s/merged with\s*//;
  88                $bug_flag =~ s/\<[^\>]+\>//g;
  89                $bug_flag =~ s/\s//sg;
  90                $bug->{merged_with} = $bug_flag;
  91
  92           }
  93           elsif ($bug_flag =~ /\>Done:\</) {
  94                $bug->{done} = 1;
  95           }
  96           elsif ($bug_flag =~ /\>Fixed\</) {
  97                $bug->{done} = 1;
  98           }
  99      }
 100      # report bug
 101
 102      $report = '';
 103      $report .= 'DONE:' if defined $bug->{done} and $bug->{done};
 104      $report .= '#'.$bug->{num}.':'.uc($bug->{severity}).'['.$bug->{package}.'] '.$bug->{title};
 105      $report .= ' ('.$bug->{tags}.')' if defined $bug->{tags};
 106      $report .= '; ' . $bug->{date};
 107      # Avoid reporting so many merged bugs.
 108      $report .= ' ['.join(',',splice(@{[split(/,/,$bug->{merged_with})]},0,3)).']' if defined $bug->{merged_with};
 109      if ($DEBUG) {
 110           use Data::Dumper;
 111           print STDERR Dumper($bug);
 112      }
 113      return $report;
 114 }
 115
 116 sub package_bugs($){
 117
 118 }
 119
 120 1;
 121
 122
 123 __END__
 124
 125 # vim:ts=4:sw=4:expandtab:tw=80