lib/PublicInbox/LeiOverview.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 # per-mitem/smsg iterators for search results
   5 # "ovv" => "Overview viewer"
   6 package PublicInbox::LeiOverview;
   7 use strict;
   8 use v5.10.1;
   9 use parent qw(PublicInbox::Lock);
  10 use POSIX qw(strftime);
  11 use Fcntl qw(F_GETFL O_APPEND);
  12 use File::Spec;
  13 use File::Temp ();
  14 use PublicInbox::MID qw($MID_EXTRACT);
  15 use PublicInbox::Address qw(pairs);
  16 use PublicInbox::Config;
  17 use PublicInbox::Search qw(get_pct);
  18
  19 # cf. https://en.wikipedia.org/wiki/JSON_streaming
  20 my $JSONL = 'ldjson|ndjson|jsonl'; # 3 names for the same thing
  21
  22 sub _iso8601 ($) { strftime('%Y-%m-%dT%H:%M:%SZ', gmtime($_[0])) }
  23
  24 # we open this in the parent process before ->wq_do handoff
  25 sub ovv_out_lk_init ($) {
  26         my ($self) = @_;
  27         $self->{tmp_lk_id} = "$self.$$";
  28         my $tmp = File::Temp->new("lei-ovv.out.$$.lock-XXXXXX",
  29                                         TMPDIR => 1, UNLINK => 0);
  30         $self->{lock_path} = $tmp->filename;
  31 }
  32
  33 sub ovv_out_lk_cancel ($) {
  34         my ($self) = @_;
  35         ($self->{tmp_lk_id}//'') eq "$self.$$" and
  36                 unlink(delete($self->{lock_path}));
  37 }
  38
  39 sub new {
  40         my ($class, $lei) = @_;
  41         my $opt = $lei->{opt};
  42         my $out = $opt->{output} // '-';
  43         $out = '/dev/stdout' if $out eq '-';
  44
  45         my $fmt = $opt->{'format'};
  46         $fmt = lc($fmt) if defined $fmt;
  47         if ($out =~ s/\A([a-z]+)://is) { # e.g. Maildir:/home/user/Mail/
  48                 my $ofmt = lc $1;
  49                 $fmt //= $ofmt;
  50                 return $lei->fail(<<"") if $fmt ne $ofmt;
  51 --format=$fmt and --output=$ofmt conflict
  52
  53         }
  54         $fmt //= 'json' if $out eq '/dev/stdout';
  55         $fmt //= 'maildir'; # TODO
  56
  57         if (index($out, '://') < 0) { # not a URL, so assume path
  58                  $out = File::Spec->canonpath($out);
  59         } # else URL
  60
  61         my $self = bless { fmt => $fmt, out => $out }, $class;
  62         my $json;
  63         if ($fmt =~ /\A($JSONL|(?:concat)?json)\z/) {
  64                 $json = $self->{json} = ref(PublicInbox::Config->json);
  65         }
  66         my ($isatty, $seekable);
  67         if ($out eq '/dev/stdout') {
  68                 $isatty = -t $lei->{1};
  69                 $lei->start_pager if $isatty;
  70                 $opt->{pretty} //= $isatty;
  71                 if (!$isatty && -f _) {
  72                         my $fl = fcntl($lei->{1}, F_GETFL, 0) //
  73                                 return $lei->fail("fcntl(stdout): $!");
  74                         ovv_out_lk_init($self) unless ($fl & O_APPEND);
  75                 } else {
  76                         ovv_out_lk_init($self);
  77                 }
  78         } elsif ($json) {
  79                 return $lei->fail('JSON formats only output to stdout');
  80         } else {
  81                 return $lei->fail("TODO: $out -f $fmt");
  82         }
  83         $self;
  84 }
  85
  86 # called once by parent
  87 sub ovv_begin {
  88         my ($self, $lei) = @_;
  89         if ($self->{fmt} eq 'json') {
  90                 print { $lei->{1} } '[';
  91         } # TODO HTML/Atom/...
  92 }
  93
  94 # called once by parent (via PublicInbox::EOFpipe)
  95 sub ovv_end {
  96         my ($self, $lei) = @_;
  97         if ($self->{fmt} eq 'json') {
  98                 # JSON doesn't allow trailing commas, and preventing
  99                 # trailing commas is a PITA when parallelizing outputs
 100                 print { $lei->{1} } "null]\n";
 101         } elsif ($self->{fmt} eq 'concatjson') {
 102                 print { $lei->{1} } "\n";
 103         }
 104 }
 105
 106 sub ovv_atfork_child {
 107         my ($self) = @_;
 108         # reopen dedupe here
 109 }
 110
 111 # prepares an smsg for JSON
 112 sub _unbless_smsg {
 113         my ($smsg, $mitem) = @_;
 114
 115         delete @$smsg{qw(lines bytes num tid)};
 116         $smsg->{rt} = _iso8601(delete $smsg->{ts}); # JMAP receivedAt
 117         $smsg->{dt} = _iso8601(delete $smsg->{ds}); # JMAP UTCDate
 118         $smsg->{relevance} = get_pct($mitem) if $mitem;
 119
 120         if (my $r = delete $smsg->{references}) {
 121                 $smsg->{refs} = [
 122                                 map { "<$_>" } ($r =~ m/$MID_EXTRACT/go) ];
 123         }
 124         if (my $m = delete($smsg->{mid})) {
 125                 $smsg->{'m'} = "<$m>";
 126         }
 127         for my $f (qw(from to cc)) {
 128                 my $v = delete $smsg->{$f} or next;
 129                 $smsg->{substr($f, 0, 1)} = pairs($v);
 130         }
 131         $smsg->{'s'} = delete $smsg->{subject};
 132         # can we be bothered to parse From/To/Cc into arrays?
 133         scalar { %$smsg }; # unbless
 134 }
 135
 136 sub ovv_atexit_child {
 137         my ($self, $lei) = @_;
 138         if (my $bref = delete $lei->{ovv_buf}) {
 139                 my $lk = $self->lock_for_scope;
 140                 print { $lei->{1} } $$bref;
 141         }
 142 }
 143
 144 # JSON module ->pretty output wastes too much vertical white space,
 145 # this (IMHO) provides better use of screen real-estate while not
 146 # being excessively compact:
 147 sub _json_pretty {
 148         my ($json, $k, $v) = @_;
 149         if (ref $v eq 'ARRAY') {
 150                 if (@$v) {
 151                         my $sep = ",\n" . (' ' x (length($k) + 7));
 152                         if (ref($v->[0])) { # f/t/c
 153                                 $v = '[' . join($sep, map {
 154                                         my $pair = $json->encode($_);
 155                                         $pair =~ s/(null|"),"/$1, "/g;
 156                                         $pair;
 157                                 } @$v) . ']';
 158                         } else { # references
 159                                 $v = '[' . join($sep, map {
 160                                         substr($json->encode([$_]), 1, -1);
 161                                 } @$v) . ']';
 162                         }
 163                 } else {
 164                         $v = '[]';
 165                 }
 166         }
 167         qq{  "$k": }.$v;
 168 }
 169
 170 sub ovv_each_smsg_cb {
 171         my ($self, $lei) = @_;
 172         $lei->{ovv_buf} = \(my $buf = '');
 173         delete(@$self{qw(lock_path tmp_lk_id)}) unless $lei->{-parallel};
 174         my $json = $self->{json}->new;
 175         $lei->{1}->autoflush(1);
 176         if ($json) {
 177                 $json->utf8->canonical;
 178                 $json->ascii(1) if $lei->{opt}->{ascii};
 179         }
 180         if ($self->{fmt} =~ /\A(concat)?json\z/ && $lei->{opt}->{pretty}) {
 181                 my $EOR = ($1//'') eq 'concat' ? "\n}" : "\n},";
 182                 sub { # DIY prettiness :P
 183                         my ($smsg, $mitem) = @_;
 184                         $smsg = _unbless_smsg($smsg, $mitem);
 185                         $buf .= "{\n";
 186                         $buf .= join(",\n", map {
 187                                 my $v = $smsg->{$_};
 188                                 if (ref($v)) {
 189                                         _json_pretty($json, $_, $v);
 190                                 } else {
 191                                         $v = $json->encode([$v]);
 192                                         qq{  "$_": }.substr($v, 1, -1);
 193                                 }
 194                         } sort keys %$smsg);
 195                         $buf .= $EOR;
 196                         if (length($buf) > 65536) {
 197                                 my $lk = $self->lock_for_scope;
 198                                 print { $lei->{1} } $buf;
 199                                 $buf = '';
 200                         }
 201                 }
 202         } elsif ($json) {
 203                 my $ORS = $self->{fmt} eq 'json' ? ",\n" : "\n"; # JSONL
 204                 sub {
 205                         my ($smsg, $mitem) = @_;
 206                         delete @$smsg{qw(tid num)};
 207                         $buf .= $json->encode(_unbless_smsg(@_)) . $ORS;
 208                         if (length($buf) > 65536) {
 209                                 my $lk = $self->lock_for_scope;
 210                                 print { $lei->{1} } $buf;
 211                                 $buf = '';
 212                         }
 213                 }
 214         } elsif ($self->{fmt} eq 'oid') {
 215                 sub {
 216                         my ($smsg, $mitem) = @_;
 217                 }
 218         } # else { ...
 219 }
 220
 221 no warnings 'once';
 222 *DESTROY = \&ovv_out_lk_cancel;
 223
 224 1;