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 use Debbugs::MIME qw(parse);
  33
  34 BEGIN{
  35      ($VERSION) = q$Revision: 1.3 $ =~ /^Revision:\s+([^\s+])/;
  36      $DEBUG = 0 unless defined $DEBUG;
  37
  38      @EXPORT = ();
  39      %EXPORT_TAGS = (add    => [qw(add_bug_log add_bug_message)],
  40                     );
  41      @EXPORT_OK = ();
  42      Exporter::export_ok_tags(qw(add));
  43      $EXPORT_TAGS{all} = [@EXPORT_OK];
  44 }
  45
  46
  47 sub add_bug_log{
  48      my ($est,$bug_num) = @_;
  49
  50      # We want to read the entire bug log, pulling out individual
  51      # messages, and shooting them through hyper estraier
  52
  53      my $location = getbuglocation($bug_num,'log');
  54      my $bug_log = getbugcomponent($bug_num,'log',$location);
  55      my $log_fh = new IO::File $bug_log, 'r' or
  56           die "Unable to open bug log $bug_log for reading: $!";
  57
  58      my $log = Debbugs::Log->new($log_fh) or
  59           die "Debbugs::Log was unable to be initialized";
  60
  61      my %seen_msg_ids;
  62      my $msg_num=0;
  63      my $status = {};
  64      if (my $location = getbuglocation($bug_num,'summary')) {
  65           $status = readbug($bug_num,$location);
  66      }
  67      while (my $record = $log->read_record()) {
  68           $msg_num++;
  69           next unless $record->{type} eq 'incoming-recv';
  70           my ($msg_id) = $record->{text} =~ /^Message-Id:\s+<(.+)>/im;
  71           next if defined $msg_id and exists $seen_msg_ids{$msg_id};
  72           $seen_msg_ids{$msg_id} = 1 if defined $msg_id;
  73           next if $msg_id =~ /handler\..+\.ack(?:info)?\@/;
  74           add_bug_message($est,$record->{text},$bug_num,$msg_num,$status)
  75      }
  76      return $msg_num;
  77 }
  78
  79 =head2 remove_old_message
  80
  81      remove_old_message($est,300000,50);
  82
  83 Removes all messages which are no longer in the log
  84
  85 =cut
  86
  87 sub remove_old_messages{
  88      my ($est,$bug_num,$max_message) = @_;
  89      # remove records which are no longer present in the log (uri > $msg_num)
  90      my $cond = new Search::Estraier::Condition;
  91      $cond->add_attr('@uri STRBW '.$bug_num.'/');
  92      $cond->set_max(50);
  93      my $skip;
  94      my $nres;
  95      while ($nres = $est->search($cond,0) and $nres->doc_num > 0){
  96           for my $rdoc (map {$nres->get_doc($_)} 0..($nres->doc_num-1)) {
  97                my $uri = $rdoc->uri;
  98                my ($this_message) = $uri =~ m{/(\d+)$};
  99                next unless $this_message > $max_message;
 100                $est->out_doc_by_uri($uri);
 101           }
 102           last unless $nres->doc_num >= $cond->max;
 103           $cond->set_skip($cond->skip+$cond->max);
 104      }
 105
 106 }
 107
 108 sub add_bug_message{
 109      my ($est,$bug_message,$bug_num,
 110          $msg_num,$status) = @_;
 111
 112      my $doc;
 113      my $uri = "$bug_num/$msg_num";
 114      $doc = $est->get_doc_by_uri($uri);
 115      $doc = new Search::Estraier::Document if not defined $doc;
 116
 117      my $message = parse($bug_message);
 118      $doc->add_text(join('',values %{$message}));
 119
 120      # * @id : the ID number determined automatically when the document is registered.
 121      # * @uri : the location of a document which any document should have.
 122      # * @digest : the message digest calculated automatically when the document is registered.
 123      # * @cdate : the creation date.
 124      # * @mdate : the last modification date.
 125      # * @adate : the last access date.
 126      # * @title : the title used as a headline in the search result.
 127      # * @author : the author.
 128      # * @type : the media type.
 129      # * @lang : the language.
 130      # * @genre : the genre.
 131      # * @size : the size.
 132      # * @weight : the scoring weight.
 133      # * @misc : miscellaneous information.
 134      my @attr = qw(status subject date submitter package tags severity);
 135      # parse the date
 136      my ($date) = $bug_message =~ /^Date:\s+(.+?)\s*$/mi;
 137      $doc->add_attr('@cdate' => $date);
 138      # parse the title
 139      my ($subject) = $bug_message =~ /^Subject:\s+(.+?)\s*$/mi;
 140      $doc->add_attr('@title' => $subject);
 141      # parse the author
 142      my ($author) = $bug_message =~ /^From:\s+(.+?)\s*$/mi;
 143      $doc->add_attr('@author' => $author);
 144      # create the uri
 145      $doc->add_attr('@uri' => $uri);
 146      foreach my $attr (@attr) {
 147           $doc->add_attr($attr => $status->{$attr});
 148      }
 149      print STDERR "adding $uri\n" if $DEBUG;
 150      # Try a bit harder if estraier is returning timeouts
 151      my $attempt = 5;
 152      while ($attempt > 0) {
 153           $est->put_doc($doc) and last;
 154           my $status = $est->status;
 155           $attempt--;
 156           print STDERR "Failed to add $uri\n".$status."\n";
 157           last unless $status =~ /^5/;
 158           sleep 20;
 159      }
 160
 161 }
 162
 163
 164 1;
 165
 166
 167 __END__
 168
 169
 170
 171
 172
 173