• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 634
  • Last Modified:

More MIME-tools.

I would like to use mimetools to parse a message into ram, look at the attached file names, then be able to save given parts (decided by type or recommended filename) to disk. I also want to be able to give each part a new name if the file already exists.

My code as of now is below, so how do i manipulate the files _before_ actually writing them to disk?

#!/usr/bin/perl -w
use strict;

use MIME::Parser;
use MIME::Head;

my $parser = new MIME::Parser;

# read STDIN
my $entity = $parser->read(\*STDIN) or die "couldn't parse MIME stream";

# to get message headers:
my $head = $entity->head;
#print $head->as_string;
print "\n\n";
my $to = $entity->head->get('To');
my $from = $entity->head->get('from');
my $subject = $entity->head->get('subject');
my $xat = $entity->head->get('X-Apparently-To');
chomp ($to, $subject, $from, $xat);

print "Group: $xat Subject: $subject From: $from\n";
# message parts
my $part;
foreach $part($entity->parts) {
 # do something with message part

 # prints path to extracted file
 print $part->bodyhandle->path;
 print " ";

 # prints mime-type
# print $part->head->mime_type;
# print "\n";
print "\n======================================================================================================================\n";
  • 2
1 Solution

I had the same problems :)

As a result, I allow to MIME parser save attachments to temporary derectory and then in the cycle
foreach $part($entity->parts) {

# procedure SuggestNewPath takes temporary file path as
# parameter, extracts pure filename, checks if this name
# is free in target directory. If not, it adds number to
# the filename

$newpath = &SuggestNewPath($part->bodyhandle->path);

# after that "$newpath" contains new path to the file
# and I move old file to the new location

move ($part->bodyhandle->path, $newpath);


sub SuggestNewPath {
        my ($cfn) = @_;

        my ($name, $ext);
        my $basepath = "/target/directory"

        # get pure filename (assume that it's string
        # after last slash or backslash)
        $cfn =~ s/.*(\/|\\)//g;

        if (-e "$basepath/$cfn") {
                # if file with this name exists
                # we have to give different name
                # to the new file. Split file name
                # into 2 parts: filename & extension
                if ($cfn =~ /^(.*)\./) {
                        ($name,$ext) = ($1,$');
                } else {
                        ($name,$ext) = ($cfn,"");
                my $i = 0;

                # trying filenames like
                # file2.ext, file3.ext

                while (-e "$basepath/$name".++$i.".$ext") {}
                return "$basepath/$name".$i.".$ext";
        } else {
                return "$basepath/$cfn";
j2Author Commented:
Uhm, call me dumb here, but how would i implement that in a "complete" solution? I mean, it solves the generate-new-name part in an excellent way.

I cant make headfs or tails of the mime-tools docs, i seem to be missing the "Newbie" stuff/examples as in "how to check type, size, whatever" and stuff :-/

feel free to ask more questions if you need. When I tried MIME-Tools for the first time, it was not a piece of cake :)

MIME-Tools is a set of modules, basic is MIME::Entity which contains MIME::Head, MIME::Body

To get more info about them, follow this link

and search for "MIME" (by name)

Start with
"MIME-tools - modules for parsing (and creating!) MIME entities"

Then check MIME::Entity, MIME::Head - there are some examples.

Feel free to ask me if you need help (don't close this question till you get it working)

Featured Post

New feature and membership benefit!

New feature! Upgrade and increase expert visibility of your issues with Priority Questions.

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now