#!/usr/athena/bin/perl
use warnings;
use strict;

sub request_pipe (@) {
  my (@reqs) = @_;

  my $pid = open my $FH, '-|', '-';
  defined $pid or die "open(-|): $!";

  if (! $pid) {
    # child
    exec 'pop', map +( '-request' => $_ ), ( 'c', @reqs, 'q' );
    die "exec: $!";
  }

  $FH;
}

use constant OUT_DBG => 0;
use constant STAT_DBG => 1;

sub request_out (@) {
  my $FH = request_pipe(@_);
  my @data;
  while (<$FH>) {
    chomp;
    print ">> '$_'\n" if OUT_DBG;
    push @data, $_;
  }
  print ">> (end)\n" if OUT_DBG;  
  my $size = @data;
  print ":: request_out: $. blocks read, $size stored\n" if STAT_DBG;  
  @data;
}

sub request_lines (@) {
  local $/ = "\n";
  request_out(@_);
}

sub request_para (@) {
  local $/ = "";
  request_out(@_);
}

sub list (;$) {
  my ($limit) = @_;
  local $/ = "\n";
  my $FH = request_pipe('list');
  my (@data, $count);
  while (<$FH>) {
    chomp;
    /^\s*\d+\s+\d+\b/ or next;
    ++$count;
    my ($msg, $size) = split ' ';
    $limit and $size <= $limit and next;
    push @data, [ $msg, $size ];
  }
  my $size = @data;
  print ":: list: $. lines read, $count data, $size stored\n" if STAT_DBG;  
  @data;
}

sub fmt_size ( $ ) {
  my ($size) = @_;

  my ($scaled, $units) = $size;
  $scaled = $scaled / 1024, $units = 'KB' if $scaled >= 1500;
  $scaled = $scaled / 1024, $units = 'MB' if $scaled >= 1500;
  $scaled = $scaled / 1024, $units = 'GB' if $scaled >= 1500;

  my @frag;
  unshift @frag, $1 while $size =~ s/(?<=\d)(\d{3})$//;
  $size = join(',', $size, @frag) . ' bytes';

  $size = sprintf "%.2f %s; %s", $scaled, $units, $size if $units;
  $size;
}

my $LIMIT = shift(@ARGV) || 100000;

my @list = sort {$b->[1] <=> $a->[1]} list $LIMIT;
my @top = request_para map "top $_->[0]", @list;

@top == @list
  or die "Mismatch: asked for " . @list . " messages, got " . @top;

my @HEADERS = qw( from to cc subject date x-spam-score );

my $HEADER_RE = '^(?i:' . join('|', map lc, @HEADERS) . '):';
$HEADER_RE = qr/$HEADER_RE/;

my @to_del;

MSG:
for my $i (0..$#top) {
  my $N = $list[$i][0];
  my @headers = split /\n(?!\s)/, $top[$i];
  #print "@@ '$_'\n" for @headers;
  my $desc = join "\n", grep(/$HEADER_RE/, @headers);
  #print "DD '$desc'\n";
  $desc =~ s/^/$N:/gm;
  my $size = fmt_size $list[$i][1];
  $desc .= "\n        [size: $size]\n";

  print $desc;
 ANSWER:
  {
    print "\nD(elete)/H(eaders)/F(ull-hdr)/V(iew)/S(kip)/Q(uit)?\n";
    my $ans = scalar <>;
    chomp $ans;
    if      ($ans =~ /^d/i) {
      push @to_del, $N;
    } elsif ($ans =~ /^h/i) {
      print $desc;
      redo ANSWER;
    } elsif ($ans =~ /^f/i) {
      local $SIG{PIPE} = sub {};
      open my $PAGER, '|-', ($ENV{PAGER} || 'less')
	or die "open(|less): $!";
      print $PAGER $top[$i];
      close $PAGER;
      redo ANSWER;
    } elsif ($ans =~ /^v/i) {
      local $SIG{PIPE} = sub {};
      open my $PAGER, '|-', ($ENV{PAGER} || 'less')
	or die "open(|less): $!";
      print $PAGER join "\n\n", map( ((length > 4096) ? '[[...]]' : $_),
				     request_para "retr $N" );
      close $PAGER;
      redo ANSWER;
    } elsif ($ans =~ /^q/i) {
      last MSG;
    } elsif ($ans !~ /^s/i) {
      print "'$ans' unknown!\n";
      redo ANSWER;
    }
  }
}

if (@to_del) {
  print "Processing deletions...\n";
  print request_out map "dele $_", sort {$b <=> $a} @to_del;
  print "...done!\n";
}