package Mail::Miner::Mail;
use strict;
use warnings;
use Carp;
use base 'Mail::Miner::DBI';
use Date::Manip qw(UnixDate ParseDate);
use Mail::Miner::Attachment;
use Mail::Miner;
__PACKAGE__->set_up_table('messages');
__PACKAGE__->has_many("assets", 'Mail::Miner::Asset' => "message_id");
__PACKAGE__->has_many("attachments", 'Mail::Miner::Attachment' => "message_id");
__PACKAGE__->has_a(
content => 'MIME::Entity',
inflate => sub { $Mail::Miner::parser->parse_data(shift) },
deflate => 'stringify'
);
sub date_epoch {
my $obj = shift;
return UnixDate(ParseDate($obj->received), '%s');
}
sub create {
my ($class, $message) = @_;
croak "Not a MIME::Entity" unless $message->isa("MIME::Entity");
my $head = $message->head;
my $format = "%Y-%m-%d %H:%M:%S";
my ($subject, $from) = map { $head->get($_) } qw(Subject From);
chomp $subject; $subject =~ s/^\s+//; $subject =~ s/\s+$//;
chomp $from; $from =~ s/^\s+//; $from =~ s/\s+$//;
my $obj = $class->SUPER::create(
{
from_address => ($from || "(Unknown Sender)"),
subject => ($subject || "(No subject)"),
received => (UnixDate(
ParseDate($head->get("Date") || scalar localtime)
, $format))
}
);
$message = Mail::Miner::Attachments::detach_attachments($obj, $message);
$obj->content($message);
Mail::Miner::Assets::miner_analyse($obj);
$obj->commit;
return $obj;
}
#sub _quote {
# my ($dbh) = (__PACKAGE__->db_handles)[0];
# return $dbh->quote(shift);
#}
our %basic = # Add additional "basic" terms here
( from => { field => "from_address", type => "=s",
help => "Match messages from a given sender" },
subject => { field => "subject", type => "=s",
help => "Match messages with a given subject" },
id => { field => "id", type => "=i" ,
help => "Match a given Mail Miner ID"} );
sub select {
my $class = shift;
my %options = @_;
# We have some conditions, we'd like a bunch of objects.
my %search;
for (keys %basic) {
next unless exists $options{$_};
my $match = $basic{$_};
if ($match->{type} eq "=s") {
$search{$match->{field}} = "%$options{$_}%";
} elsif ($match->{type} eq "=i") {
my $id;
($id = $options{$_}) =~ s/\D//g;
die "Search term '$options{$_}' for field $_ should be numeric.\n" unless length $id;
$search{$match->{field}} = $id;
} else {
die "Internal urp: Bad match type for $_\n";
}
delete $options{$_};
}
if (!%options) { # Just a basic search
if (!%search) { return $class->retrieve_all };
return $class->search_like(%search);
}
# OK, let's grab a candidate set of records.
my $it = %search ? $class->search_like(%search) : $class->retrieve_all;
my @rv;
my %plugins = Mail::Miner->plugins();
MAILS: while (my $mail = $it->next) {
my @assets = $mail->assets;
next unless @assets;
for my $opt (keys %options) {
die "Unknown search term $opt (".(join ",", keys %plugins).")\n"
unless $plugins{$opt};
my $term = $options{$opt};
my @relevant_assets = grep {$_->creator eq $plugins{$opt}} @assets;
# Do we have a specialised search engine for this plugin?
no strict 'refs';
if (defined (my $search = *{$plugins{$opt}."::search"}{CODE})) {
next MAILS
unless $search->($mail, $term, @relevant_assets);
}
# OK, just do an ordinary regex search on the asset.
next MAILS
unless grep { $_->asset =~ /$term/ } @relevant_assets;
}
# We made it.
push @rv, $mail;
}
return @rv;
}
sub display_verbose {
my ($class, @objs) = @_;
for (@objs) {
print "From mail-miner-".$_->id."\@localhost @{[scalar localtime]}\n";
print $_->content->stringify;
print "\n\n# Mail Miner ID: ".$_->id."\n\n";
# Makes it handy mailbox format.
}
}
sub display_summary {
my ($class, $rr, @objs) = @_;
my %plugins = Mail::Miner->plugins;
my %options = map { $plugins{$_} => 1 } @$rr;
if (!@objs) {
print "No messages matched.\n"; return;
}
print @objs." matches\n";
my $id_width = (sort map {length $_->id} @objs)[-1];
for (@objs) {
printf "%${id_width}i:%10s:%40s:%s\n",
$_->id,
substr($_->received,0,10),
substr($_->from_address,-40,40),
substr($_->subject,0,$ENV{COLUMNS}?$ENV{COLUMNS}-(53+$id_width):25-$id_width);
my $last = "";
for (sort {$a->creator cmp $b->creator } $_->assets) {
next unless $options{$_->creator};
my $metadata = $Mail::Miner::recognisers{$_->creator};
next if $metadata->{nodisplay};
print " ".$metadata->{title}.":\n" unless $last eq $_->creator;
$last = $_->creator;
print $_->asset,"\n";
}
}
}
1;