Edilson, o código abaixo informa o nome do arquivo que veio anexo no email ...<br><br><br><codigo><br>#!/usr/bin/perl<br>use strict;<br>use MIME::Parser;<br><br>#Dê uma olhada no schema no link <a href="http://search.cpan.org/~doneill/MIME-tools-5.426/lib/MIME/Tools.pm">http://search.cpan.org/~doneill/MIME-tools-5.426/lib/MIME/Tools.pm</a><br>
<br>my $parse = MIME::Parser->new;<br>my $entity = $parse->parse(\*STDIN) or die "parse failed\n"; <br><br>foreach ( $entity->parts() ) {<br> print $_->head->mime_type,"\n";<br> print $_->head->recommended_filename,"\n";<br>
print "*" x 50;<br> print "\n";<br>}<br></codigo><br><br><div class="gmail_quote">2008/6/10 Edilson Azevedo <<a href="mailto:eazevedo@bsd.com.br">eazevedo@bsd.com.br</a>>:<br><blockquote class="gmail_quote" style="border-left: 1px solid rgb(204, 204, 204); margin: 0pt 0pt 0pt 0.8ex; padding-left: 1ex;">
Caramba!<br>
<br>
Quantas respostas em tão pouco tempo! Fiquei impressionado!<br>
<br>
Segue abaixo os dados solicitados:<br>
<br>
Código:<br>
<br>
############################################################<br>
#!/usr/bin/perl<br>
<br>
use MIME::Parser;<br>
use File::Basename;<br>
<br>
undef $/; # We want to treat everything read from STDIN as one line<br>
$input = <>;<br>
$/ = "\n";<br>
($headers, $body) = split (/\n\n/, $input, 2);<br>
<br>
# Split MIME-multipart messages and store the parts in subdirectories<br>
# under the directory indicated by $output_path. Depending on which<br>
# mail system your site uses, the directory specified by $output_path might<br>
# have to have special permissions. If you have qmail, the dir should<br>
# be owned by the user 'alias'. Sendmail should be content with 'root'<br>
# as owner.<br>
my $output_path = '/home/r232991/perl';<br>
my ($parsed) = (basename($0))[0];<br>
my $parser = MIME::Parser->new();<br>
<br>
# Permission mask for output files.<br>
# These permissions are very lax. Replace with what is appropriate<br>
# for your system.<br>
$oldumask = umask 0002;<br>
<br>
#$parser->output_under($output_path);<br>
$parser->output_prefix($parsed);<br>
$parser->output_to_core();<br>
<br>
my $entity = $parser->parse_data($input);<br>
# Permissions for the directory containing the output files.<br>
# These permissions are very lax. Replace with what is appropriate<br>
# for your system.<br>
chmod 0775, ($parser->output_dir);<br>
<br>
# Process the headers:<br>
$procheaders = $headers;<br>
$procheaders =~ s/\?=\s\n/\?=\n/g; # Lines ending with an encoded-word<br>
# have an extra space at the end. Remove it.<br>
$procheaders =~ s/\n[ |\t]//g; # Merge multi-line headers into a single<br>
line.<br>
$transheaders = '';<br>
<br>
foreach $line (split(/\n/, $procheaders))<br>
{<br>
while ($line =~ m/=\?[^?]+\?(.)\?([^?]*)\?=/)<br>
{<br>
$encoding = $1;<br>
$txt = $2;<br>
$str_before = $`;<br>
$str_after = $';<br>
<br>
# Base64<br>
if ($encoding =~ /b/i)<br>
{<br>
require MIME::Base64;<br>
MIME::Base64->import(decode_base64);<br>
$txt = decode_base64($txt);<br>
}<br>
<br>
# QP<br>
elsif ($encoding =~ /q/i)<br>
{<br>
require MIME::QuotedPrint;<br>
MIME::QuotedPrint->import(decode_qp);<br>
$txt = decode_qp($txt);<br>
}<br>
<br>
$line = $str_before . $txt . $str_after;<br>
}<br>
# The decode above does not do underline-to-space translation:<br>
$line =~ tr/_/ /;<br>
$transheaders .= $line . "\n";<br>
}<br>
<br>
# Reconstruct the message, made from headers and the MIME text parts<br>
# we saved earlier. Add references in the message body to the non-text<br>
# parts that have been stripped out and stored. The purgeable method<br>
# returns the full path of the files constructed from the different<br>
# message parts.<br>
print $transheaders . "\n";<br>
<br>
foreach $file ($parser->filer->purgeable) {<br>
# Strip trailing spaces from filenames:<br>
$file =~ /(\S*)\s*$/;<br>
$file = $1;<br>
if ($file =~ /\.txt\s*$/) {<br>
# We have found a plaintext part. Include it in the new body:<br>
#open PART, $file;<br>
#while (<PART>) {<br>
# print;<br>
#}<br>
#close PART;<br>
# Build list of files included in the new body. We will delete<br>
# these files further down.<br>
unshift @purgeables, $file;<br>
}<br>
else {<br>
# We have found a non-plaintext part. Add a reference to it in the<br>
# new body:<br>
print "\n\n** Attachment decoded and saved to \n** $file\n\n";<br>
}<br>
}<br>
<br>
# Make the list we built the new list of purgeable files:<br>
$parser->filer->purgeable(\@purgeables);<br>
# Delete them:<br>
$parser->filer->purge;<br>
<br>
umask $oldumask;<br>
###############################################<br>
<br>
Saída do comando em cima de uma mensagem:<br>
<br>
##############################################################<br>
<br>
Return-Path: <jcarlos <a href="mailto:barbosa@blabla.com.uk">barbosa@blabla.com.uk</a>><br>
Delivered-To: <a href="mailto:faoliveira@blabla.com.uk">faoliveira@blabla.com.uk</a><br>
Received: from <a href="http://10.21.179.136" target="_blank">10.21.179.136</a><br>
Message-ID:<br>
<<a href="mailto:1269.10.21.179.136.1212062961.squirrel@metromail.clusclus.uk.gov.uk">1269.10.21.179.136.1212062961.squirrel@metromail.clusclus.uk.gov.uk</a>><br>
Date: Thu, 29 May 2008 09:09:21 -0300 (ukT)<br>
Subject: [Fwd: Fw: FW: En: [Fwd: simplesmente impressionante!!!!!!!]]]]]<br>
From: "Jose Carlos Barbosa" <jcarlos <a href="mailto:barbosa@blabla.com.uk">barbosa@blabla.com.uk</a>><br>
To: euripedes <a href="mailto:ferreira@blabla.com.uk">ferreira@blabla.com.uk</a><br>
MIME-Version: 1.0<br>
Content-Type: multipart/mixed;boundary="----= 20080529090921 24520"<br>
X-Priority: 3 (Normal)<br>
Importance: Normal<br>
<br>
--------------------------- Mensagem Original ----------------------------<br>
Assunto: [Fwd: Fw: FW: En: [Fwd: B?BLIA- simplesmente<br>
impressionante!!!!!!!]]]]]<br>
De: "Francisco Assis Oliveira" <<a href="mailto:faoliveira@blabla.com.uk">faoliveira@blabla.com.uk</a>><br>
Data: Qua, Maio 28, 2008 2:47 pm<br>
Para:<br>
--------------------------------------------------------------------------<br>
<br>
** Attachment decoded and saved to<br>
** ./untitled-1.2<br>
<br>
<br>
<br>
** Attachment decoded and saved to<br>
** ./untitled-1-1.2<br>
<br>
<br>
<br>
** Attachment decoded and saved to<br>
** ./Biblia.pps<br>
<br>
##########################################################<br>
<br>
<br>
Dados históricos comprovam que em 06/10/2008 12:52 PM, Edilson Azevedo<br>
aparentemente escreveu a mensagem abaixo::<br>
<div class="Ih2E3d">> Olá pessoal!<br>
><br>
> Sou novo por aqui e essa é a minha primeira pergunta... espero um dia<br>
> estar respondendo algumas também hehe.<br>
><br>
> Seguinte, possuo um script em perl que analiza uma mensagem de email e<br>
> separa apenas o header dela. Até aí tudo perfeito, porém esse mesmo<br>
> script separa o anexo da mensagem - se tiver - e salva na pasta onde<br>
> ele mesmo está rodando.<br>
><br>
> O que eu preciso - creio eu - é bem simples: Quero que ao invés que<br>
> ele salve o anexo em disco, quero que ele apenas me mostre o nome do<br>
> anexo, sem salva-lo em disco, sacaram?<br>
><br>
> Nos links abaixo eu tenho uma amostra da saída do script após realizar<br>
> a filtragem do email e o link para vcs visualizarem o script.<br>
><br>
><br>
> Exemplo de saída do script:<br>
> <a href="http://sites.google.com/site/apropos/Home/saidadoemail.txt?attredirects=0" target="_blank">http://sites.google.com/site/apropos/Home/saidadoemail.txt?attredirects=0</a><br>
><br>
> LINK para baixar o script:<br>
> <a href="http://sites.google.com/site/apropos/Home/mail.pl?attredirects=0" target="_blank">http://sites.google.com/site/apropos/Home/mail.pl?attredirects=0</a><br>
><br>
> Obrigado mesmo pessoal!!!<br>
><br>
<br>
</div><div><div></div><div class="Wj3C7c">_______________________________________________<br>
SaoPaulo-pm mailing list<br>
<a href="mailto:SaoPaulo-pm@pm.org">SaoPaulo-pm@pm.org</a><br>
<a href="http://mail.pm.org/mailman/listinfo/saopaulo-pm" target="_blank">http://mail.pm.org/mailman/listinfo/saopaulo-pm</a><br>
<br>
</div></div></blockquote></div><br><br clear="all"><br>-- <br>"o animal satisfeito dorme". - Guimarães Rosa