Anhangspeichern.pl

From LUGUM

#!/usr/bin/perl

##############################################################################
#                                                                            #
#      Script zum Abholen von Mails und Extrahieren der Anhaenge             #
#                                                                            #
#           Autor: (C) Andreas Kraus (lug@ak1301.de)                         #
#         Version: 1.0                                                       #
#  Ersterstellung: 23.09.2007                                                #
# Letzte Änderung: 23.09.2007                                                #
#                                                                            #
##############################################################################

use Net::POP3;
use MIME::Parser;
use strict;

# Anmeldedaten
my $username = 'archiv2';
my $password = 'archiv2';
my $pop3host = '10.40.70.5';

# Speicherverzeichnis
my $verzeichnis = './anhang/';



# Verbindet sich mit dem Pop3 Server
my $pop = Net::POP3->new($pop3host, Timeout => 60);

# macht nur weiter wenn Mails auf dem Server liegen.
if ($pop->login($username, $password) > 0) {
    my $msgnums = $pop->list; # 
    foreach my $msgnum (keys %$msgnums) {
         my $fh = $pop->getfh($msgnum);
         my $parser = MIME::Parser->new();
            $parser->output_dir('./anhang/');
            $parser->read($fh);
         close($fh) or die $!;
         # Loescht die Mail auf dem POP3 Server
         ### $pop->delete($msgnum);
         # Loescht den Textteil der Mail
         ### unlink (glob("$verzeichnis/msg-*.txt"));
     }
}
$pop->quit;