Hallo,
ich habe das Problem mit der falschen Kodierung der Dateinamen von Attachment (z.B. "Täst.doc" wird zu "T%E4st.doc"). Verwendet werden die Module Mail::POP3CLient und MIME::Parser bzw. MIME::Head.
Unter WinXP mit Perl 5.8 habe ich das identische Skript verwendet, da hatte ich noch keinerlei Probleme. Unter Win2003 Server mit Perl 5.14 funktioniert es nicht mehr wie gewünscht.
Ich habe keine konkrete Lösung parat, vielleicht kann mir ja hier jemand helfen?! Danke vorab!
Hier der Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
while ("1")
{
my $pop = new Mail::POP3Client( USER => $cfg{pop3user},
PASSWORD => $cfg{pop3pass},
HOST => $cfg{pop3host} );
for(my $i = 1; $i <= $pop->Count(); $i++ )
{
print "\nLade E-Mail vom Server...";
my $CTIME_String = localtime(time);
print LOG ("\n###$CTIME_String###") if ($cfg{logging}==2);
print LOG ("\nLade E-Mail vom Server...") if ($cfg{logging}==2);
my $fh = new IO::File $mailfile, "w";
$pop->HeadAndBodyToFile($fh, $i);
$fh->close;
print "OK\n";
PARSE();
...
..
.
}
sub PARSE
{
my $parser = new MIME::Parser;
$parser->output_to_core(0);
$parser->output_dir($indir);
$parser->ignore_errors(1);
my $ent = $parser->parse_open($mailfile);
if ($Encoding and !$ent->is_multipart)
{
supported MIME::Decoder $Encoding or
die "unsupported encoding: $Encoding\n";
$ent->head->mime_attr("Content-transfer-encoding" => $Encoding);
}
my $head = MIME::Head->from_file($mailfile);
$to = $head->get('From', 0);
my @ar;
if (($to =~ m'\"') && ($to =~ m'\<') && ($to =~ m'\>'))
{
#Vorname und Name extrahieren
@ar = split('\" \<',$to);
$ar[1] =~ s'>''g;
$ar[1] =~ s'<''g;
$to = $ar[1];
$ar[0] =~ s'\"'';
$ar[0] =~ s','';
@ar = split(' ', $ar[0]);
}
$vorname = $ar[1];
$nachname = $ar[0];
$vorname = "unbekannter" unless ($vorname);
$nachname = "Benutzer" unless ($nachname);
$to =~ s'\n''g;
$to =~ s'\r''g;
$to =~ s'>''g;
$to =~ s'.*<''g;
#Löschen des nicht benötigten Mail-Body und die Mailfile
unlink $mailfile;
opendir (INDIR, $indir) or die "Verzeichniss nicht vorhanden";
while ($filename = readdir (INDIR))
{
if (($filename ne ".") && ($filename ne ".."))
{
if ($filename =~ /msg-.*-.*\.txt/i) #löschen des mail body
{
unlink("$indir$filename");
}
else
{
print LOG ("\nAnhang: $filename") if ($cfg{logging}==2);
}
}
}
closedir INDIR;
}