]> git.donarmstrong.com Git - debbugs.git/blob - Debbugs/Estraier.pm
default charset to UTF-8 when it isn't defined
[debbugs.git] / Debbugs / Estraier.pm
1 # This module is part of debbugs, and is released
2 # under the terms of the GPL version 2, or any later
3 # version at your option.
4 # See the file README and COPYING for more information.
5 #
6 # Copyright 2007 by Don Armstrong <don@donarmstrong.com>.
7
8 package Debbugs::Estraier;
9
10 =head1 NAME
11
12 Debbugs::Estraier -- Routines for interfacing bugs to HyperEstraier
13
14 =head1 SYNOPSIS
15
16 use Debbugs::Estraier;
17
18
19 =head1 DESCRIPTION
20
21
22 =head1 BUGS
23
24 None known.
25
26 =cut
27
28 use warnings;
29 use strict;
30 use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
31 use base qw(Exporter);
32 use Debbugs::Log;
33 #use Params::Validate;
34 use Search::Estraier;
35 use Date::Manip;
36 use Debbugs::Common qw(getbuglocation getbugcomponent make_list);
37 use Debbugs::Status qw(readbug);
38 use Debbugs::MIME qw(parse);
39
40 BEGIN{
41      ($VERSION) = q$Revision: 1.3 $ =~ /^Revision:\s+([^\s+])/;
42      $DEBUG = 0 unless defined $DEBUG;
43
44      @EXPORT = ();
45      %EXPORT_TAGS = (add    => [qw(add_bug_log add_bug_message)],
46                     );
47      @EXPORT_OK = ();
48      Exporter::export_ok_tags(qw(add));
49      $EXPORT_TAGS{all} = [@EXPORT_OK];
50 }
51
52
53 sub add_bug_log{
54      my ($est,$bug_num) = @_;
55
56      # We want to read the entire bug log, pulling out individual
57      # messages, and shooting them through hyper estraier
58
59      my $location = getbuglocation($bug_num,'log');
60      my $bug_log = getbugcomponent($bug_num,'log',$location);
61      my $log_fh = new IO::File $bug_log, 'r' or
62           die "Unable to open bug log $bug_log for reading: $!";
63
64      my $log = Debbugs::Log->new($log_fh) or
65           die "Debbugs::Log was unable to be initialized";
66
67      my %seen_msg_ids;
68      my $msg_num=0;
69      my $status = {};
70      if (my $location = getbuglocation($bug_num,'summary')) {
71           $status = readbug($bug_num,$location);
72      }
73      while (my $record = $log->read_record()) {
74           $msg_num++;
75           next unless $record->{type} eq 'incoming-recv';
76           my ($msg_id) = $record->{text} =~ /^Message-Id:\s+<(.+)>/im;
77           next if defined $msg_id and exists $seen_msg_ids{$msg_id};
78           $seen_msg_ids{$msg_id} = 1 if defined $msg_id;
79           next if defined $msg_id and $msg_id =~ /handler\..+\.ack(?:info)?\@/;
80           add_bug_message($est,$record->{text},$bug_num,$msg_num,$status)
81      }
82      return $msg_num;
83 }
84
85 =head2 remove_old_message
86
87      remove_old_message($est,300000,50);
88
89 Removes all messages which are no longer in the log
90
91 =cut
92
93 sub remove_old_messages{
94      my ($est,$bug_num,$max_message) = @_;
95      # remove records which are no longer present in the log (uri > $msg_num)
96      my $cond = new Search::Estraier::Condition;
97      $cond->add_attr('@uri STRBW '.$bug_num.'/');
98      $cond->set_max(50);
99      my $skip;
100      my $nres;
101      while ($nres = $est->search($cond,0) and $nres->doc_num > 0){
102           for my $rdoc (map {$nres->get_doc($_)} 0..($nres->doc_num-1)) {
103                my $uri = $rdoc->uri;
104                my ($this_message) = $uri =~ m{/(\d+)$};
105                next unless $this_message > $max_message;
106                $est->out_doc_by_uri($uri);
107           }
108           last unless $nres->doc_num >= $cond->max;
109           $cond->set_skip($cond->skip+$cond->max);
110      }
111
112 }
113
114 sub add_bug_message{
115      my ($est,$bug_message,$bug_num,
116          $msg_num,$status) = @_;
117
118      my $doc;
119      my $uri = "$bug_num/$msg_num";
120      $doc = $est->get_doc_by_uri($uri);
121      $doc = new Search::Estraier::Document if not defined $doc;
122
123      my $message = parse($bug_message);
124      $doc->add_text(join("\n",make_list(values %{$message})));
125
126      # * @id : the ID number determined automatically when the document is registered.
127      # * @uri : the location of a document which any document should have.
128      # * @digest : the message digest calculated automatically when the document is registered.
129      # * @cdate : the creation date.
130      # * @mdate : the last modification date.
131      # * @adate : the last access date.
132      # * @title : the title used as a headline in the search result.
133      # * @author : the author.
134      # * @type : the media type.
135      # * @lang : the language.
136      # * @genre : the genre.
137      # * @size : the size.
138      # * @weight : the scoring weight.
139      # * @misc : miscellaneous information.
140      my @attr = qw(status subject date submitter package tags severity);
141      # parse the date
142      my ($date) = $bug_message =~ /^Date:\s+(.+?)\s*$/mi;
143      $doc->add_attr('@cdate' => $date) if defined $date;
144      # parse the title
145      my ($subject) = $bug_message =~ /^Subject:\s+(.+?)\s*$/mi;
146      $doc->add_attr('@title' => $subject) if defined $subject;
147      # parse the author
148      my ($author) = $bug_message =~ /^From:\s+(.+?)\s*$/mi;
149      $doc->add_attr('@author' => $author) if defined $author;
150      # create the uri
151      $doc->add_attr('@uri' => $uri);
152      foreach my $attr (@attr) {
153           $doc->add_attr($attr => $status->{$attr}) if defined $status->{$attr};
154      }
155      print STDERR "adding $uri\n" if $DEBUG;
156      # Try a bit harder if estraier is returning timeouts
157      my $attempt = 5;
158      while ($attempt > 0) {
159           $est->put_doc($doc) and last;
160           my $status = $est->status;
161           $attempt--;
162           print STDERR "Failed to add $uri\n".$status."\n";
163           last unless $status =~ /^5/;
164           sleep 20;
165      }
166
167 }
168
169
170 1;
171
172
173 __END__
174
175
176
177
178
179