File Coverage

blib/lib/Mail/Audit/Attach.pm

Criterion	Covered	Total	%
statement	18	111	16.2
branch	0	34	0.0
condition	0	17	0.0
subroutine	6	19	31.5
pod	7	10	70.0
total	31	191	16.2

package Mail::Audit::Attach;

# Copyright (c) 2002-2010 Christian Renz . All rights reserved.
# This program is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.

use strict;
use vars qw($VERSION @ISA $ERROR);
use MIME::Entity;
use File::Spec;

$VERSION = '0.96';

@ISA = qw(MIME::Entity);

$ERROR = '';

# constructor

sub new {
    my $class = shift;
    my %opts = @_;
    my $self = $opts{ENTITY};
    $self->{MAIL_AUDIT_OBJ} = $opts{CREATOR};

    bless $self, $class;
}

# properties

sub error {
    return $ERROR;
}

sub _set_error {
    my ($error) = @_;

    $ERROR = $error;

    return undef;
}

sub size {
    my $self = shift;
    my $body = $self->bodyhandle;

    if (defined($body->path)) {
	return -s $body->path;
    } else {
	return length($body->as_string);
    }
}

sub filename {
    my $self = shift;

    return $self->head->recommended_filename;
}

sub safe_filename {
    my $self = shift;
    my $filename = $self->filename;

    $filename =~ s,([/:;|]|\s|\\|\[|\])+,_,g;

    return ($filename || 'attachment');
}

# actions

sub remove {
    my $self = shift;

    return _remove_part($self->{MAIL_AUDIT_OBJ}, $self);
}

# Internal helper function that walks through MIME parts to remove a part.
sub _remove_part {
    my $msg = shift;
    my $part = shift;
    local $_;

    foreach ($msg->parts) {
	if ($_ == $part) {
	    $part->bodyhandle->purge;
	    $msg->parts([ grep { $_ != $part } $msg->parts ]);
	    return 1;
	} elsif ($_->parts > 0) {
	    return _remove_part($_, $part);
	}
    }

    return undef;
}

sub save {
    my $self = shift;
    my $location = shift || File::Spec->curdir;
    my $filename = $self->safe_filename;
    my $n = 1;
    local $_;

    if (-d $location) {
	$filename = File::Spec->catfile($location, $self->safe_filename);
    } else {
	$filename = $location;
    }

    if (-e $filename) {
	while (-e "$filename.$n") {
	    $n++;
	}

	$filename = "$filename.$n";
    }

    my $io = $self->open("r")
	or return _set_error("Can't open internal bodyhandle");
    open(SAVE, ">$filename")
	or return _set_error("Can't save to '$filename': $!\n");
    while (defined($_ = $io->getline)) {
	print SAVE $_;
    }
    close(SAVE);
    $io->close;

    return $filename;
}

1;

package Mail::Audit;

use MIME::Entity;
use MIME::Head;

sub num_attachments {
    my $self = shift;
    my $count = 0;
    local $_;

    if (UNIVERSAL::isa($self, "MIME::Entity")) {
	foreach ($self->parts_DFS) {
	    $count++
		if (defined $_->head->recommended_filename());
	}

	return $count;
    } else {
	return 0;
    }
}

sub attachments {
# TODO: walk the tree ourself and save the parent instead of CREATOR.
    my $self = shift;
    local $_;

    if (UNIVERSAL::isa($self, "MIME::Entity")) {
	my @entities = grep { defined $_->head->recommended_filename }
	                    $self->parts_DFS;
        my $attachments = [];
        foreach (@entities) {
	    push @$attachments, Mail::Audit::Attach->new(ENTITY => $_,
							 CREATOR => $self);
	}

        return $attachments;
    } else {
	return undef;
    }
}

sub remove_attachments {
    my $self = shift;
    my %opts = @_;

    if (UNIVERSAL::isa($self, "MIME::Entity")) {
	return _remove_attachments($self, %opts);
    } else {
	return undef;
    }
}

# Internal helper function that walks through MIME parts to remove
# attachments
sub _remove_attachments {
    my $msg = shift;
    my %opts = @_;
    my $count = 0;
    local $_;

    my @parts = $msg->parts;
    foreach my $part (@parts) {
	if (defined $part->head->recommended_filename()) {
	  COND: {
	      last COND if (defined($opts{mime_type}) &&
			    $part->mime_type !~ $opts{mime_type});
	      last COND if (defined($opts{filename}) &&
			    $part->filename !~ $opts{filename});
	      last COND if (defined($opts{bigger_than}) &&
			    $part->size >= $opts{smaller_than});
	      last COND if (defined($opts{bigger_than}) &&
			    $part->size <= $opts{bigger_than});

	      $part->bodyhandle->purge;
	      $msg->parts([ grep { $_ != $part } $msg->parts ]);
	      $count++;
	  }
        } elsif ($part->parts > 0) {
            $count += _remove_attachments($part, %opts);
        }
    }

    return $count;
}



1;

__END__