james
james derry wrote:
this might not be the best-written script, but might this help?
#!/usr/bin/perl
# file: pop_fetch.pl
#text attachments are first appended to a single file, then that file is re-opened for reading and its lines are first matched to one of two regular expressions.
# depending on match, the line is then written to one of two text files
use strict; use lib '.';
use PopParser; use PromptUtil; use Carp qw(carp confess);
$ENV{PATH} = '/bin:/usr/bin:/usr/X11/bin:/usr/local/bin'; delete $ENV{$_} foreach qw/ENV IFS BASH_ENV CDPATH/;
#my($username,$host) = shift =~ /([\w.-]+)@([\w.-]+)/; my $username = "biosci\\user"; my $host = "localhost"; my $netfeed; $username or die <<'USAGE'; Usage: pop_parse.pl [EMAIL PROTECTED] USAGE ;
my $entity; $SIG{INT} = sub { exit 0 };
my $pop = PopParser->new($host) or die "Connect to host: $!\n"; my $passwd = "hoosier";
#create filehandles my $OUT = "test.txt"; if (-e $OUT){ open(OUT, ">>test.txt");} else { `touch test.txt`; open(OUT, ">test.txt");}
my $SWITCHPORT = "biosci_switchport_mac.txt"; if (-e $SWITCHPORT){ open(SWITCHPORT, ">>biosci_switchport_mac.txt");} else { `touch biosci_switchport_mac.txt`; open(SWITCHPORT, ">biosci_switchport_mac.txt");} my $IP = "biosci_mac_ip.txt"; if (-e $IP){ open(IP, ">>biosci_mac_ip.txt"); } else { `touch biosci_mac_ip.txt`; open(IP, ">biosci_mac_ip.txt"); my $header = "ip_address\tmac_address\tfirst_seen\tlast_seen\n"; print IP $header;}
my $message_count = $pop->apop($username => $passwd) || $pop->login($username => $passwd) or die "Can't log in: ",$pop->message,"\n";
for my $msgnum (1..$message_count) {
next unless $entity = $pop->get($msgnum);
display_entity($entity); $entity->purge; $pop->delete($msgnum);
} continue { print "\n" }
# view a message sub display_entity { my $entity = shift;
# A multipart message if ($entity->is_multipart) { handle_multipart($entity); } else { display_part($entity); } }
# called to process all the parts of a multipart entity sub handle_multipart { my $entity = shift; my @parts = $entity->parts;
# separate text/plain parts from the others my @text = grep $_->mime_type eq 'text/plain',@parts; my @attachments = grep $_->mime_type ne 'text/html',@parts;
#print @attachments . "\n";
for (my $i=0;$i<@attachments;$i++) { display_entity($attachments[$i]) } }
# view the content of a message part sub display_part { my $part = shift;
my $head = $part->head;
my $type = $head->mime_type;
my $description = $head->get('Content-Description');
my ($default_name) = $head->get('Content-Disposition') =~ /filename="([^\"]+)"/;
my $body = $part->bodyhandle;
select(OUT); $body->print; } END { $entity->purge if defined $entity; }
#text attachments are first appended to a single file, then that file is re-opened for reading and its lines are first matched to one of two regular expressions.
# depending on match, the line is then written to one of two text files
close OUT; open(OUT, "test.txt");
my $count;
while(<OUT>)
{
if ((/^\w+\-\w+/) && (/\d+\.\d+\.\d+\.\d+\s\w+\/\d+\sVlan\d+\s\w+\:\w+\:\w+:\w+:\w+:\w+\s\d+\-\d+-\d+\s\d+\:\d+\:\d+\s\d+\-\d+-\d+\s\d+\:\d+:\d+\sACO/) && (!/\sPP\d+/))
{s/ACO#//;
print SWITCHPORT $_;}
if (/^\d+\.\d+\.\d+\.\d+\s\w+\:\w+\:\w+:\w+:\w+:\w+\s\d+\-\d+-\d+\s\d+\:\d+\:\d+\s\d+\-\d+-\d+\s\d+\:\d+:\d+/){print IP $_;}
}
close OUT;
close SWITCHPORT; close IP; $pop->quit;
#the glommed file is given a unique filename and archived. my $dts = `date +%s`;
`cp test.txt archive/$dts`; `rm test.txt`;
#END OF SCRIPT
goog luck, james
JupiterHost.Net wrote:
C.F. Scheidecker Antunes wrote:
Hello all,
Hello,
Although I have done this same thing in PHP and Java before I have an urgent need to accomplish it in Perl due to specific requirements.
What I need is to write an application that: - Access a pop3 remote account - Iterate through the list of messages on the server - Download the attachments and save them localy on the machine - delete all downloaded messages
requirements:
- only attachments ending with .txt and .zip should be saved, the rest must be ignored.
OK, so I need help and directions on this.
What are the Perl CPAN modules to achieve it? Browsing CPAN I found: Net-POP3_auth-0.03.tar.gz and Mail-POP3Client-2.16.tar.gz.
However I do not know how can I handle the mime attachment requirement. Read the MIME body, save the attachment with its original name and only .txt and .zip files.
Sorry for the delay I've had this message waiting for a reply and finally am getting to it :)
Ok, use Mail::POP3Client to connect and iterate through each message then delete them
Mail::Internet is excellent for parsing email, althgough it doesn't do MIME.
I;ve used MIME::Parser for parsing the mime stuff.
Its a bit complicated, as all MIME can get due to evil MIME makers.
I'd start there, I also am aware of a module coming out that has a single fucntion that breaks the email up into a hash, incuding a key that is a hash of the attachements.
If you like I can send you more info about it, but its not due out for a few more weeks give or take. It uses Mail::Internet and Mime::Parser and does all the crazy stuff for you :)
So that you could do something like:
#connect # get messages into an array of array refs for(@messages) { my $email = emailhash($_); my %att = %{ $email->{ATTACHED}; # for easier reading :) for(keys %att) { my %part = %{ $att{$_} }; # again for easier reading :) if($part{ctype} eq 'text/plain' && $part{filename} =~ m/\.txt$) { # save file } } } #delete messages
After that, I will need to unzip all the .zip files saved to check inside and do some processing.
Archive::Zip is what I've used to do this :)
I appreacite any help, any links to articles that teach how to do it in perl.
Thanks in advance,
HTH :)
Lee.M - JupiterHost.Net
-- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>
