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
  29     # Pass request to the user agent and get a response back
  30     my $res = $ua->request($req);
  31
  32     # Check the outcome of the response
  33     if ( $res->is_success ) {
  34         return $res->content;
  35     }
  36     else {
  37         return undef;
  38     }
  39 }
  40
  41 sub bug_info($;$) {
  42     my $bug_num = shift;
  43     my $options = shift || {};
  44
  45     if ( not $bug_num =~ /^\#?\d+$/ ) {
  46         warn "Bug is not a number!" and return undef
  47           if not $options->{return_warnings};
  48         return "Bug is not a number!";
  49     }
  50     $bug_num =~ s/^\#//;
  51     my $report =
  52       get_url("http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=$bug_num");
  53
  54     # strip down report to relevant header information.
  55     $report =~ /<HEAD>(.+?)<HR>/s;
  56     $report = $1;
  57     my $bug = {};
  58     ( $bug->{num}, $bug->{title} ) =
  59       $report =~ m#\#(\d+)\<\/A\>\<BR\>(.+?)\<\/H1\>#is;
  60     if ($DEBUG) {
  61         print "Bugnum: $bug->{num}\nTitle: $bug->{title}\nReport: $report\n";
  62     }
  63     $bug->{title} =~ s/&lt;/\</g;
  64     $bug->{title} =~ s/&gt;/\>/g;
  65     $bug->{title} =~ s/&quot;/\"/g;
  66     $bug->{severity} = 'n';    #Default severity is normal
  67     my @bug_flags = split /(?<!\&.t)[;\.]\n/s, $report;
  68     foreach my $bug_flag (@bug_flags) {
  69         print "Bug_flag: $bug_flag\n" if $DEBUG;
  70         if ( $bug_flag =~ /Severity:/i ) {
  71             ( $bug->{severity} ) =
  72               $bug_flag =~ /(wishlist|minor|normal|important|serious|grave)/i;
  73
  74             # Just leave the leter instead of the whole thing.
  75             $bug->{severity} =~ s/^(.).+$/$1/;
  76         }
  77         elsif ( $bug_flag =~ /Package:/ ) {
  78             ( $bug->{package} ) = $bug_flag =~ /\"\>\s*([^\<\>\"]+?)\s*\<\/a\>/;
  79         }
  80         elsif ( $bug_flag =~ /Reported by:/ ) {
  81             ( $bug->{reporter} ) = $bug_flag =~ /\"\>\s*(.+?)\s*\<\/a\>/;
  82
  83             # strip &lt; and &gt;
  84             $bug->{reporter} =~ s/&lt;/\</g;
  85             $bug->{reporter} =~ s/&gt;/\>/g;
  86         }
  87         elsif ( $bug_flag =~ /Date:/ ) {
  88             ( $bug->{date} ) = $bug_flag =~ /Date:\s*(\w.+?)\s*$/;
  89
  90             #ditch extra whitespace
  91             $bug->{date} =~ s/\s{2,}/\ /;
  92         }
  93         elsif ( $bug_flag =~ /Tags:/ ) {
  94             ( $bug->{tags} ) = $bug_flag =~ /strong\>\s*(.+?)\s*\<\/strong\>/;
  95         }
  96         elsif ( $bug_flag =~ /merged with / ) {
  97             $bug_flag =~ s/merged with\s*//;
  98             $bug_flag =~ s/\<[^\>]+\>//g;
  99             $bug_flag =~ s/\s//sg;
 100             $bug->{merged_with} = $bug_flag;
 101
 102         }
 103         elsif ( $bug_flag =~ /\>Done:\</ ) {
 104             $bug->{done} = 1;
 105         }
 106         elsif ( $bug_flag =~ /\>Fixed\</ ) {
 107             $bug->{done} = 1;
 108         }
 109     }
 110
 111     # report bug
 112
 113     $report = '';
 114     $report .= 'DONE:' if defined $bug->{done} and $bug->{done};
 115     $report .= '#'
 116       . $bug->{num} . ':'
 117       . uc( $bug->{severity} ) . '['
 118       . $bug->{package} . '] '
 119       . $bug->{title};
 120     $report .= ' (' . $bug->{tags} . ')' if defined $bug->{tags};
 121     $report .= '; ' . $bug->{date};
 122
 123     # Avoid reporting so many merged bugs.
 124     $report .= ' ['
 125       . join( ',', splice( @{ [ split( /,/, $bug->{merged_with} ) ] }, 0, 3 ) )
 126       . ']'
 127       if defined $bug->{merged_with};
 128     if ($DEBUG) {
 129         use Data::Dumper;
 130         print STDERR Dumper($bug);
 131     }
 132     return $report;
 133 }
 134
 135 sub package_bugs($) {
 136
 137 }
 138
 139 1;
 140
 141
 142 __END__
 143
 144 # vim:ts=4:sw=4:expandtab:tw=80