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);
  31 use Debbugs::Status qw(readbug);
  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      return $msg_num;
  76 }
  77
  78 =head2 remove_old_message
  79
  80      remove_old_message($est,300000,50);
  81
  82 Removes all messages which are no longer in the log
  83
  84 =cut
  85
  86 sub remove_old_messages{
  87      my ($est,$bug_num,$max_message) = @_;
  88      # remove records which are no longer present in the log (uri > $msg_num)
  89      my $cond = new Search::Estraier::Condition;
  90      $cond->add_attr('@uri STRBW '.$bug_num.'/');
  91      $cond->set_max(50);
  92      my $skip;
  93      my $nres;
  94      while ($nres = $est->search($cond,0) and $nres->doc_num > 0){
  95           for my $rdoc (map {$nres->get_doc($_)} 0..($nres->doc_num-1)) {
  96                my $uri = $rdoc->uri;
  97                my ($this_message) = $uri =~ m{/(\d+)$};
  98                next unless $this_message > $max_message;
  99                $est->out_doc_by_uri($uri);
 100           }
 101           last unless $nres->doc_num >= $cond->max;
 102           $cond->set_skip($cond->skip+$cond->max);
 103      }
 104
 105 }
 106
 107 sub add_bug_message{
 108      my ($est,$bug_message,$bug_num,
 109          $msg_num,$status) = @_;
 110
 111      my $doc;
 112      my $uri = "$bug_num/$msg_num";
 113      $doc = $est->get_doc_by_uri($uri);
 114      $doc = new Search::Estraier::Document if not defined $doc;
 115      $doc->add_text($bug_message);
 116
 117      # * @id : the ID number determined automatically when the document is registered.
 118      # * @uri : the location of a document which any document should have.
 119      # * @digest : the message digest calculated automatically when the document is registered.
 120      # * @cdate : the creation date.
 121      # * @mdate : the last modification date.
 122      # * @adate : the last access date.
 123      # * @title : the title used as a headline in the search result.
 124      # * @author : the author.
 125      # * @type : the media type.
 126      # * @lang : the language.
 127      # * @genre : the genre.
 128      # * @size : the size.
 129      # * @weight : the scoring weight.
 130      # * @misc : miscellaneous information.
 131      my @attr = qw(status subject date submitter package tags severity);
 132      # parse the date
 133      my ($date) = $bug_message =~ /^Date:\s+(.+?)\s*$/mi;
 134      $doc->add_attr('@cdate' => $date);
 135      # parse the title
 136      my ($subject) = $bug_message =~ /^Subject:\s+(.+?)\s*$/mi;
 137      $doc->add_attr('@title' => $subject);
 138      # parse the author
 139      my ($author) = $bug_message =~ /^From:\s+(.+?)\s*$/mi;
 140      $doc->add_attr('@author' => $author);
 141      # create the uri
 142      $doc->add_attr('@uri' => $uri);
 143      foreach my $attr (@attr) {
 144           $doc->add_attr($attr => $status->{$attr});
 145      }
 146      print STDERR "adding $uri\n" if $DEBUG;
 147      # Try a bit harder if estraier is returning timeouts
 148      my $attempt = 5;
 149      while ($attempt > 0) {
 150           $est->put_doc($doc) and last;
 151           my $status = $est->status;
 152           $attempt--;
 153           print STDERR "Failed to add $uri\n".$status."\n";
 154           last unless $status =~ /^5/;
 155           sleep 20;
 156      }
 157
 158 }
 159
 160
 161 1;
 162
 163
 164 __END__
 165
 166
 167
 168
 169
 170