Schrift
Start · Board · Anwendungen/Programme/Skripte in Perl · Allgemeines zu Perl
[thread]9151[/thread]

Mail in DB speichern

Leser: 2


<< |< 1 2 >| >> 11 Einträge, 2 Seiten
ja.bla
 2007-07-03 15:06
#78160 #78160
User since
2006-01-07
9 Artikel
BenutzerIn
[default_avatar]
Moin,

ich versuche Mails von einem Pop3-Server abzuholen und danach in eine MySQL-DB speichern (Absender, Betreff, Text, kein HTML und keinen Anhang). Beim zerlegen der Mail komm ich nicht wirklich weiter. Mit einem Mime::Parser Script von Thomas Fahle bekomme ich "text/plain" und "text/html".

Mail zerlegen:
Code: (dl )
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
#!/usr/bin/perl -w

use strict;
use MIME::Parser;

my $file = 'Beispielnachricht.txt';

my $parser = MIME::Parser->new();
$parser->output_to_core('ALL');

open(INPUT,$file) or die $!;
my $entity = $parser->read(\*INPUT);
close(INPUT) or die $!;

my $head = $entity->head();
print "From: " ,        $entity->head->get('From');
print "Subject: " ,     $entity->head->get('Subject');
print "MIME type: " ,   $entity->mime_type,"\n";
print "MIME enc: ",     $head->mime_encoding, "\n";

if ($head->mime_type() =~ m/multipart/i) {
        my $part = $entity->parts();
        my $part_entity = $entity->parts(0);
        my $body = $part_entity->as_string;
        print "Parts: $part\n";
        print "$body\n";
}
else{
        my $body = $entity->as_string;
        print "$body\n";
}


Output:
Quote
From: Thomas Fahle <thomas@thomas-fahle.de>
Subject: Testnachricht mit Anh&�ngseln
MIME type: multipart/mixed
MIME enc: 7bit
Parts: 3
Content-Type: multipart/alternative; boundary="------------7FBBC9B0FED4B8DB02DE6558"


--------------7FBBC9B0FED4B8DB02DE6558
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit

Hallo Thomas

Anbei zwei Bildchen

cu
------------------------------------------------------------------------

Thomas

--------------7FBBC9B0FED4B8DB02DE6558
Content-Type: text/html; charset=us-ascii
Content-Transfer-Encoding: 7bit

<HTML>
<BODY TEXT="#000000" BGCOLOR="#FFFFFF" LINK="#0000FF" VLINK="#FF0000" ALINK="#000088">
<FONT COLOR="#33CC00">Hallo Thomas</FONT>

<P>Anbei zwei Bildchen

<P>cu
<BR>
<HR WIDTH="100%">
<BR>Thomas
</BODY>
</HTML>

--------------7FBBC9B0FED4B8DB02DE6558--


Wie komme ich an den reinen Text, ohne den HTML Teil?
Gibts dafür ein anderes nettes Modul?
styx-cc
 2007-07-03 15:13
#78161 #78161
User since
2006-05-20
533 Artikel
BenutzerIn

user image
Vielleicht hilft dir CPAN:dieses Modul weiter..

MfG
Pörl.
renee
 2007-07-03 15:18
#78162 #78162
User since
2003-08-04
14371 Artikel
ModeratorIn
[Homepage] [default_avatar]
Er braucht doch nur den text/plain-Teil zu speichern...
OTRS-Erweiterungen (http://feature-addons.de/)
Frankfurt Perlmongers (http://frankfurt.pm/)
--

Unterlagen OTRS-Workshop 2012: http://otrs.perl-services.de/workshop.html
Perl-Entwicklung: http://perl-services.de/
jan
 2007-07-04 13:15
#78163 #78163
User since
2003-08-04
2536 Artikel
ModeratorIn
[Homepage] [default_avatar]
Code: (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
use Email::MIME;
if(my $parsed = Email::MIME->new($rawmessage))
{
    my $absender = $parsed->header('From');
    my @parts = $parsed->parts;
    my $textinhalt;
    for my $part (@parts)
        {
                if(scalar @{$part->{'parts'}} > 0)
                {
                        for my $part (@{$part->{'parts'}})
                        {
               
 next if($part->content_type =~ m#text/html#);
               
 $textinhalt .= $part->body;
            }
        }
    }
}


ungetestet, aber lässt sich ausbauen, denke ich.
ja.bla
 2007-07-06 15:25
#78164 #78164
User since
2006-01-07
9 Artikel
BenutzerIn
[default_avatar]
Mit dieser Testmail Datei funzt Jans Code, aber wenn ich versuche eine Mail vom Pop3-Server zu übergeben, bekomme ich folgende Ausgabe:
Quote
Use of uninitialized value in concatenation (.) or string at ./pop307.pl line 25.
Absender:
Use of uninitialized value in concatenation (.) or string at ./pop307.pl line 26.
Betreff:
Parts: 1


mein Code:
Code: (dl )
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
#!/usr/bin/perl -w

use strict;
use Email::MIME;
use Net::POP3;

#my $file = 'Beispielnachricht.txt';
#my $file = 'multipart.txt';
#my $message = do { local( @ARGV, $/ ) = $file; <> };

my $host = 'pop.Xserver.de';
my $user = 'user@Xserver.de';
my $pw   = 'tollespw';
  
my $pop = Net::POP3->new($host) || die("Kein Kontakt zu $host. $!");
my $anzahl = $pop->login($user, $pw);
my $message = $pop->get($anzahl);
#print "@$message\n";

if(my $parsed = Email::MIME->new(@$message)){
        my $absender = $parsed->header('From');
        my $subject = $parsed->header('Subject');
        my @parts = $parsed->parts;
        my $parts = $parsed->parts;
        print "Absender: $absender\n";
        print "Betreff: $subject\n";
        print "Parts: $parts\n";
        for my $part (@parts){
                if(scalar @{$part->{'parts'}} > 0){
                        for my $part (@{$part->{'parts'}}){
                                #next if($part->content_type =~ m/text\/html/);
                                my $text .= $part->body;
                                print "Text: $text\n";
                        }
                }
        }
}


Was mach ich falsch?
jan
 2007-07-06 16:06
#78165 #78165
User since
2003-08-04
2536 Artikel
ModeratorIn
[Homepage] [default_avatar]
der fehler liegt beim parsen ...
Code: (dl )
if(my $parsed = Email::MIME->new(@$message)){


bringt nicht das gewünschte ergebnis. du übergibst hier einen array. wenn du print einen gibst, gibt es ihn aus, daher scheint es alles korrekt zu sein ... aber Email::Mime nimmt einfach den ersten parameter. der rest bleibt weg. daher klappt's nicht.

etwas klarer wird's in meinem code, das sind die zeilen
Code: (dl )
1
2
3
4
my $message = $pop->get($msgid);
my $messageall = join("", @$message);

if(my $parsed = Email::MIME->new($messageall)){


und komplett:
Code: (dl )
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
#!/usr/bin/perl -w

use strict;
use Email::MIME;
use Net::POP3;
use Data::Dumper;
#my $file = 'Beispielnachricht.txt';
#my $file = 'multipart.txt';
#my $message = do { local( @ARGV, $/ ) = $file; <> };

my $host = '...';
my $user = ':::';
my $pw   = '---';
 
my $pop = Net::POP3->new($host) || die("Kein Kontakt zu $host. $!");
my $anzahl = $pop->login($user, $pw);
my $msgnums = $pop->list; # hashref of msgnum => size
my @msgids = keys %$msgnums;
my $msgid = shift(@msgids);
my $message = $pop->get($msgid);
my $messageall = join("", @$message);

if(my $parsed = Email::MIME->new($messageall)){
      my $absender = $parsed->header('from');
       my $subject = $parsed->header('subject');
       my @parts = $parsed->parts;
       my $parts = $parsed->parts;
       print "Absender: " . $absender . "\n";
       print "Betreff: $subject\n";
       print "Parts: $parts\n";
       for my $part (@parts){
               if(scalar @{$part->{'parts'}} > 0){
                       for my $part (@{$part->{'parts'}}){
                               #next if($part->content_type =~ m/text\/html/);
                               my $text .= $part->body;
                               print "Text: $text\n";
                       }
               }
       }
}
ja.bla
 2007-07-09 14:41
#78166 #78166
User since
2006-01-07
9 Artikel
BenutzerIn
[default_avatar]
Irgendwie funzt das nich wirklich, z.B. bei Mails mit dem Content-Type: multipart/alternative, da komm ich nicht an den Body der Mail.
Würde viellecht mit "subparts" klappen, aber ich versteh ja nichtmal folgenden Teil aus Jans Code um an die normalen Parts zukommen.

Code: (dl )
1
2
3
4
5
...
for my $part (@parts){
              if(scalar @{$part->{'parts'}} > 0){
                      for my $part (@{$part->{'parts'}}){
...


Über eine Erklärung würde ich mich freuen.
renee
 2007-07-09 14:57
#78167 #78167
User since
2003-08-04
14371 Artikel
ModeratorIn
[Homepage] [default_avatar]
Code: (dl )
1
2
3
Für jedes Element des Arrays @parts{
    wenn in der Arrayreferenz $part->{'parts'} Elemente gespeichert sind {
        Iteriere über die Elemente der Arrayreferenz $part->{'parts'} {
\n\n

<!--EDIT|renee|1183978690-->
OTRS-Erweiterungen (http://feature-addons.de/)
Frankfurt Perlmongers (http://frankfurt.pm/)
--

Unterlagen OTRS-Workshop 2012: http://otrs.perl-services.de/workshop.html
Perl-Entwicklung: http://perl-services.de/
ja.bla
 2007-07-17 00:04
#78168 #78168
User since
2006-01-07
9 Artikel
BenutzerIn
[default_avatar]
hab das jetzt mit CPAN:MIME::Parser realisiert. Und jetzt hab ich das nächste Problem, ich kann keine Umlaute bzw. kein ¤ Zeichen in meine Datenbank schreiben.

Text:
Quote
Betreff: Umlaute ä ö ü Euro ¤
Body: Umlaute ä ö ü Euro ¤


Text in DB:
Quote
Betreff: Umlaute Ã&¤ ö Ã&¼ Euro â&‚¬
Body: Umlaute ä ö ü Euro &¤


Script:
Code: (dl )
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
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
#!/usr/bin/perl -w

use strict;
use utf8;
use DBI;
use Net::POP3;
use MIME::Parser;
use HTML::FormatText::WithLinks;
use MIME::QuotedPrint;
use Encode qw/encode decode/;
use Term::Prompt;

my ( $text_plain, $text_html, $text, $charset );
### POP3
my $host = 'pop.Xserver.de';
my $user = 'script@Xserver.de';
my $pw   = 'tollespw';
### DB
my $database = "ticket";
my $hostname = "127.0.0.1";
my $dsn      = "DBI:mysql:database=$database;host=$hostname";
my $dbuser   = "mydbuser";
my $dbpasswd = 'tollesdbpw';

### POP3 Login
my $pop = Net::POP3->new($host) || die("Kein Kontakt zu $host. $!");
my $anzahl = $pop->login( $user, $pw );

### DB Verbindung
my $dbh = DBI::->connect( $dsn, $dbuser, $dbpasswd,
    { 'RaiseError' => 1, 'AutoCommit' => 1 } )
    or die DBI::errstr;

### Mails abholen
for ( my $i = 1; $i <= $anzahl; $i++ ) {
    my $message = $pop->get($i);
    my $messageall = join( "", @$message );

    ### MIME-Nachricht einlesen und parsen
    my $parser = MIME::Parser->new();
    $parser->output_to_core(1);
    my $top_entity = $parser->parse_data($messageall);

    ### Mail_Header ausgeben
    my $head     = $top_entity->head();
    my $subject  = $head->get('Subject');
    my $absender = $head->get('From');
    $charset      = $head->mime_attr('Content-type.charset');
    $subject     = decode( 'MIME-Header', $subject );
    #$subject      = encode( 'MIME-Header', $subject_utf8 );

    $head->decode;
    $head->unfold;
    print "Subject:     $subject\n";
    print "From:        $absender\n";
    print "Return-Path: ", $head->get('Return-Path');
    print "Date:        ", $head->get('Date');
    print "To:          ", $head->get('To');
    print "Charset:     $charset\n";
    print "Body:\n";

    ### MIME-Nachricht rekursiv durchlaufen
    &walk($top_entity);

    ### Text umwandeln
    if ( defined $text_plain ) { $text = $text_plain }
    else {
        my $formater = HTML::FormatText::WithLinks->new();
        $text = $formater->parse($text_html);
    }
    if ( $charset !~ m/UTF-8/i ) {
        #$text = decode_qp($text);    ### QuotedPrintable String dekodieren
    }

    ### Text anzeigen
    chomp($text);
    print '-' x 60 . "\n";
    print "$text\n";
    print '-' x 60 . "\n";

    ### Text in DB speichern
    my $sth = $dbh->prepare(
        "INSERT INTO mail(id, mailadd, subject, mailtext) VALUES ('',?,?,?)");
    $sth->execute( $absender, $subject, $text );

    ### Mail loeschen?
    my $result
        = prompt( 'y', "Soll eMail $i von $anzahl Gesamt geloescht werden?",
        '', '' );
    if ( $result == 1 ) { $pop->delete($i) }
    undef($text_plain);
    undef($text_html);
}

$pop->quit();
$dbh->disconnect;
exit;

sub walk {    ### Entity
    my $entity = shift if @_;
    return unless defined $entity;
    my $head = $entity->head();

    if ( $head->mime_type() =~ m/multipart/i ) {    ### mehrteilige Nachricht
        my $i;
        my $num_alt_parts = $entity->parts();
        my $current_entity;

        ### alle Teile der Nachricht rekursiv abarbeiten
        for ( $i = 0; $i < $num_alt_parts; $i++ ) {
            $current_entity = $entity->parts($i);
            &walk($current_entity);
        }
    }
    elsif ( $head->mime_type() =~ m#text/plain#i ) {    ### Text Nachricht
        my $body = $entity->bodyhandle();
        if ( defined $body && $body !~ '' ) { $text_plain = $body->as_string }
    }
    elsif ( $head->mime_type() =~ m#text/html#i ) {     ### HTML Nachricht
        print "MIME: ", $head->mime_type(), "\n";
        my $body = $entity->bodyhandle();
        if ( defined $body ) { $text_html = $body->as_string }
    }
}


Die DB Tabellen sind in "utf8_unicode_ci".
Muß ich bevor der Text in die DB geschrieben wird noch den Zeichensatz mit "SET CHARACTER SET charset_name" angeben?

vielen Dank schonma
ptk
 2007-07-17 22:11
#78169 #78169
User since
2003-11-28
3645 Artikel
ModeratorIn
[default_avatar]
Nein, du musst selbst Encode::encode bzw. Encode::decode aufrufen.
<< |< 1 2 >| >> 11 Einträge, 2 Seiten



View all threads created 2007-07-03 15:06.