run update-copyrights from gnulib for 2019

[public-inbox.git] / lib / PublicInbox / ExtMsg.pm

diff --git a/lib/PublicInbox/ExtMsg.pm b/lib/PublicInbox/ExtMsg.pm
index 04cb40623de30f8105e5af1cb8c6254f2128607c..167dc5e5d37fe0e2185d2eccbc47ff6f94263131 100644 (file)
--- a/lib/PublicInbox/ExtMsg.pm
+++ b/lib/PublicInbox/ExtMsg.pm
@@ -1,4 +1,4 @@
-# Copyright (C) 2015-2018 all contributors <meta@public-inbox.org>
+# Copyright (C) 2015-2019 all contributors <meta@public-inbox.org>
 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
 #
 # Used by the web interface to link to messages outside of the our
@@ -8,12 +8,13 @@
 package PublicInbox::ExtMsg;
 use strict;
 use warnings;
-use PublicInbox::Hval;
+use PublicInbox::Hval qw/ascii_html/;
 use PublicInbox::MID qw/mid2path/;
 use PublicInbox::WwwStream;
+our $MIN_PARTIAL_LEN = 16;
 
 # TODO: user-configurable
-our @EXT_URL = (
+our @EXT_URL = map { ascii_html($_) } (
        # leading "//" denotes protocol-relative (http:// or https://)
        '//marc.info/?i=%s',
        '//www.mail-archive.com/search?l=mid&q=%s',
@@ -26,6 +27,53 @@ our @EXT_URL = (
                'doc-url=/lurker&format=en.html&query=id:%s'
 );
 
+sub PARTIAL_MAX () { 100 }
+
+sub search_partial ($$) {
+       my ($srch, $mid) = @_;
+       return if length($mid) < $MIN_PARTIAL_LEN;
+       my $opt = { limit => PARTIAL_MAX, mset => 2 };
+       my @try = ("m:$mid*");
+       my $chop = $mid;
+       if ($chop =~ s/(\W+)(\w*)\z//) {
+               my ($delim, $word) = ($1, $2);
+               if (length($word)) {
+                       push @try, "m:$chop$delim";
+                       push @try, "m:$chop$delim*";
+               }
+               push @try, "m:$chop";
+               push @try, "m:$chop*";
+       }
+
+       # break out long words individually to search for, because
+       # too many messages begin with "Pine.LNX." (or "alpine" or "nycvar")
+       if ($mid =~ /\w{9,}/) {
+               my @long = ($mid =~ m!(\w{3,})!g);
+               push(@try, join(' ', map { "m:$_" } @long));
+
+               # is the last element long enough to not trigger excessive
+               # wildcard matches?
+               if (length($long[-1]) > 8) {
+                       $long[-1] .= '*';
+                       push(@try, join(' ', map { "m:$_" } @long));
+               }
+       }
+
+       foreach my $m (@try) {
+               # If Xapian can't handle the wildcard since it
+               # has too many results.  $@ can be
+               # Search::Xapian::QueryParserError or even:
+               # "something terrible happened at ../Search/Xapian/Enquire.pm"
+               my $mset = eval { $srch->query($m, $opt) } or next;
+
+               my @mids = map {
+                       my $doc = $_->get_document;
+                       PublicInbox::SearchMsg->load_doc($doc)->mid;
+               } $mset->items;
+               return \@mids if scalar(@mids);
+       }
+}
+
 sub ext_msg {
        my ($ctx) = @_;
        my $cur = $ctx->{-inbox};
@@ -56,41 +104,23 @@ sub ext_msg {
        return exact($ctx, \@found, $mid) if @found;
 
        # fall back to partial MID matching
-       my $n_partial = 0;
        my @partial;
-
-       if (my $mm = $cur->mm) {
-               my $tmp_mid = $mid;
-               my $res = $mm->mid_prefixes($tmp_mid, 100);
-               if ($res && scalar(@$res)) {
-                       $n_partial += scalar(@$res);
-                       push @partial, [ $cur, $res ];
-               # fixup common errors:
-               } elsif ($tmp_mid =~ s,/[tTf],,) {
-                       $res = $mm->mid_prefixes($tmp_mid, 100);
-                       if ($res && scalar(@$res)) {
-                               $n_partial += scalar(@$res);
-                               push @partial, [ $cur, $res ];
-                       }
-               }
+       my $n_partial = 0;
+       my $srch = $cur->search;
+       my $mids = search_partial($srch, $mid) if $srch;
+       if ($mids) {
+               $n_partial = scalar(@$mids);
+               push @partial, [ $cur, $mids ];
        }
 
        # can't find a partial match in current inbox, try the others:
-       if (!$n_partial && length($mid) >= 16) {
-               my $tmp_mid = $mid;
-again:
+       if (!$n_partial && length($mid) >= $MIN_PARTIAL_LEN) {
                foreach my $ibx (@ibx) {
-                       my $mm = $ibx->mm or next;
-                       my $res = $mm->mid_prefixes($tmp_mid, 100);
-                       if ($res && scalar(@$res)) {
-                               $n_partial += scalar(@$res);
-                               push @partial, [ $ibx, $res ];
-                               last if $n_partial >= 100;
-                       }
-               }
-               # fixup common errors:
-               if (!$n_partial && $tmp_mid =~ s,/[tTf],,) {
-                       goto again;
+                       $srch = $ibx->search or next;
+                       $mids = search_partial($srch, $mid) or next;
+                       $n_partial += scalar(@$mids);
+                       push @partial, [ $ibx, $mids];
+                       last if $n_partial >= PARTIAL_MAX;
                }
        }
 
@@ -103,6 +133,7 @@ again:
        if ($n_partial) {
                $code = 300;
                my $es = $n_partial == 1 ? '' : 'es';
+               $n_partial .= '+' if ($n_partial == PARTIAL_MAX);
                $s .= "\n$n_partial partial match$es found:\n\n";
                my $cur_name = $cur->{name};
                foreach my $pair (@partial) {