lib/PublicInbox/LeiP2q.pm

   1 # Copyright (C) 2021 all contributors <meta@public-inbox.org>
   2 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
   3
   4 # front-end for the "lei patch-to-query" sub-command
   5 package PublicInbox::LeiP2q;
   6 use strict;
   7 use v5.10.1;
   8 use parent qw(PublicInbox::IPC);
   9 use PublicInbox::Eml;
  10 use PublicInbox::Smsg;
  11 use PublicInbox::MsgIter qw(msg_part_text);
  12 use PublicInbox::Git qw(git_unquote);
  13 use PublicInbox::Spawn qw(popen_rd);
  14 use URI::Escape qw(uri_escape_utf8);
  15
  16 sub xphrase ($) {
  17         my ($s) = @_;
  18         return () unless $s =~ /\S/;
  19         # cf. xapian-core/queryparser/queryparser.lemony
  20         # [\./:\\\@] - is_phrase_generator (implicit phrase search)
  21         # FIXME not really sure about these..., we basically want to
  22         # extract the longest phrase possible that Xapian can handle
  23         map {
  24                 s/\A\s*//;
  25                 s/\s+\z//;
  26                 /[\|=><,\sA-Z]/ && !m![\./:\\\@]! ? qq("$_") : $_;
  27         } ($s =~ m!(\w[\|=><,\./:\\\@\-\w\s]+)!g);
  28 }
  29
  30 sub extract_terms { # eml->each_part callback
  31         my ($p, $lei) = @_;
  32         my $part = $p->[0]; # ignore $depth and @idx;
  33         my $ct = $part->content_type || 'text/plain';
  34         my ($s, undef) = msg_part_text($part, $ct);
  35         defined $s or return;
  36         my $in_diff;
  37         # TODO: b: nq: q:
  38         for (split(/\n/, $s)) {
  39                 if ($in_diff && s/^ //) { # diff context
  40                         push @{$lei->{qterms}->{dfctx}}, xphrase($_);
  41                 } elsif (/^-- $/) { # email signature begins
  42                         $in_diff = undef;
  43                 } elsif (m!^diff --git "?[^/]+/.+ "?[^/]+/.+\z!) {
  44                         # wait until "---" and "+++" to capture filenames
  45                         $in_diff = 1;
  46                 } elsif (/^index ([a-f0-9]+)\.\.([a-f0-9]+)\b/) {
  47                         my ($oa, $ob) = ($1, $2);
  48                         push @{$lei->{qterms}->{dfpre}}, $oa;
  49                         push @{$lei->{qterms}->{dfpost}}, $ob;
  50                         # who uses dfblob?
  51                 } elsif (m!^(?:---|\+{3}) ("?[^/]+/.+)!) {
  52                         my $fn = (split(m!/!, git_unquote($1.''), 2))[1];
  53                         push @{$lei->{qterms}->{dfn}}, xphrase($fn);
  54                 } elsif ($in_diff && s/^\+//) { # diff added
  55                         push @{$lei->{qterms}->{dfb}}, xphrase($_);
  56                 } elsif ($in_diff && s/^-//) { # diff removed
  57                         push @{$lei->{qterms}->{dfa}}, xphrase($_);
  58                 } elsif (/^@@ (?:\S+) (?:\S+) @@\s*(\S+.*)/) {
  59                         push @{$lei->{qterms}->{dfhh}}, xphrase($1);
  60                 } elsif (/^(?:dis)similarity index/ ||
  61                                 /^(?:old|new) mode/ ||
  62                                 /^(?:deleted|new) file mode/ ||
  63                                 /^(?:copy|rename) (?:from|to) / ||
  64                                 /^(?:dis)?similarity index / ||
  65                                 /^\\ No newline at end of file/ ||
  66                                 /^Binary files .* differ/) {
  67                 } elsif ($_ eq '') {
  68                         # possible to be in diff context, some mail may be
  69                         # stripped by MUA or even GNU diff(1).  "git apply"
  70                         # treats a bare "\n" as diff context, too
  71                 } else {
  72                         $in_diff = undef;
  73                 }
  74         }
  75 }
  76
  77 my %pfx2smsg = (
  78         t => [ qw(to) ],
  79         c => [ qw(cc) ],
  80         f => [ qw(from) ],
  81         tc => [ qw(to cc) ],
  82         tcf => [ qw(to cc from) ],
  83         a => [ qw(to cc from) ],
  84         s => [ qw(subject) ],
  85         bs => [ qw(subject) ], # body handled elsewhere
  86         d => [ qw(ds) ], # nonsense?
  87         dt => [ qw(ds) ], # ditto...
  88         rt => [ qw(ts) ], # ditto...
  89 );
  90
  91 sub do_p2q { # via wq_do
  92         my ($self) = @_;
  93         my $lei = $self->{lei};
  94         my $want = $lei->{opt}->{want} // [ qw(dfpost7) ];
  95         my @want = split(/[, ]+/, "@$want");
  96         for (@want) {
  97                 /\A(?:(d|dt|rt):)?([0-9]+)(\.(?:day|weeks)s?)?\z/ or next;
  98                 my ($pfx, $n, $unit) = ($1, $2, $3);
  99                 $n *= 86400 * ($unit =~ /week/i ? 7 : 1);
 100                 $_ = [ $pfx, $n ];
 101         }
 102         my $smsg = bless {}, 'PublicInbox::Smsg';
 103         my $in = $self->{0};
 104         unless ($in) {
 105                 my $input = $self->{input};
 106                 if (-e $input) {
 107                         $in = $lei->fopen('<', $input) or
 108                                 return $lei->fail("open < $input: $!");
 109                 } else {
 110                         my @cmd = (qw(git format-patch --stdout -1), $input);
 111                         $in = popen_rd(\@cmd, undef, { 2 => $lei->{2} });
 112                 }
 113         };
 114         my $eml = PublicInbox::Eml->new(\(do { local $/; <$in> }));
 115         $lei->{diff_want} = +{ map { $_ => 1 } @want };
 116         $smsg->populate($eml);
 117         while (my ($pfx, $fields) = each %pfx2smsg) {
 118                 next unless $lei->{diff_want}->{$pfx};
 119                 for my $f (@$fields) {
 120                         my $v = $smsg->{$f} // next;
 121                         push @{$lei->{qterms}->{$pfx}}, xphrase($v);
 122                 }
 123         }
 124         $eml->each_part(\&extract_terms, $lei, 1);
 125         if ($lei->{opt}->{debug}) {
 126                 my $json = ref(PublicInbox::Config->json)->new;
 127                 $json->utf8->canonical->pretty;
 128                 $lei->err($json->encode($lei->{qterms}));
 129         }
 130         my (@q, %seen);
 131         for my $pfx (@want) {
 132                 if (ref($pfx) eq 'ARRAY') {
 133                         my ($p, $t_range) = @$pfx; # TODO
 134
 135                 } elsif ($pfx =~ m!\A(?:OR|XOR|AND|NOT)\z! ||
 136                                 $pfx =~ m!\A(?:ADJ|NEAR)(?:/[0-9]+)?\z!) {
 137                         push @q, $pfx;
 138                 } else {
 139                         my $plusminus = ($pfx =~ s/\A([\+\-])//) ? $1 : '';
 140                         my $end = ($pfx =~ s/([0-9\*]+)\z//) ? $1 : '';
 141                         my $x = delete($lei->{qterms}->{$pfx}) or next;
 142                         my $star = $end =~ tr/*//d ? '*' : '';
 143                         my $min_len = ($end // 0) + 0;
 144
 145                         # no wildcards for bool_pfx_external
 146                         $star = '' if $pfx =~ /\A(dfpre|dfpost|mid)\z/;
 147                         $pfx = "$plusminus$pfx:";
 148                         if ($min_len) {
 149                                 push @q, map {
 150                                         my @t = ($pfx.$_.$star);
 151                                         while (length > $min_len) {
 152                                                 chop $_;
 153                                                 push @t, 'OR', $pfx.$_.$star;
 154                                         }
 155                                         @t;
 156                                 } @$x;
 157                         } else {
 158                                 push @q, map {
 159                                         my $k = $pfx.$_.$star;
 160                                         $seen{$k}++ ? () : $k
 161                                 } @$x;
 162                         }
 163                 }
 164         }
 165         if ($lei->{opt}->{uri}) {
 166                 @q = (join('+', map { uri_escape_utf8($_) } @q));
 167         } else {
 168                 @q = (join(' ', @q));
 169         }
 170         $lei->out(@q, "\n");
 171 }
 172
 173 sub call { # the "lei patch-to-query" entry point
 174         my ($cls, $lei, $input) = @_;
 175         my $self = $lei->{p2q} = bless {}, $cls;
 176         if ($lei->{opt}->{stdin}) {
 177                 $self->{0} = delete $lei->{0}; # guard from lei_atfork_child
 178         } else {
 179                 $self->{input} = $input;
 180         }
 181         my $op = $lei->workers_start($self, 'lei patch2query', 1, {
 182                 '' => [ $lei->{p2q_done} // $lei->can('dclose'), $lei ]
 183         });
 184         $self->wq_io_do('do_p2q', []);
 185         $self->wq_close(1);
 186         while ($op && $op->{sock}) { $op->event_step }
 187 }
 188
 189 sub ipc_atfork_child {
 190         my ($self) = @_;
 191         my $lei = $self->{lei};
 192         $lei->lei_atfork_child;
 193         $SIG{__WARN__} = PublicInbox::Eml::warn_ignore_cb();
 194         $self->SUPER::ipc_atfork_child;
 195 }
 196
 197 1;