#! /usr/bin/perl -w
use strict;
use Getopt::Long;
use lib '../../Mail';
use Mail::Box::Manager;
my $VERSION = '2.019';
#-----------
# prototypes
#-----------
sub open_mailboxes();
sub create_outboxes();
sub parse_mailboxes();
sub compile_regex();
sub configure_sigs();
sub get_options();
sub surpress_werr();
sub trace($);
sub usage($);
my @Mailboxes;
my $Outbox;
my %option = ( verbose => 0,
werr => 0,
);
get_options;
usage 2 if not @ARGV;
usage 0 if $option{help};
surpress_werr if not $option{werr};
compile_regex;
my $Manager = Mail::Box::Manager->new;
configure_sigs;
$Outbox = create_outboxes;
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. ";
if(my $mbox = $Manager->open(
folder => "$item/$mb", access => 'r', extract => 'LAZY',
trace => 'NONE'))
{ trace "Success.\n";
push @Mailboxes, $mbox;
}
else { trace "Failed! $item/$mb\n" }
}
closedir DIR;
}
# $item is a file
if (-f $item) {
trace "Opening folder $item. ";
my $mbox = $Manager->open( folder => $item,
access => 'r',
extract => 'LAZY',
trace => 'NONE');
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->messages) {
for my $h (keys %{$option{header}}) {
my $hd = $msg->head->get($h);
my $pat = $option{header}{$h};
next MESSAGE unless defined $hd && $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($Outbox) { $Manager->copyMessage($Outbox, $msg) }
else { $msg->write }
}
}
}
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%',
'werr',
'verbose',
'help|?');
}
sub surpress_werr() {
$SIG{__WARN__} = 0;
}
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>
--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 for 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 is a
standard Perl regular expression, without the leading and trailing slash
'/'. Multiple key=value pairs can be given by separating them with
whitespace. Example:
takemail --header subject=[Hh]ello from=peter\|john ~/Mail
Care must be taken when specifying patterns with special shell characters,
especially those used for piping. This means that '|' etc. will probably
need 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 --verbose
(or C<-v>) In addition to normal output, print a log of what is being 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 2.019