#! /usr/bin/perl -w

use strict;
use Getopt::Long;
#use lib '../../Mail';
use Mail::Box::Manager;

my $VERSION = '1.321';

#-----------
# prototypes
#-----------
sub open_mailboxes	();
sub create_outboxes	();
sub parse_mailboxes	();
sub store_on_split	($);
sub compile_regex	();
sub configure_sigs	();
sub get_options		();
sub get_split_on    ();
sub create_splitted	();
sub surpress_werr	();
sub trace			($);
sub usage			($);

my %option = (	verbose => 0, 
				werr => 0, 
			 );
get_options;


usage 2 if not @ARGV;
usage 0 if $option{help};

my @Mailboxes;
my $Outbox;
my $Outdir = $option{outdir} || $ENV{HOME};
my ($Split_crit, $Split_num);
my %Grouped;

surpress_werr if not $option{werr};
compile_regex;

my $Manager = Mail::Box::Manager->new;
configure_sigs;
if (not $option{split}) { $Outbox = create_outboxes }
else { 
	mkdir $Outdir, 0775 or trace $! if not -d $Outdir;
	($Split_crit, $Split_num) = get_split_on;
}
open_mailboxes;
parse_mailboxes;
$Manager->closeAllFolders;

#-----
# subs
#-----

sub open_mailboxes() {

	for my $item (@ARGV) {
	
		# $item is a directory
		if (-d $item) {
			opendir DIR, $item or die "Error: Could not open $item: $!";
			my @mboxes = readdir DIR;
			for my $mb (@mboxes) {
				next if $mb =~ /^\.\.?$/; 
				trace "Opening folder $mb. ";
				my $mbox = $Manager->open(	folder => "$item/$mb", 
											access => 'r',
											lazy_extract => 'ALWAYS');
				if ($mbox) {
					trace "Success.\n";
					push @Mailboxes, $mbox;
				}
				else { trace "Failed!\n" }
			}
			closedir DIR ;
		}
		# $item is a file
		if (-f $item) {
			trace "Opening folder $item. ";
			my $mbox = $Manager->open(	folder => $item, 
										access => 'r',
										lazy_extract => 'ALWAYS');
			if ($mbox) {
					trace "Success.\n";
					push @Mailboxes, $mbox;
			}
			else { trace "Failed!\n" }
		}
	}
}

sub create_outboxes() {
	my $outbox;
	if ($option{outbox}) {
		trace "Creating $option{outbox}. ";
		$outbox = $Manager->open(	folder => $option{outbox}, 
									access => 'w',
									create => 1 );
		if ($outbox) 	{ trace "Success.\n" }
		else			{ trace "Failed!\n" }
	}
	return $outbox;
}
					

sub parse_mailboxes() {
	for my $mbox (@Mailboxes) {
		MESSAGE:
		for my $msg ($mbox->allMessages) {
				
			for my $h (keys %{$option{header}}) {
				my $hd  = $msg->head->get($h);				
				my $pat = $option{header}{$h};
				next MESSAGE if (not $hd or not $hd =~ $pat); 
			}
			
			for my $h (keys %{$option{nheader}}) {
				my $hd  = $msg->head->get($h);
				my $pat = $option{nheader}{$h};
				last if not $hd; 
				next MESSAGE if $hd =~ $pat;
			}
			
			if (not $option{split}) {	
				if ($Outbox) 	{ $Manager->copyMessage($Outbox, $msg) }
				else			{ $msg->print }
			}
			else { store_on_split $msg }
		}
	}
	create_splitted if $option{split};
}

sub store_on_split ($) {
	my $msg = shift;
	my $key;
	eval { $key = $msg->head->get($Split_crit) || 'field not there'; };
	push @{$Grouped{$key}}, $msg; 
}
	
sub create_splitted () {
	my $folder;
	
	for my $k (keys %Grouped) {
	
		if (scalar @{$Grouped{$k}} >= $Split_num) {
			my $i = 1;
			$folder = $k;
			until (! -e "$Outdir/$folder") { $folder = $k.$i++ }
			trace "Creating $Outdir/$folder. ";
			my $mb = $Manager->open(folder => "$Outdir/$folder", access => 'w', 
									create => 1);
			$mb ? trace "Success.\n" : trace "Failed!\n";
			for my $msg (@{$Grouped{$k}}) {
				eval { $Manager->copyMessage($mb, $msg); };
				trace "On eval: $@" if $@;
			}
		}

	}
}
			
sub compile_regex() {
	for my $h (keys %{$option{header}}) {
		my $pat = $option{header}{$h};
		$option{header}{$h} = qr($pat);
	}
	for my $h (keys %{$option{nheader}}) {
		my $pat = $option{nheader}{$h};
		$option{nheader}{$h} = qr($pat);
	}
}

sub configure_sigs() {
	$SIG{INT} = sub {
		print "Received sigint\n";
		$Manager->closeAllFolders;
		exit;
	}
}

sub get_options() {
	use Getopt::Long;
	my $res = GetOptions(\%option,
	                'outdir=s',
					'outbox=s',
					'header=s%',
					'nheader=s%',
					'split=s%',
					'werr',
					'verbose',
					'help|?');
}

sub get_split_on() {
	my $split_on;
	for my $s (keys %{$option{split}}) {
		$split_on = $s;
		last; # only take one field for splitting
	}
	return ($split_on, $option{split}{$split_on});
}

sub surpress_werr() {
	$SIG{__WARN__} = sub { };
}

sub trace($) {
	print STDERR shift if $option{verbose};
}

sub usage($) {
	my $ec = shift;

	warn <<USAGE;
Usage: $0 [options] mailbox/mailbox-dir
options:
	--outdir <dir>            create new mailboxes in <dir>
	--outbox <mbox>           output to <mbox> (defaults to stdout)
	--header <field>=<regex>  capture mails applying to <regexp> 
	                          in header-<field>
	--nheader <field>=<regex> capture mails not applying to <regexp>
	                          in header-<field>
	--split   <field>=<num>   create a new mailbox containing mails
	                          with the same <field>-line if there are 
	                          more than <num> of those
	--verbose                 print what is done
	--werr                    print warnings and errors as well
	--help                    print this help
USAGE

	exit $ec;
}

__END__

=head1 NAME

takemail - walk through mailboxes and grep something

=head1 SYNOPSIS

takemail [--outbox][--outdir][--header][--nheader]
         [--verbose][--werr][--help] mailbox/mailbox-dir

=head1 DESCRIPTION

Dump mails applying to regular expressions either to stdout or into a newly created mailbox.

Options:

=over 4

=item --outbox FILE

(or C<-c>) Create a new mailbox FILE and write the found messages into it. If omitted output goes to stdout.

=item --outdir DIR

Nothing yet.

=item --header HEADER-FIELD=REGEX

Only find messages whose HEADER-FIELD(s) conform to REGEX. REGEX are standard Perl regular expresses without the leading and trailing slash '/'. Multiple key=value pairs can be given by separating them with whitespaces. Example:
	
 takemail --header subject=[Hh]ello from=peter\|john ~/Mail

Care must be taken on special shell characters, especially those for piping. That means, '|' etc. probably needs to be escaped with a backslash '\'.

=item --nheader HEADER-FIELD=REGEX

Only find messages whose HEADER-FIELD(s) do not conform to REGEX. Same usage as --header.

=item --split HEADER-FIELD=NUM

(or C<-s>) Create new mailboxes in --outdir (or $HOME if not given) with all those mails that have the same string in HEADER-FIELD but only if there are more than NUM of those. The following example will split the mailbox ~/received on from-lines and only copying a mail if there are at least 4 others from the same sender into ~/splitted. Each new mailbox will have the value of the from-line in the mail-header as filename:

 takemail --outdir ~/splitted --split from=5 ~/received

=item --verbose

(or C<-v>) Additionally print what is done to stderr.

=item --werr

Nothing yet.

=item --help

(or C<-?>) Print a short summary of options.

=back

=head1 AUTHOR

Tassilo v. Parseval (F<tassilo.parseval@post.rwth-aachen.de>).

All rights reserved.  This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.

=head1 VERSION

This code is beta, version 1.321
