#!/usr/bin/env perl
#
# ./undup-mbox, but with a proper mailbox processing library
#
# $Id$

use strict;
use warnings;

use Getopt::Std;
use Mail::Box::Manager;

my %opt;
getopts( 'dhilB:H:o:ux:', \%opt );

$opt{h} and HELP_MESSAGE();

sub HELP_MESSAGE
{
  print STDERR <<ZZ;

Usage: $0 [-H [!]regex] [-B [!]regex] [-i] [-l] [-u] [-x mbox] [-d] mbox1 [mbox2 [...]]]

to read one or more mail files in Unix mbox format,
and output messages from them in mbox format on standard output.

Options:

  -H [!]regex

     Only output the messages of which some line in the headers
     matches regex, a regular expression, or, if a ! is prefixed,
     of which *no* line in the headers matches regex.

  -B [!]regex

     Only output the messages of which some line in the body
     matches regex, a regular expression, or, if a ! is prefixed,
     of which *no* line in the body matches regex.

  -i

     Match case-insensitively.

  -u

     Deduplicate messages (using the Message-ID header).

  -x mbox

     Do *not* print any messages from the given mbox file
     (based on, again, the Message-ID header).

  -d

     Print debug messages.

Example:

  $0 -H '^Date: .* 2012' \$MAIL

    outputs the messages from your Unix mailbox that arrived in 2012.

  $0 -ue '!^Newsgroups: ' *

    outputs messages from mailbox files in the current directory
    that are not newsgroup postings, never outputting a message twice.

ZZ
  exit(0);
}

my $outbox = $opt{o};

sub create_filter
{
  my ($BH) = @_;

  if ( defined $opt{$BH} )
  {
    my ( $negate, $regex ) = ( $opt{$BH} // '.' ) =~ /^(!*)(.*)/;
    $negate = length($negate) % 2;
    $regex = $opt{i} ? qr/$regex/mi : qr/$regex/m;

    sub {
      my ($lines) = @_;
      my $matches = 0 + ( $lines =~ /$regex/ );
      #warn "xor of negate ($negate) and matches ($matches) is ", ($negate xor $matches), "\n";
      ( $negate xor $matches )    # XOR
     }
  }
  else
  {
    sub { 1 }
  }
}

my %passes =    # maps 'H' and 'B' to the header and body passes, resp.
 (
  'H' => create_filter('H'),
  'B' => create_filter('B')
 );

my $mgr = new Mail::Box::Manager;

if ( $opt{d} )
{
  $mgr->defaultTrace('DEBUG');
}

my $out;

if ( defined $outbox )
{
  $out = $mgr->open( folder => $outbox, access => 'rw', create => 1 )
   or die "cannot open/create output mbox '$outbox'\n";

  # access should be w except for a bug in Mail::Box::File, see
  # https://rt.cpan.org/Ticket/Display.html?id=44439
}

my %uid;    # the IDs of messages found, if -u is specified
my %xid;    # the IDs of messages to exclude, if -x is specified

if ( $opt{x} )
{
  # the argument is the mailbox to *subtract* from the
  # other messages

  my $xbox = $opt{x};
  my $xin = $mgr->open( folder => $xbox, access => 'r', keep_dups => 0 )
   or die "cannot open input mbox '$xbox'\n";

  foreach my $msg ( $xin->messages )
  {
    ++$xid{ $msg->messageId };
  }
  $mgr->close( $xin, write => 'NEVER' );
}

@ARGV or die "specify at least one mailbox file as argument\n";

my %argv_matches;
$opt{l} and $| = 1;    # flush the output

foreach my $inbox (@ARGV)
{
  my $in = $mgr->open(
    folder    => $inbox,
    access    => 'r',
    lock_type => 'NONE',
    keep_dups => !$opt{u}
  ) or die "cannot open input mbox '$inbox'\n";

  foreach my $msg ( $in->messages )
  {
    next
     if defined $xid{ $msg->messageId };

    if ( $opt{u} )
    {
      # de-duplicate even between different input folders
      next
       if defined $uid{ $msg->messageId };
      ++$uid{ $msg->messageId };
    }

    if ( $passes{'H'}( $msg->head() ) && $passes{'B'}( $msg->body() ) )
    {
      if ( $opt{l} )
      {
        $argv_matches{$inbox}++
         or print "$inbox\n";    # print its name on the first match
      }
      elsif ( defined $out )
      {
        $mgr->copyMessage( $out, $msg );
      }
      else
      {
        $msg->write;
      }
    }
  }

  $mgr->close( $in, write => 'NEVER' );
}

if ( defined $out )
{
  $mgr->close( $out, write => 'ALWAYS' )
   or die "could not write outbox '$outbox': $!\n";
}