Email::Store::Attachment - Split attachments from mails

Email-Store documentation Contained in the Email-Store distribution.

Index

Code Index:

NAME

Top

Email::Store::Attachment - Split attachments from mails

SYNOPSIS

Top

    my @attachments = $mail->attachments;
    for (@attachments) {
        print $_->filename, $_->content_type, $_->payload;
    }

DESCRIPTION

Top

This plug-in adds the concept of an attachment. At index time, it removes all attachments from the mail, and stores them in a separate attachments table. This records the filename, content_type and payload of the attachments, and each mail's attachments can be reached through the attachments accessor. The text of the mail, sans attachments, is replaced into the mail table.

WARNING

Top

If your database requires you to turn on some attribute for encoding binary nulls, you need to do this in your call to use Email::Store.

Email-Store documentation Contained in the Email-Store distribution. 
package Email::Store::Attachment;
use base "Email::Store::DBI";
use strict;
use MIME::Parser;
__PACKAGE__->table("attachment");
__PACKAGE__->columns(All => qw[ id mail filename content_type payload ]);
__PACKAGE__->has_a(mail => "Email::Store::Mail");
Email::Store::Mail->has_many(attachments => "Email::Store::Attachment");


sub on_store {
    my ($class, $mail) = @_;

    my $id     = $mail->message_id;
    my $rfc822 = $mail->message;
    my $parser = MIME::Parser->new();

    $parser->output_to_core('ALL');
    $parser->extract_nested_messages(0);

    my $entity = $parser->parse_data($rfc822);

    my @keep;
    for ($entity->parts) {
        push (@keep, $_) && next if keep_part($_);
        my $type    = $_->effective_type;
        my $file    = $_->head->recommended_filename() || invent_filename($type);
        my $payload = $_->bodyhandle->as_string;
        $class->create({ mail => $id,  payload => $payload, content_type => $type, filename => $file });
    }
    $entity->parts(\@keep);
    $entity->make_singlepart;

    $mail->message($entity->as_string);
    undef $mail->{simple}; # Invalidate cache
    $mail->update;
}

sub on_store_order { 1 }

my $gname = 0;

sub invent_filename {
    my ($ct) = @_;
    require MIME::Types;
    my $type = MIME::Types->new->type($ct);
    my $ext = $type && (($type->extensions)[0]);
    $ext ||= "dat";
    return "attachment-$$-".$gname++.".$ext";
}


sub keep_part {
    my $p = shift;
    my $fn = $_->head->recommended_filename();
    my $ct = $p->effective_type                   || 'text/plain';
    my $dp = $p->head->get('Content-Disposition') || 'inline';
    return $ct =~ m[text/plain] && $dp =~ /inline/ && (!defined $fn or $fn =~ /^\s*$/);
}


1;


__DATA__

CREATE TABLE IF NOT EXISTS attachment (
    id           integer NOT NULL PRIMARY KEY AUTO_INCREMENT,
    mail         varchar(255),
    payload      text,
    filename     varchar(255),
    content_type varchar(255)
);