lib/PublicInbox/SearchMsg.pm

   1 # Copyright (C) 2015-2019 all contributors <meta@public-inbox.org>
   2 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
   3 # based on notmuch, but with no concept of folders, files or flags
   4 #
   5 # Wraps a document inside our Xapian search index.
   6 # There may be many of these objects loaded in memory at once
   7 # for large threads in our WWW UI.
   8 package PublicInbox::SearchMsg;
   9 use strict;
  10 use warnings;
  11 use base qw(Exporter);
  12 our @EXPORT_OK = qw(subject_normalized);
  13 use PublicInbox::MID qw/mid_clean mid_mime/;
  14 use PublicInbox::Address;
  15 use PublicInbox::MsgTime qw(msg_timestamp msg_datestamp);
  16 use Time::Local qw(timegm);
  17
  18 sub new {
  19         my ($class, $mime) = @_;
  20         bless { mime => $mime }, $class;
  21 }
  22
  23 sub wrap {
  24         my ($class, $mid) = @_;
  25         bless { mid => $mid }, $class;
  26 }
  27
  28 sub get_val ($$) {
  29         my ($doc, $col) = @_;
  30         Search::Xapian::sortable_unserialise($doc->get_value($col));
  31 }
  32
  33 sub to_doc_data {
  34         my ($self, $oid, $mid0) = @_;
  35         $oid = '' unless defined $oid;
  36         join("\n",
  37                 $self->subject,
  38                 $self->from,
  39                 $self->references,
  40                 $self->to,
  41                 $self->cc,
  42                 $oid,
  43                 $mid0,
  44                 $self->{bytes} || '',
  45                 $self->{lines} || ''
  46         );
  47 }
  48
  49 sub load_from_data ($$) {
  50         my ($self) = $_[0]; # data = $_[1]
  51         (
  52                 $self->{subject},
  53                 $self->{from},
  54                 $self->{references},
  55
  56                 # To: and Cc: are stored to optimize HDR/XHDR in NNTP since
  57                 # some NNTP clients will use that for message displays.
  58                 # NNTP only, and only stored in Over(view), not Xapian
  59                 $self->{to},
  60                 $self->{cc},
  61
  62                 $self->{blob},
  63                 $self->{mid},
  64
  65                 # NNTP only
  66                 $self->{bytes},
  67                 $self->{lines}
  68         ) = split(/\n/, $_[1]);
  69 }
  70
  71 sub load_expand {
  72         my ($self, $doc) = @_;
  73         my $data = $doc->get_data or return;
  74         $self->{ts} = get_val($doc, PublicInbox::Search::TS());
  75         my $dt = get_val($doc, PublicInbox::Search::DT());
  76         my ($yyyy, $mon, $dd, $hh, $mm, $ss) = unpack('A4A2A2A2A2A2', $dt);
  77         $self->{ds} = timegm($ss, $mm, $hh, $dd, $mon - 1, $yyyy);
  78         utf8::decode($data);
  79         load_from_data($self, $data);
  80         $self;
  81 }
  82
  83 sub psgi_cull ($) {
  84         my ($self) = @_;
  85         from_name($self); # fill in {from_name} so we can delete {from}
  86
  87         # drop NNTP-only fields which aren't relevant to PSGI results:
  88         # saves ~80K on a 200 item search result:
  89         delete @$self{qw(from ts to cc bytes lines)};
  90         $self;
  91 }
  92
  93 # Only called by PSGI interface, not NNTP
  94 sub load_doc {
  95         my ($class, $doc) = @_;
  96         my $self = bless {}, $class;
  97         psgi_cull(load_expand($self, $doc));
  98 }
  99
 100 # :bytes and :lines metadata in RFC 3977
 101 sub bytes ($) { $_[0]->{bytes} }
 102 sub lines ($) { $_[0]->{lines} }
 103
 104 sub __hdr ($$) {
 105         my ($self, $field) = @_;
 106         my $val = $self->{$field};
 107         return $val if defined $val;
 108
 109         my $mime = $self->{mime} or return;
 110         my @raw = $mime->header($field);
 111         $val = join(', ', @raw);
 112         $val =~ tr/\t\n/  /;
 113         $val =~ tr/\r//d;
 114         $self->{$field} = $val;
 115 }
 116
 117 sub subject ($) { __hdr($_[0], 'subject') }
 118 sub to ($) { __hdr($_[0], 'to') }
 119 sub cc ($) { __hdr($_[0], 'cc') }
 120
 121 # no strftime, that is locale-dependent and not for RFC822
 122 my @DoW = qw(Sun Mon Tue Wed Thu Fri Sat);
 123 my @MoY = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
 124
 125 sub date ($) {
 126         my ($self) = @_;
 127         my $ds = $self->{ds};
 128         return unless defined $ds;
 129         my ($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime($ds);
 130         "$DoW[$wday], " . sprintf("%02d $MoY[$mon] %04d %02d:%02d:%02d +0000",
 131                                 $mday, $year+1900, $hour, $min, $sec);
 132
 133 }
 134
 135 sub from ($) {
 136         my ($self) = @_;
 137         my $from = __hdr($self, 'from');
 138         if (defined $from && !defined $self->{from_name}) {
 139                 my @n = PublicInbox::Address::names($from);
 140                 $self->{from_name} = join(', ', @n);
 141         }
 142         $from;
 143 }
 144
 145 sub from_name {
 146         my ($self) = @_;
 147         my $from_name = $self->{from_name};
 148         return $from_name if defined $from_name;
 149         $self->from;
 150         $self->{from_name};
 151 }
 152
 153 sub ts {
 154         my ($self) = @_;
 155         $self->{ts} ||= eval { msg_timestamp($self->{mime}->header_obj) } || 0;
 156 }
 157
 158 sub ds {
 159         my ($self) = @_;
 160         $self->{ds} ||= eval { msg_datestamp($self->{mime}->header_obj); } || 0;
 161 }
 162
 163 sub references {
 164         my ($self) = @_;
 165         my $x = $self->{references};
 166         defined $x ? $x : '';
 167 }
 168
 169 sub mid ($;$) {
 170         my ($self, $mid) = @_;
 171
 172         if (defined $mid) {
 173                 $self->{mid} = $mid;
 174         } elsif (defined(my $rv = $self->{mid})) {
 175                 $rv;
 176         } else {
 177                 die "NO {mime} for mid\n" unless $self->{mime};
 178                 $self->_extract_mid; # v1 w/o Xapian
 179         }
 180 }
 181
 182 sub _extract_mid { mid_clean(mid_mime($_[0]->{mime})) }
 183
 184 our $REPLY_RE = qr/^re:\s+/i;
 185
 186 sub subject_normalized ($) {
 187         my ($subj) = @_;
 188         $subj =~ s/\A\s+//s; # no leading space
 189         $subj =~ s/\s+\z//s; # no trailing space
 190         $subj =~ s/\s+/ /gs; # no redundant spaces
 191         $subj =~ s/\.+\z//; # no trailing '.'
 192         $subj =~ s/$REPLY_RE//igo; # remove reply prefix
 193         $subj;
 194 }
 195
 196 1;