Ok, Just to let you know (may be can helps someone) I did a new recursive function that try to find a body in the mail message including also inline/attached images. These inline immages can easily be replaced in the body message.
This is not bullet proof, I mean, It would have also some mime check. But it works in almost 99% of cases.
here's the code.
Code:
sub get_body {
#--------------------------------------------------------------------
# Parse the body (@lepo's manufacure - warning :::: recursive)
# the funcion seach recursively through whole parts doing two operations: Lookin for subparts, saving attachments and documents.
# nested documents are more relevant.
# From a Head-mail object, it returns an hash with body, array-ref of all attachments and a MIME type.
my $self = shift;
my $head = shift;
my ($body, $type, $attachments);
# is a sub-parts into this part? yeah, let's do the recursive-thing.
if($head->is_multipart) {
my $parts = $head->parts;
for (@$parts) {
my $r = $self->get_body($_);
for my $attach (@{$r->{attachments}}) { push @{$attachments}, $attach ; }
# save the body and type. Remember, nested is more relevant.
($r->{body}) and ($body = $r->{body});
($r->{type}) and ($type = $r->{body});
}
}
$type = lc($head->mime_attr('content-type'));
#this check is a quite rough but is works. (?) Every MIME stat has the word 'text' means it a text, otherwise
#we save it as an attach. This it's not really a smart sub.
if (($type !~ m/text/i)) {
my ($b, $attach);
my $in = $head->body_in;
if ($in eq 'MEMORY') { $b = $head->body_data; }
elsif ($in eq 'HANDLE') { $b = $head->body_handle; }
elsif ($in eq 'FILE') { $b = $head->body_path; }
if($b) {
$attach = { 'name' => $head->recommended_filename() || $self->build_name($type),
'type' => $type || 'application/octet-stream',
'id' => $head->get('content-id'),
'file' => $b,
};
push @{$attachments}, $attach;
# print "\nname= " . $attach->{name} . " type= [" . $attach->{'type'} . "] id= " . $attach->{'id'};
}
}
else {
$body = $head->body_as_string;
}
return { body => $body, attachments => $attachments, type => $type};
} sub build_name {
#-------------------------------------------------------
# given a MIME type return an appropriate filename. Uses global
# object variable $self->{internal_counter}
my $self = shift;
my $type = shift;
my $name = $self->{internal_counter}++; SWITCH:{ $type =~ /html/i and do { $name .= '.html'; last SWITCH };
$type =~ /gif/i and do { $name .= '.gif'; last SWITCH };
$type =~ /png/i and do { $name .= '.png'; last SWITCH };
$type =~ /jpeg/i and do { $name .= '.jpg'; last SWITCH };
$type =~ /jpg/i and do { $name .= '.jpg'; last SWITCH };
$type =~ /xml/i and do { $name .= '.xml'; last SWITCH };
$type =~ /zip/i and do { $name .= '.zip'; last SWITCH };
$type =~ /xml/i and do { $name .= '.xml'; last SWITCH };
$type =~ /mpeg/i and do { $name .= '.mpeg'; last SWITCH };
$type =~ /bmp/i and do { $name .= '.bmp'; last SWITCH };
$type =~ /msword/i and do { $name .= '.doc'; last SWITCH };
$type =~ /x-shockwave-flash/i and do { $name .= '.swf'; last SWITCH };
$type =~ /ms-excel/i and do { $name .= '.xls'; last SWITCH };
}
#debug print "\n $name ($type)";
return $name;
}