Debbugs/Estraier.pm

   1
   2 package Debbugs::Estraier;
   3
   4 =head1 NAME
   5
   6 Debbugs::Estraier -- Routines for interfacing bugs to HyperEstraier
   7
   8 =head1 SYNOPSIS
   9
  10 use Debbugs::Estraier;
  11
  12
  13 =head1 DESCRIPTION
  14
  15
  16 =head1 BUGS
  17
  18 None known.
  19
  20 =cut
  21
  22 use warnings;
  23 use strict;
  24 use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
  25 use base qw(Exporter);
  26 use Debbugs::Log;
  27 #use Params::Validate;
  28 use Search::Estraier;
  29 use Date::Manip;
  30 use Debbugs::Common qw(getbuglocation getbugcomponent readbug);
  31
  32
  33 BEGIN{
  34      ($VERSION) = q$Revision: 1.3 $ =~ /^Revision:\s+([^\s+])/;
  35      $DEBUG = 0 unless defined $DEBUG;
  36
  37      @EXPORT = ();
  38      %EXPORT_TAGS = (add    => [qw(add_bug_log add_bug_message)],
  39                     );
  40      @EXPORT_OK = ();
  41      Exporter::export_ok_tags(qw(add));
  42      $EXPORT_TAGS{all} = [@EXPORT_OK];
  43 }
  44
  45
  46 sub add_bug_log{
  47      my ($est,$bug_num) = @_;
  48
  49      # We want to read the entire bug log, pulling out individual
  50      # messages, and shooting them through hyper estraier
  51
  52      my $location = getbuglocation($bug_num,'log');
  53      my $bug_log = getbugcomponent($bug_num,'log',$location);
  54      my $log_fh = new IO::File $bug_log, 'r' or
  55           die "Unable to open bug log $bug_log for reading: $!";
  56
  57      my $log = Debbugs::Log->new($log_fh) or
  58           die "Debbugs::Log was unable to be initialized";
  59
  60      my %seen_msg_ids;
  61      my $msg_num=0;
  62      my $status = {};
  63      if (my $location = getbuglocation($bug_num,'summary')) {
  64           $status = readbug($bug_num,$location);
  65      }
  66      while (my $record = $log->read_record()) {
  67           $msg_num++;
  68           next unless $record->{type} eq 'incoming-recv';
  69           my ($msg_id) = $record->{text} =~ /^Message-Id:\s+<(.+)>/im;
  70           next if defined $msg_id and exists $seen_msg_ids{$msg_id};
  71           $seen_msg_ids{$msg_id} = 1 if defined $msg_id;
  72           next if $msg_id =~ /handler\..+\.ack(?:info)?\@/;
  73           add_bug_message($est,$record->{text},$bug_num,$msg_num,$status)
  74      }
  75 }
  76
  77 sub add_bug_message{
  78      my ($est,$bug_message,$bug_num,
  79          $msg_num,$status) = @_;
  80
  81      my $doc;
  82      my $uri = "$bug_num/$msg_num";
  83      $doc = $est->get_doc_by_uri($uri);
  84      $doc = new Search::Estraier::Document if not defined $doc;
  85      $doc->add_text($bug_message);
  86
  87      # * @id : the ID number determined automatically when the document is registered.
  88      # * @uri : the location of a document which any document should have.
  89      # * @digest : the message digest calculated automatically when the document is registered.
  90      # * @cdate : the creation date.
  91      # * @mdate : the last modification date.
  92      # * @adate : the last access date.
  93      # * @title : the title used as a headline in the search result.
  94      # * @author : the author.
  95      # * @type : the media type.
  96      # * @lang : the language.
  97      # * @genre : the genre.
  98      # * @size : the size.
  99      # * @weight : the scoring weight.
 100      # * @misc : miscellaneous information.
 101      my @attr = qw(status subject date submitter package tags severity);
 102      # parse the date
 103      my ($date) = $bug_message =~ /^Date:\s+(.+?)\s*$/mi;
 104      $doc->add_attr('@cdate' => $date);
 105      # parse the title
 106      my ($subject) = $bug_message =~ /^Subject:\s+(.+?)\s*$/mi;
 107      $doc->add_attr('@title' => $subject);
 108      # parse the author
 109      my ($author) = $bug_message =~ /^From:\s+(.+?)\s*$/mi;
 110      $doc->add_attr('@author' => $author);
 111      # create the uri
 112      $doc->add_attr('@uri' => $uri);
 113      foreach my $attr (@attr) {
 114           $doc->add_attr($attr => $status->{$attr});
 115      }
 116      print STDERR "adding $uri\n" if $DEBUG;
 117      # Try a bit harder if estraier is returning timeouts
 118      my $attempt = 5;
 119      while ($attempt > 0) {
 120           $est->put_doc($doc) and last;
 121           my $status = $est->status;
 122           $attempt--;
 123           print STDERR "Failed to add $uri\n".$status."\n";
 124           last unless $status =~ /^5/;
 125           sleep 20;
 126      }
 127
 128 }
 129
 130
 131 1;
 132
 133
 134 __END__
 135
 136
 137
 138
 139
 140