Mail-MboxParser-0.55/0000755000175000017500000000000010346004150014616 5ustar ethanethan00000000000000Mail-MboxParser-0.55/t/0000755000175000017500000000000010346004150015061 5ustar ethanethan00000000000000Mail-MboxParser-0.55/t/8_from_trace.t0000755000175000017500000000176410346002752017637 0ustar ethanethan00000000000000use Test; use File::Spec; use strict; use Mail::MboxParser; my $src = File::Spec->catfile('t', 'testbox'); BEGIN { plan tests => 9 }; my $mb = Mail::MboxParser->new($src); my @mails = $mb->get_messages; # 1 print "Testing num of messages...\n"; ok(scalar @mails, $mb->nmsgs); # 2 - 7 print "Testing from- and received-lines...\n"; ok($mails[0]->from_line, 'From friedrich@pythonpros.com Thu Feb 26 17:23:40 1998'); ok(scalar $mails[0]->trace, 2); ok($mails[1]->from_line, 'From nobody@p11.speed-link.de Thu Jul 05 08:03:22 2001'); ok(scalar $mails[1]->trace, 6); ok($mails[2]->from_line, 'From nobody@p11.speed-link.de Thu Jul 05 08:03:22 2001'); ok(scalar $mails[2]->trace, 6); # 8 - 9 ( for M::MP::M::get_field() ) print "Testing get_field() method...\n"; ok ($mails[0]->get_field('message-id'), 'Message-ID: <34F5EB6C.4F37CD1E@pythonpros.com>'); ok ($mails[4]->get_field('to'), 'To: Tassilo von Parseval , andreas.koenig@anima.de'); Mail-MboxParser-0.55/t/0_pod.t0000755000175000017500000000016610346004070016256 0ustar ethanethan00000000000000eval "use Test::Pod"; if ($@) { print "1..0 # Skip Test::Pod not installed\n"; exit; } all_pod_files_ok(); Mail-MboxParser-0.55/t/old_8_from_trace.t0000755000175000017500000000200410346002752020461 0ustar ethanethan00000000000000use Test; use File::Spec; use strict; use Mail::MboxParser; my $src = File::Spec->catfile('t', 'testbox'); BEGIN { plan tests => 9 }; my $mb = Mail::MboxParser->new($src, oldparser => 1); my @mails = $mb->get_messages; # 1 print "Testing num of messages...\n"; ok(scalar @mails, $mb->nmsgs); # 2 - 7 print "Testing from- and received-lines...\n"; ok($mails[0]->from_line, 'From friedrich@pythonpros.com Thu Feb 26 17:23:40 1998'); ok(scalar $mails[0]->trace, 2); ok($mails[1]->from_line, 'From nobody@p11.speed-link.de Thu Jul 05 08:03:22 2001'); ok(scalar $mails[1]->trace, 6); ok($mails[2]->from_line, 'From nobody@p11.speed-link.de Thu Jul 05 08:03:22 2001'); ok(scalar $mails[2]->trace, 6); # 8 - 9 ( for M::MP::M::get_field() ) print "Testing get_field() method...\n"; ok ($mails[0]->get_field('message-id'), 'Message-ID: <34F5EB6C.4F37CD1E@pythonpros.com>'); ok ($mails[4]->get_field('to'), 'To: Tassilo von Parseval , andreas.koenig@anima.de'); Mail-MboxParser-0.55/t/6_autoload.t0000755000175000017500000000060410346002752017314 0ustar ethanethan00000000000000use Test; use File::Spec; use strict; use Mail::MboxParser; my $src = File::Spec->catfile('t', 'testbox'); BEGIN { plan tests => 5 }; my $mb = Mail::MboxParser->new($src); my @a = $mb->get_messages; my $msg = $a[8]; ok(defined $mb); ok($msg->effective_type, 'multipart/mixed'); ok($msg->num_entities, 3); ok($msg->parts_DFS, 2); ok($msg->parts(1)->make_singlepart eq 'ALREADY'); Mail-MboxParser-0.55/t/2_for.t0000755000175000017500000000225210346002752016267 0ustar ethanethan00000000000000use Test; use File::Spec; use strict; use Mail::MboxParser; my $src = File::Spec->catfile('t', 'testbox'); BEGIN { plan tests => 28 }; my $mb = Mail::MboxParser->new($src); my @mails = $mb->get_messages; # 1 print "Testing num of messages...\n"; ok(scalar @mails, $mb->nmsgs); # 2 - 9 print "Testing subjects...\n"; ok($mails[1]->header->{subject}, 'Welcome new user VPARSEVAL'); ok($mails[2]->header->{subject}, 'Welcome new user VPARSEVAL'); ok($mails[3]->header->{subject}, 'Password Update'); ok($mails[4]->header->{subject}, 'Notification from PAUSE'); ok($mails[5]->header->{subject}, 'CPAN Upload: V/VP/VPARSEVAL/Mail-MboxParser-0.01.tar.gz'); ok($mails[6]->header->{subject}, 'Module submission Mail::MboxParser'); ok($mails[7]->header->{subject}, 'Module submission Mail::MboxParser'); ok($mails[8]->header->{subject}, 'Re: Mail::MboxParser'); # 10-25 print "Testing attachments...there should be none\n"; for my $msg (@mails[0..7]) { ok($msg->num_entities, 1); ok($msg->get_attachments, undef); } # 26-28 print "Testing attachments on multipart...\n"; ok($mails[8]->num_entities, 3); ok($mails[8]->get_attachments); ok($mails[8]->get_attachments('Plans'), 2); Mail-MboxParser-0.55/t/old_3_while.t0000755000175000017500000000234710346002752017455 0ustar ethanethan00000000000000use Test; use File::Spec; use strict; use Mail::MboxParser; my $src = File::Spec->catfile('t', 'testbox'); BEGIN { plan tests => 28 }; my $mb = Mail::MboxParser->new($src, oldparser => 3); my @mails; while (my $msg = $mb->next_message) { push @mails, $msg; } # 1 print "Testing num of messages...\n"; ok(scalar @mails, $mb->nmsgs); # 2 - 9 print "Testing subjects...\n"; ok($mails[1]->header->{subject}, 'Welcome new user VPARSEVAL'); ok($mails[2]->header->{subject}, 'Welcome new user VPARSEVAL'); ok($mails[3]->header->{subject}, 'Password Update'); ok($mails[4]->header->{subject}, 'Notification from PAUSE'); ok($mails[5]->header->{subject}, 'CPAN Upload: V/VP/VPARSEVAL/Mail-MboxParser-0.01.tar.gz'); ok($mails[6]->header->{subject}, 'Module submission Mail::MboxParser'); ok($mails[7]->header->{subject}, 'Module submission Mail::MboxParser'); ok($mails[8]->header->{subject}, 'Re: Mail::MboxParser'); # 10-25 print "Testing attachments...there should be none\n"; for my $msg (@mails[0..7]) { ok($msg->num_entities, 1); ok($msg->get_attachments, undef); } # 10-28 print "Testing attachments on multipart...\n"; ok($mails[8]->num_entities, 3); ok($mails[8]->get_attachments); ok($mails[8]->get_attachments('Plans'), 2); Mail-MboxParser-0.55/t/old_2_for.t0000755000175000017500000000227210346002752017127 0ustar ethanethan00000000000000use Test; use File::Spec; use strict; use Mail::MboxParser; my $src = File::Spec->catfile('t', 'testbox'); BEGIN { plan tests => 28 }; my $mb = Mail::MboxParser->new($src, oldparser => 1); my @mails = $mb->get_messages; # 1 print "Testing num of messages...\n"; ok(scalar @mails, $mb->nmsgs); # 2 - 9 print "Testing subjects...\n"; ok($mails[1]->header->{subject}, 'Welcome new user VPARSEVAL'); ok($mails[2]->header->{subject}, 'Welcome new user VPARSEVAL'); ok($mails[3]->header->{subject}, 'Password Update'); ok($mails[4]->header->{subject}, 'Notification from PAUSE'); ok($mails[5]->header->{subject}, 'CPAN Upload: V/VP/VPARSEVAL/Mail-MboxParser-0.01.tar.gz'); ok($mails[6]->header->{subject}, 'Module submission Mail::MboxParser'); ok($mails[7]->header->{subject}, 'Module submission Mail::MboxParser'); ok($mails[8]->header->{subject}, 'Re: Mail::MboxParser'); # 10-25 print "Testing attachments...there should be none\n"; for my $msg (@mails[0..7]) { ok($msg->num_entities, 1); ok($msg->get_attachments, undef); } # 26-28 print "Testing attachments on multipart...\n"; ok($mails[8]->num_entities, 3); ok($mails[8]->get_attachments); ok($mails[8]->get_attachments('Plans'), 2); Mail-MboxParser-0.55/t/0_pod_coverage.t0000755000175000017500000000044410346004077020137 0ustar ethanethan00000000000000eval "use Test::Pod::Coverage"; if ($@) { print "1..0 # Skip Test::Pod::Coverage not installed\n"; exit; } my $ARGS = { also_private => [ qr/_(old|new)$/, qr/^init$/, qr/^parts$/ ], trustme => [ qr/^(?:error|log|new|reset_last)$/ ], }; all_pod_coverage_ok( $ARGS ); Mail-MboxParser-0.55/t/old_7_attach.t0000755000175000017500000000123010346002752017603 0ustar ethanethan00000000000000use Test; use File::Spec; use strict; use Mail::MboxParser; my $src = File::Spec->catfile('t', 'testbox'); BEGIN { plan tests => 19 }; my $mb = Mail::MboxParser->new($src, oldparser => 1); # 1 - 9 my $c = 0; for my $msg ($mb->get_messages) { if ($c == 8) { ok($msg->get_attachments('Plans'), 2); } else { ok ($msg->get_attachments, undef); } $c++; } # 10 - 18 $c = 0; while (my $msg = $mb->next_message) { if ($c == 8) { ok($msg->get_attachments('Plans'), 2); } else { ok ($msg->get_attachments, undef); } $c++; } # 19 ok($mb->get_message(8)->get_attachments('Plans'), 2); Mail-MboxParser-0.55/t/1_mmb.t0000755000175000017500000000036410346002752016255 0ustar ethanethan00000000000000use Test; use File::Spec; use strict; use Mail::MboxParser; my $src = File::Spec->catfile('t', 'testbox'); BEGIN { plan tests => 3 }; my $mb = Mail::MboxParser->new($src); ok(defined $mb); ok($mb->nmsgs == 9); ok($mb->current_pos == 0); Mail-MboxParser-0.55/t/10_qpnames.t0000755000175000017500000000060510346003673017227 0ustar ethanethan00000000000000use Test; use File::Spec; use strict; use Mail::MboxParser; my $src = File::Spec->catfile('t', 'qpname'); BEGIN { plan tests => 1 }; my $mb = Mail::MboxParser->new($src); my ($msg) = $mb->get_messages; my $att = $msg->get_attachments; skip(&Mail::MboxParser::Mail::HAVE_MIMEWORDS ? 0 : "Mime::Words not installed", defined $msg->get_attachments("test þðüýçö characters.txt")); Mail-MboxParser-0.55/t/5_body.t0000755000175000017500000000137310346002752016444 0ustar ethanethan00000000000000use Test; use File::Spec; use strict; use Mail::MboxParser; my $src = File::Spec->catfile('t', 'testbox'); BEGIN { plan tests => 18 }; my $mb = Mail::MboxParser->new($src); my @mails; for (0 .. $mb->nmsgs - 1) { push @mails, $mb->get_message($_); } # 1 - 8 print "Testing body-idx...\n"; for my $msg (@mails[0..7]) { ok($msg->find_body, 0); } # 9 print "Testing body-idx on multipart...\n"; ok($mails[8]->find_body, 1); # 10 - 12 print "Signature for mail 1, 2, 9...\n"; for my $msg (@mails[0,1,8]) { ok($msg->body($msg->find_body)->signature); } # 13 - 18 print "No signature for mails 3, 4, 5, 6, 7, 8...\n"; for my $msg (@mails[2..7]) { my $body = $msg->body($msg->find_body); my @n = $body->signature; ok($body->error); } Mail-MboxParser-0.55/t/old_5_body.t0000755000175000017500000000141310346002752017275 0ustar ethanethan00000000000000use Test; use File::Spec; use strict; use Mail::MboxParser; my $src = File::Spec->catfile('t', 'testbox'); BEGIN { plan tests => 18 }; my $mb = Mail::MboxParser->new($src, oldparser => 1); my @mails; for (0 .. $mb->nmsgs - 1) { push @mails, $mb->get_message($_); } # 1 - 8 print "Testing body-idx...\n"; for my $msg (@mails[0..7]) { ok($msg->find_body, 0); } # 9 print "Testing body-idx on multipart...\n"; ok($mails[8]->find_body, 1); # 10 - 12 print "Signature for mail 1, 2, 9...\n"; for my $msg (@mails[0,1,8]) { ok($msg->body($msg->find_body)->signature); } # 13 - 18 print "No signature for mails 3, 4, 5, 6, 7, 8...\n"; for my $msg (@mails[2..7]) { my $body = $msg->body($msg->find_body); my @n = $body->signature; ok($body->error); } Mail-MboxParser-0.55/t/testbox0000644000175000017500000010444410346002752016511 0ustar ethanethan00000000000000 From friedrich@pythonpros.com Thu Feb 26 17:23:40 1998 Received: from dnstx.unitedspacealliance.com (dnstx.unitedspacealliance.com [161.40.254.10]) by python.org (8.8.5/8.8.5) with SMTP id RAA24304 for ; Thu, 26 Feb 1998 17:23:40 -0500 (EST) Received: from pythonpros.com by dnstx.unitedspacealliance.com (SMI-8.6/SMI-SVR4) id QAA07985; Thu, 26 Feb 1998 16:23:18 -0600 Message-ID: <34F5EB6C.4F37CD1E@pythonpros.com> Date: Thu, 26 Feb 1998 16:23:40 -0600 From: Robin Friedrich Organization: Python Professional Services, Inc. X-Mailer: Mozilla 4.04 [en] (Win95; I) MIME-Version: 1.0 To: mailman-developers@python.org Subject: List entry indexing Content-Type: text/plain; charset=us-ascii Content-Transfer-Encoding: 7bit In a prior round of email, Ken mentioned that we would need to key the mail list entries to something other than the person's actual email address in order to implement the flexible user information editing capability of the web (changing one's sendto address, etc.). I agree that this is needed, sooner or later. Since I haven't seen the code yet, how difficult is it to just make a unique key for each subscriber and key the database off that with address as just one value? I hope I'm not using this list too soon. -- Robin K. Friedrich Houston, Texas Python Professional Services, Inc. friedrich@pythonpros.com http://www.pythonpros.com From nobody@p11.speed-link.de Thu Jul 05 08:03:22 2001 Received: from ethan ([127.0.0.1] helo=localhost) by ethan with esmtp (Exim 3.22 #1 (Debian)) id 15I2EU-00005N-00 for ; Thu, 05 Jul 2001 08:03:22 +0200 Received: from mails.rz.rwth-aachen.de [134.130.1.251] by localhost with POP3 (fetchmail-5.8.10) for tp517810@localhost (single-drop); Thu, 05 Jul 2001 08:03:22 +0200 (CEST) Received: from ue250-1.rz.RWTH-Aachen.de ("port 65230"@ue250-1.rz.RWTH-Aachen.DE [134.130.3.33]) by mails.rz.rwth-aachen.de (Sun Internet Mail Server sims.4.0.2000.10.12.16.25.p8) with ESMTP id <0GFZ00G8TE4KGH@mails.rz.rwth-aachen.de> for tp517810?post.rwth-aachen.de@sims-ms-daemon (ORCPT rfc822;tassilo.parseval@post.rwth-aachen.de); Thu, 5 Jul 2001 05:38:44 +0200 (MET DST) Received: from ue250-1.rz.RWTH-Aachen.de (relay1.RWTH-Aachen.DE [134.130.3.3]) by ue250-1.rz.RWTH-Aachen.de (8.10.1/8.11.3-2) with ESMTP id f653chN02016 for ; Thu, 05 Jul 2001 05:38:43 +0200 (MEST) Received: from pause.perl.org (IDENT:root@dubravka.kbx.de [212.40.160.59]) by ue250-1.rz.RWTH-Aachen.de (8.10.1/8.11.3/4) with ESMTP id f653cg902012 for ; Thu, 05 Jul 2001 05:38:43 +0200 (MEST) Received: (from nobody@localhost) by pause.perl.org (8.9.3/8.9.3) id FAA01527; Thu, 05 Jul 2001 05:38:38 +0200 Date: Thu, 05 Jul 2001 05:38:38 +0200 From: Perl Authors Upload Server Subject: Welcome new user VPARSEVAL To: tassilo.parseval@post.rwth-aachen.de, andreas.koenig@anima.de Reply-to: modules@perl.org Message-id: <200107050338.FAA01527@pause.perl.org> Status: RO Content-Length: 977 Lines: 25 (This mail has been generated automatically by the Perl Authors Upload Server on behalf of the admin andreas.koenig@anima.de) As already described in a separate message, you're a registered Perl Author with the userid VPARSEVAL. For the sake of approval I have assigned to you a change-password-only-password that enables you to pick your own password. This password is ``a76dd6f7'' (without the enclosing quotes). Please visit either https://pause.perl.org/pause/authenquery?ACTION=change_passwd or http://pause.perl.org/pause/authenquery?ACTION=change_passwd and use this password to initialize yourself in the ordinary authentication database. Once you have entered your password there, your one-time password is expired automatically. If for whatever reason the procedure doesn't work the first time you try, please visit http://pause.perl.org/password.html and send me a password of your choice according to these guidelines. Thanks. -- andreas.koenig@anima.de From nobody@p11.speed-link.de Thu Jul 05 08:03:22 2001 Received: from ethan ([127.0.0.1] helo=localhost) by ethan with esmtp (Exim 3.22 #1 (Debian)) id 15I2ET-00005N-00 for ; Thu, 05 Jul 2001 08:03:21 +0200 Received: from mails.rz.rwth-aachen.de [134.130.1.251] by localhost with POP3 (fetchmail-5.8.10) for tp517810@localhost (single-drop); Thu, 05 Jul 2001 08:03:21 +0200 (CEST) Received: from ue250-1.rz.RWTH-Aachen.de ("port 65221"@ue250-1.rz.RWTH-Aachen.DE [134.130.3.33]) by mails.rz.rwth-aachen.de (Sun Internet Mail Server sims.4.0.2000.10.12.16.25.p8) with ESMTP id <0GFZ00G8QE4GGH@mails.rz.rwth-aachen.de> for tp517810?post.rwth-aachen.de@sims-ms-daemon (ORCPT rfc822;tassilo.parseval@post.rwth-aachen.de); Thu, 5 Jul 2001 05:38:41 +0200 (MET DST) Received: from ue250-1.rz.RWTH-Aachen.de (relay1.RWTH-Aachen.DE [134.130.3.3]) by ue250-1.rz.RWTH-Aachen.de (8.10.1/8.11.3-2) with ESMTP id f653ceN02001 for ; Thu, 05 Jul 2001 05:38:40 +0200 (MEST) Received: from pause.perl.org (IDENT:root@dubravka.kbx.de [212.40.160.59]) by ue250-1.rz.RWTH-Aachen.de (8.10.1/8.11.3/4) with ESMTP id f653cd901996 for ; Thu, 05 Jul 2001 05:38:39 +0200 (MEST) Received: (from nobody@localhost) by pause.perl.org (8.9.3/8.9.3) id FAA01533; Thu, 05 Jul 2001 05:38:38 +0200 Date: Thu, 05 Jul 2001 05:38:38 +0200 From: Perl Authors Upload Server Subject: Welcome new user VPARSEVAL To: tassilo.parseval@post.rwth-aachen.de Reply-to: modules@perl.org Message-id: <200107050338.FAA01533@pause.perl.org> Status: RO Content-Length: 1123 Lines: 33 Welcome Tassilo von Parseval, PAUSE, the Perl Authors Upload Server, has a userid for you: VPARSEVAL Once you've gone through the procedure of password approval (see the separate mail you should receive about right now), this userid will be the one that you can use to upload your work or edit your credentials in the PAUSE database. This is what we have stored in the database now: Name: Tassilo von Parseval email: tassilo.parseval@post.rwth-aachen.de homepage: http://www-users.rwth-aachen.de/tassilo.parseval enteredby: Kurt D. Starsinic Please note that your email address is exposed in various listings and database dumps. You can register with both a public and a secret email if you want to protect yourself from SPAM. If you want to do this, please visit https://pause.perl.org/pause/authenquery?ACTION=edit_cred or http://pause.perl.org/pause/authenquery?ACTION=edit_cred If you need any further information, please visit $CPAN/modules/04pause.html. If this doesn't answer your questions, contact modules@perl.org. Thank you for your prospective contributions, The Pause Team From nobody@p11.speed-link.de Thu Jul 05 08:18:51 2001 Received: from ethan ([127.0.0.1] helo=localhost) by ethan with esmtp (Exim 3.22 #1 (Debian)) id 15I2TS-00008H-00 for ; Thu, 05 Jul 2001 08:18:50 +0200 Received: from mails.rz.rwth-aachen.de [134.130.1.251] by localhost with POP3 (fetchmail-5.8.10) for tp517810@localhost (single-drop); Thu, 05 Jul 2001 08:18:50 +0200 (CEST) Received: from ue250-1.rz.RWTH-Aachen.de ("port 51581"@ue250-1.rz.RWTH-Aachen.DE [134.130.3.33]) by mails.rz.rwth-aachen.de (Sun Internet Mail Server sims.4.0.2000.10.12.16.25.p8) with ESMTP id <0GFZ00IE0LGXCS@mails.rz.rwth-aachen.de> for tp517810?post.rwth-aachen.de@sims-ms-daemon (ORCPT rfc822;tassilo.parseval@post.rwth-aachen.de); Thu, 5 Jul 2001 08:17:21 +0200 (MET DST) Received: from ue250-1.rz.RWTH-Aachen.de (relay1.RWTH-Aachen.DE [134.130.3.3]) by ue250-1.rz.RWTH-Aachen.de (8.10.1/8.11.3-2) with ESMTP id f656HLN28064 for ; Thu, 05 Jul 2001 08:17:21 +0200 (MEST) Received: from pause.perl.org (IDENT:root@dubravka.kbx.de [212.40.160.59]) by ue250-1.rz.RWTH-Aachen.de (8.10.1/8.11.3/4) with ESMTP id f656HJ928050 for ; Thu, 05 Jul 2001 08:17:20 +0200 (MEST) Received: (from nobody@localhost) by pause.perl.org (8.9.3/8.9.3) id IAA02787; Thu, 05 Jul 2001 08:17:19 +0200 Date: Thu, 05 Jul 2001 08:17:19 +0200 From: Perl Authors Upload Server Subject: Password Update To: Tassilo von Parseval Reply-to: modules@perl.org Message-id: <200107050617.IAA02787@pause.perl.org> Status: RO Content-Length: 325 Lines: 11 Password update on PAUSE: VPARSEVAL (Tassilo von Parseval) visited the password changer on PAUSE at Thu Jul 5 06:17:19 2001 GMT and changed the password for VPARSEVAL (Tassilo von Parseval). No action is required, but it would be a good idea if somebody would check the correctness of the new password. Thanks, The Pause From nobody@p11.speed-link.de Thu Jul 05 08:24:05 2001 Received: from ethan ([127.0.0.1] helo=localhost) by ethan with esmtp (Exim 3.22 #1 (Debian)) id 15I2YX-00009D-00 for ; Thu, 05 Jul 2001 08:24:05 +0200 Received: from mails.rz.rwth-aachen.de [134.130.1.251] by localhost with POP3 (fetchmail-5.8.10) for tp517810@localhost (single-drop); Thu, 05 Jul 2001 08:24:05 +0200 (CEST) Received: from ue250-1.rz.RWTH-Aachen.de ("port 53048"@ue250-1.rz.RWTH-Aachen.DE [134.130.3.33]) by mails.rz.rwth-aachen.de (Sun Internet Mail Server sims.4.0.2000.10.12.16.25.p8) with ESMTP id <0GFZ00IOELQK5H@mails.rz.rwth-aachen.de> for tp517810?post.rwth-aachen.de@sims-ms-daemon (ORCPT rfc822;tassilo.parseval@post.rwth-aachen.de); Thu, 5 Jul 2001 08:23:08 +0200 (MET DST) Received: from ue250-1.rz.RWTH-Aachen.de (relay1.RWTH-Aachen.DE [134.130.3.3]) by ue250-1.rz.RWTH-Aachen.de (8.10.1/8.11.3-2) with ESMTP id f656N7N00305 for ; Thu, 05 Jul 2001 08:23:07 +0200 (MEST) Received: from pause.perl.org (IDENT:root@dubravka.kbx.de [212.40.160.59]) by ue250-1.rz.RWTH-Aachen.de (8.10.1/8.11.3/4) with ESMTP id f656N6900294 for ; Thu, 05 Jul 2001 08:23:07 +0200 (MEST) Received: (from nobody@localhost) by pause.perl.org (8.9.3/8.9.3) id IAA02829; Thu, 05 Jul 2001 08:23:05 +0200 Date: Thu, 05 Jul 2001 08:23:05 +0200 From: Perl Authors Upload Server Subject: Notification from PAUSE To: Tassilo von Parseval , andreas.koenig@anima.de Reply-to: modules@perl.org Message-id: <200107050623.IAA02829@pause.perl.org> Status: RO Content-Length: 966 Lines: 24 VPARSEVAL (Tassilo von Parseval) visited the PAUSE and requested an upload into his/her directory. The request used the following parameters HIDDENNAME [VPARSEVAL] CAN_MULTIPART [1] pause99_add_uri_httpupload [Mail-MboxParser-0.01.tar.gz] SUBMIT_pause99_add_uri_httpupload [ Upload this file from my disk ] pause99_add_uri_uri [] pause99_add_uri_sub [pause99_add_uri_httpupload] The request is now entered into the database where the PAUSE Daemon will pick it up as soon as possible. Allow a few minutes, and be aware that it may take longer if other requests are running. We proceed only one at a time. During upload you can watch ftp://pause.perl.org/tmp/V/VP/VPARSEVAL (temporary upload directory), and then https://pause.perl.org/pub/PAUSE/authors/id/V/VP/VPARSEVAL (final upload directory). The logfile is in https://pause.perl.org/perl/user/tail_log/2000 (replace 2000 with any offset from the end). From root@p11.speed-link.de Thu Jul 05 08:29:17 2001 Received: from ethan ([127.0.0.1] helo=localhost) by ethan with esmtp (Exim 3.22 #1 (Debian)) id 15I2dZ-0000Bf-00 for ; Thu, 05 Jul 2001 08:29:17 +0200 Received: from mails.rz.rwth-aachen.de [134.130.1.251] by localhost with POP3 (fetchmail-5.8.10) for tp517810@localhost (single-drop); Thu, 05 Jul 2001 08:29:17 +0200 (CEST) Received: from ue250-1.rz.RWTH-Aachen.de ("port 53428"@ue250-1.rz.RWTH-Aachen.DE [134.130.3.33]) by mails.rz.rwth-aachen.de (Sun Internet Mail Server sims.4.0.2000.10.12.16.25.p8) with ESMTP id <0GFZ00I09LSQRF@mails.rz.rwth-aachen.de> for tp517810?post.rwth-aachen.de@sims-ms-daemon (ORCPT rfc822;tassilo.parseval@post.rwth-aachen.de); Thu, 5 Jul 2001 08:24:27 +0200 (MET DST) Received: from ue250-1.rz.RWTH-Aachen.de (relay1.RWTH-Aachen.DE [134.130.3.3]) by ue250-1.rz.RWTH-Aachen.de (8.10.1/8.11.3-2) with ESMTP id f656OQN00791 for ; Thu, 05 Jul 2001 08:24:26 +0200 (MEST) Received: from onion.perl.org (onion.valueclick.com [209.85.157.220]) by ue250-1.rz.RWTH-Aachen.de (8.10.1/8.11.3/4) with SMTP id f656OO900781 for ; Thu, 05 Jul 2001 08:24:25 +0200 (MEST) Received: (qmail 62466 invoked by uid 1008); Thu, 05 Jul 2001 06:24:23 +0000 Received: (qmail 62440 invoked from network); Thu, 05 Jul 2001 06:24:23 +0000 Received: from dubravka.kbx.de (HELO pause.perl.org) (root@212.40.160.59) by onion.valueclick.com with SMTP; Thu, 05 Jul 2001 06:24:23 +0000 Received: (from root@localhost) by pause.perl.org (8.9.3/8.9.3) id IAA02849; Thu, 05 Jul 2001 08:24:20 +0200 Date: Thu, 05 Jul 2001 08:24:20 +0200 From: PAUSE Subject: CPAN Upload: V/VP/VPARSEVAL/Mail-MboxParser-0.01.tar.gz To: Tassilo von Parseval , cpan-testers@perl.org Reply-to: cpan-testers@perl.org Message-id: <200107050624.IAA02849@pause.perl.org> MIME-version: 1.0 Content-type: Text/Plain; Charset=UTF-8 Content-transfer-encoding: 8bit Delivered-to: cpanmail-VPARSEVAL@cpan.org X-Spam-Rating: onion.valueclick.com 1.6.2 0/1000/N Status: RO Content-Length: 457 Lines: 17 The uploaded file Mail-MboxParser-0.01.tar.gz has entered CPAN as file: $CPAN/authors/id/V/VP/VPARSEVAL/Mail-MboxParser-0.01.tar.gz size: 5135 bytes md5: 3253b705a2ecaff07d368165895e66b9 No action is required on your part Request entered by: VPARSEVAL (Tassilo von Parseval) Request entered on: Thu, 05 Jul 2001 06:23:03 GMT Request completed: Thu, 05 Jul 2001 06:24:20 GMT Virtually Yours, Id: paused,v 1.74 2001/05/20 14:59:52 k Exp k From nobody@p11.speed-link.de Thu Jul 05 08:43:16 2001 Received: from ethan ([127.0.0.1] helo=localhost) by ethan with esmtp (Exim 3.22 #1 (Debian)) id 15I2r6-0000Di-00 for ; Thu, 05 Jul 2001 08:43:16 +0200 Received: from mails.rz.rwth-aachen.de [134.130.1.251] by localhost with POP3 (fetchmail-5.8.10) for tp517810@localhost (single-drop); Thu, 05 Jul 2001 08:43:16 +0200 (CEST) Received: from ue250-1.rz.RWTH-Aachen.de ("port 57951"@ue250-1.rz.RWTH-Aachen.DE [134.130.3.33]) by mails.rz.rwth-aachen.de (Sun Internet Mail Server sims.4.0.2000.10.12.16.25.p8) with ESMTP id <0GFZ00J8DMIV0Q@mails.rz.rwth-aachen.de> for tp517810?post.rwth-aachen.de@sims-ms-daemon (ORCPT rfc822;tassilo.parseval@post.rwth-aachen.de); Thu, 5 Jul 2001 08:40:07 +0200 (MET DST) Received: from ue250-1.rz.RWTH-Aachen.de (relay1.RWTH-Aachen.DE [134.130.3.3]) by ue250-1.rz.RWTH-Aachen.de (8.10.1/8.11.3-2) with ESMTP id f656e6N07733 for ; Thu, 05 Jul 2001 08:40:06 +0200 (MEST) Received: from pause.perl.org (IDENT:root@dubravka.kbx.de [212.40.160.59]) by ue250-1.rz.RWTH-Aachen.de (8.10.1/8.11.3/4) with ESMTP id f656e5907717 for ; Thu, 05 Jul 2001 08:40:06 +0200 (MEST) Received: (from nobody@localhost) by pause.perl.org (8.9.3/8.9.3) id IAA02973; Thu, 05 Jul 2001 08:40:05 +0200 Date: Thu, 05 Jul 2001 08:40:05 +0200 From: Perl Authors Upload Server Subject: Module submission Mail::MboxParser To: tassilo.parseval@post.rwth-aachen.de Reply-to: modules@perl.org Message-id: <200107050640.IAA02973@pause.perl.org> Status: RO Content-Length: 1550 Lines: 43 The following module was proposed for inclusion in the Module List: modid: Mail::MboxParser DSLIP: adpOp description: simple access to UNIX-mailboxes userid: VPARSEVAL (Tassilo von Parseval) chapterid: 19 (Mail_and_Usenet_News) communities: similar: Mail::Cclient Mail::Box rationale: Mail::MboxParser focuses, unlike Mail::Cclient and Mail::Box, on a read-only access to UNIX-mailboxes. It provides wrapper-methods derived from MIME::Entity to get a very straight-forward handling of attachements. Since most methods are applied to MIME::Entity objects the appropriate methods from the MIME::Tools can be directly involved to extend functionality. As for namespace: The module certainly belongs under the Mail-namespace while MboxParser indicates that it is really just about parsing mailboxes and not creating them. enteredby: VPARSEVAL (Tassilo von Parseval) enteredon: Thu Jul 5 06:40:05 2001 GMT The resulting entry would be: Mail:: ::MboxParser adpOp simple access to UNIX-mailboxes VPARSEVAL Thanks for registering, The Pause Team PS: The following links are only valid for module list maintainers: Registration form with editing capabilities: https://pause.perl.org/pause/authenquery?ACTION=add_mod&USERID=21000000_293b5faf2547cbe8&SUBMIT_pause99_add_mod_preview=1 Immediate (one click) registration: https://pause.perl.org/pause/authenquery?ACTION=add_mod&USERID=21000000_293b5faf2547cbe8&SUBMIT_pause99_add_mod_insertit=1 From nobody@p11.speed-link.de Thu Jul 05 09:54:12 2001 Received: from ethan ([127.0.0.1] helo=localhost) by ethan with esmtp (Exim 3.22 #1 (Debian)) id 15I3xj-0000Fq-00 for ; Thu, 05 Jul 2001 09:54:11 +0200 Received: from mails.rz.rwth-aachen.de [134.130.1.251] by localhost with POP3 (fetchmail-5.8.10) for tp517810@localhost (single-drop); Thu, 05 Jul 2001 09:54:11 +0200 (CEST) Received: from ue250-1.rz.RWTH-Aachen.de ("port 45963"@ue250-1.rz.RWTH-Aachen.DE [134.130.3.33]) by mails.rz.rwth-aachen.de (Sun Internet Mail Server sims.4.0.2000.10.12.16.25.p8) with ESMTP id <0GFZ00KMLPPSKE@mails.rz.rwth-aachen.de> for tp517810?post.rwth-aachen.de@sims-ms-daemon (ORCPT rfc822;tassilo.parseval@post.rwth-aachen.de); Thu, 5 Jul 2001 09:49:05 +0200 (MET DST) Received: from ue250-1.rz.RWTH-Aachen.de (relay1.RWTH-Aachen.DE [134.130.3.3]) by ue250-1.rz.RWTH-Aachen.de (8.10.1/8.11.3-2) with ESMTP id f657n4N08557 for ; Thu, 05 Jul 2001 09:49:04 +0200 (MEST) Received: from pause.perl.org (IDENT:root@dubravka.kbx.de [212.40.160.59]) by ue250-1.rz.RWTH-Aachen.de (8.10.1/8.11.3/4) with ESMTP id f657n3908551 for ; Thu, 05 Jul 2001 09:49:04 +0200 (MEST) Received: (from nobody@localhost) by pause.perl.org (8.9.3/8.9.3) id JAA03431; Thu, 05 Jul 2001 09:49:03 +0200 Date: Thu, 05 Jul 2001 09:49:03 +0200 From: Perl Authors Upload Server Subject: Module submission Mail::MboxParser To: tassilo.parseval@post.rwth-aachen.de Reply-to: modules@perl.org Message-id: <200107050749.JAA03431@pause.perl.org> Status: RO Content-Length: 1550 Lines: 43 The following module was proposed for inclusion in the Module List: modid: Mail::MboxParser DSLIP: adpOp description: simple access to UNIX-mailboxes userid: VPARSEVAL (Tassilo von Parseval) chapterid: 19 (Mail_and_Usenet_News) communities: similar: Mail::Cclient Mail::Box rationale: Mail::MboxParser focuses, unlike Mail::Cclient and Mail::Box, on a read-only access to UNIX-mailboxes. It provides wrapper-methods derived from MIME::Entity to get a very straight-forward handling of attachements. Since most methods are applied to MIME::Entity objects the appropriate methods from the MIME::Tools can be directly involved to extend functionality. As for namespace: The module certainly belongs under the Mail-namespace while MboxParser indicates that it is really just about parsing mailboxes and not creating them. enteredby: VPARSEVAL (Tassilo von Parseval) enteredon: Thu Jul 5 07:49:03 2001 GMT The resulting entry would be: Mail:: ::MboxParser adpOp simple access to UNIX-mailboxes VPARSEVAL Thanks for registering, The Pause Team PS: The following links are only valid for module list maintainers: Registration form with editing capabilities: https://pause.perl.org/pause/authenquery?ACTION=add_mod&USERID=31000000_e431fde986fbb444&SUBMIT_pause99_add_mod_preview=1 Immediate (one click) registration: https://pause.perl.org/pause/authenquery?ACTION=add_mod&USERID=31000000_e431fde986fbb444&SUBMIT_pause99_add_mod_insertit=1 From markov@proxy.ATComputing.nl Fri Jul 06 16:47:17 2001 Received: from ethan ([127.0.0.1] helo=localhost) by ethan with esmtp (Exim 3.22 #1 (Debian)) id 15IWt3-0000C0-00 for ; Fri, 06 Jul 2001 16:47:17 +0200 Received: from mails.rz.rwth-aachen.de [134.130.1.251] by localhost with POP3 (fetchmail-5.8.10) for tp517810@localhost (single-drop); Fri, 06 Jul 2001 16:47:17 +0200 (CEST) Received: from ue250-1.rz.RWTH-Aachen.de ("port 37342"@ue250-1.rz.RWTH-Aachen.DE [134.130.3.33]) by mails.rz.rwth-aachen.de (Sun Internet Mail Server sims.4.0.2000.10.12.16.25.p8) with ESMTP id <0GG2006OS3M0SY@mails.rz.rwth-aachen.de> for tp517810?post.rwth-aachen.de@sims-ms-daemon (ORCPT rfc822;tassilo.parseval@post.rwth-aachen.de); Fri, 6 Jul 2001 16:44:25 +0200 (MET DST) Received: from ue250-1.rz.RWTH-Aachen.de (relay1.RWTH-Aachen.DE [134.130.3.3]) by ue250-1.rz.RWTH-Aachen.de (8.10.1/8.11.3-2) with ESMTP id f66EiON07088 for ; Fri, 06 Jul 2001 16:44:24 +0200 (MEST) Received: from atcmpg.ATComputing.nl (proxy.ATComputing.nl [195.108.229.1]) by ue250-1.rz.RWTH-Aachen.de (8.10.1/8.11.3/4) with ESMTP id f66EiM907081 for ; Fri, 06 Jul 2001 16:44:23 +0200 (MEST) Received: (from markov@localhost) by atcmpg.ATComputing.nl (8.9.3+Sun/8.9.3) id QAA15785 for tassilo.parseval@post.rwth-aachen.de; Fri, 06 Jul 2001 16:43:07 +0200 (MEST) Date: Fri, 06 Jul 2001 16:43:07 +0200 From: Mark Overmeer Subject: Re: Mail::MboxParser In-reply-to: <20010706162345.A573@ethan>; from tassilo.parseval@post.rwth-aachen.de on Fri, Jul 06, 2001 at 04:23:45PM +0200 To: Tassilo von Parseval Message-id: <20010706164307.B12625@atcmpg.ATComputing.nl> MIME-version: 1.0 Content-type: multipart/mixed; boundary="LQksG6bCIzRHxTLp" Content-disposition: inline User-Agent: Mutt/1.2.5i References: <20010706111041.B22522@atcmpg.ATComputing.nl> <20010706162345.A573@ethan> Status: RO X-Status: A Content-Length: 12338 Lines: 376 --LQksG6bCIzRHxTLp Content-Type: text/plain; charset=us-ascii Content-Disposition: inline * Tassilo von Parseval (tassilo.parseval@post.rwth-aachen.de) [010706 16:22]: > Two problems with yours: See the following output from your parser and mine Ok, the results differ. That's not a good sign: this means that investigation is needed. I'm not a bad guy: if I get a signal from someone that there is a problem, I fix it. So please send me the data. I think fixing problems is more useful than rewriting existing code... there will be other bugs. > ethan@ethan:~$ time perl -MMail::MboxParser > real 0m15.226s > > ethan@ethan:~$ time perl -MMail::Box::Mbox > real 0m3.468s I am rather pleased by these results ;) ;) > Another thing is: If you really want access to only the mail and, say, the attachements, if there are any, the immense functionality of your modules becomes a little bit confusing...at least I felt so. And often you still have to fiddle around with MIME::Tools which is an equally complex set of modules. I agree that MIME::Entity, Mail::Internet, MIME::Parser, and MIME::Tools are quite hard to use. That's why David Coppit (Mail::Box::FastReader) and I are planning to replace it. I have a global design of functionality ready, but need some hours to write some C ;) We'll meet at O'Reilly's PerlConf, in two weeks time. > Perhaps a structure like that: > Mail::Mbox::Lite (just the essential things but easy to use) Don't need that, because my delayed autoloading takes care of that. One of the reasons that my module is much faster than yours is because messages are basically skipped, and only really read when used. > Mail::Mbox::Parser Will be the C implementation > Mail::Mbox::Parser::Body (perhaps detecting quotations, signatures etc.) > Mail::Mbox::Parser::Header > Mail::Mbox::Parser::Entity Actually, the planned names will be Mail::Message Mail::Message::Body Mail::Message::Head Mail::Box::Mbox::Message isa Mail::Box::Message isa Mail::Message > So, what do you suggest? Of course we could start to write such a > system from scratch but this would just ignore the efforts other people > already took with their modules. I attach the design, which I discussed (not in full detail) with David. Maybe you have some bright contributions. Then... writing the C-code is probably a good task for me (23 years of experience, mainly in C), and I have some parts ready. Then: most difficult is designing tests. It would be very nice if you could contribute in testing. Yes, I want to throw away all old code, for the main reason that it looks like being OO, but it certainly isn't. And it is too slow too. Perl needs a good mail-parser which is fast. See attachment. -- MarkOv %-] ------------------------------------------------------------------------ drs Mark A.C.J. Overmeer markov@ATComputing.nl AT Computing, UNIX Training and Consultancy http://www.ATComputing.nl http://Mark.Overmeer.net Mark@Overmeer.net --LQksG6bCIzRHxTLp Content-Type: text/plain; charset=us-ascii Content-Disposition: attachment; filename=Plans All items with #) are implemented, but those with *) not yet. Mail::Message design version 1.113 ------------- Targets *) replace MIME::Entity, Mail::Internet and MIME::Parser to speed-up low-level mail processing. Why replace existing modules? 1) they do not use C on the lowest level. Rewrite of parts of them would be more work than reimplementation of all. 2) certainly MIME::Entity is not smart enough, not defining enough simple objects. 3) they are not conveniently supporting delay-loading. 4) they ofter use old-fashioned perl. The reimplementation will be done with a close look at the well documented code in the two existing modules. *) extend features of Mail::Folder::FastReader. *) eventually speed-up all mail-processing Perl-modules. *) handle Mbox-like folders. *) handle one file (one message) in MH-like folders. *) support for delay-loading (saves time and memory) Parts *) Mail::Box and grepmail (via Mail::Box?) maintain overview over the mail-folders. *) Mail::Message Basic messages as stored in a file. contains some stuff from Mail::Box::Message *) Mail::Message::Part isa Mail::Message *) Mail::Box::Parser Contains inlined C for simple character processing on headers and bodiess. *) Mail::Box Added wrappers around Mail::Box::Parser and `left-overs' from the replace modules. *) Mail::Message::Head, comparible to Mail::Head *) Mail::Message::Head::Field, one line from header. *) Mail::Message::Body *) Mail::Message::Body::NotParsed isa Mail::Message::Body *) Mail::Message::Body::Lines isa Mail::Message::Body *) Mail::Message::Body::Scalar isa Mail::Message::Body *) Mail::Message::Body::File isa Mail::Message::Body *) Mail::Message::Body::Multipart isa Mail::Message::Body All Mail::Message::Body* may reside in one file. = Mail::Box additions Keeps track on: - debug-level - class of message-objects - default class of head-objects [Mail::Message::Head] - default class of body-objects [Mail::Message::Body::Lines] - default class of multiparts-objects [Mail::Message::Body::Multipart] #) log warnings and errors #) report warnings and errors *) my Mail::Message::Head $head = $folder->readHead() - return Mail::Message::Head object - lines already `unfolded' - newlines removed from the end. *) my $body = $folder->readBody(want => 'Mail::Message::BodyLines' , size => $msg->head->get('Content-Length')); $msg->body($body); - returns any Mail::Message::Body based on flag. - calls $args{want}->get($fh) - while reading the body, various trics are used to try determining where a message ends. If there is a size in the message-header, it should be checked. *) $msg->sourceCopy($newfile) - Copy the message as located in the original folder file into a different file. - This is much faster than printing the message from structures. - The copy will be exact (so even no header-line order changes and such) *) $msg->writeToFile($newfile, encode => 'BASE64') - Write message from perl-structures into file. - calls $msg->head->write and $msg->body->write. - ability to encode body (see Mail::Message::Body) = Mail::Box::Parser Manages a C-pointer to a structure which handles the file-reading. Keeps track on: - filename - filehandle - fold headerline - current linenumber - dos-mode (\r\n at end line, while on UNIX) - open status *) my $fh = Mail::Box::Parser->open(...) various options on the file are set. Called by Mail::Box->open *) $fh->close when the application calls close(), but the application might try to use it later which shouldn't result in a core-dump. - set open status to 'close' Called by Mail::Box->close *) $fh->DESTROY perl's DESTROY removes the folder-object - free allocated memory. Called by Mail::Box->DESTROY *) my Mail::Message $msg = $fh->read() Simplified access to folder to get one message. It calls getHead and getBody. About the same as: my $msg = new Mail::Message(file => $fh); $msg->readHead; $msg->readBody; return $msg; = Methods in Mail::Message #) You may supply a Mail::Message::Head and/or ::Body at instantiation. *) print $msg->fromLine; $msg->fromline('From me in 2001'); get/set from-line for Mbox-like folders #) my Mail::Message::Head $head = $msg->head; Get the headers of this message #) my Mail::Message::Body $body = $msg->body; Get the body of this message *) $msg->encode(type) or $part->encode(type) *) $msg->decode or $part->decode *) $msg->signature *) $msg->remove_sig *) $reply = $msg->reply; Specialy complicated for reply on message-part. = Mail::Message::Body extended by Mail::Message::Body::NotParsed Mail::Message::Body::Lines Mail::Message::Body::Scalar Mail::Message::Body::File Mail::Message::Body::Multipart *) $body->nrlines *) my $file_offset = $body->begin; *) my $bytesize = $body->size; *) if($body->isMultipart) same as if($body isa 'Mail::Message::Body::Multipart') *) my Mail::Message::Body $body = Mail::Message::Body::get($fh) To be overruled by each sub-class. *) $body->addPart(@parts); Auto-multiparts message Conversions: *) $body->write(FILE) results in a move when already BodyFile object - supports encoding and decoding - automatically updates Content-Length field *) my $whole = $body->string use overload '""' => 'string'; No work for BodyBlock, otherwise conversion. *) my @lines = $body->lines my $lines = $body->lines; # returns [$body->lines] use overload '@{}' => 'lines'; No work for BodyLines, otherwise conversion. = Mail::Message::Part isa Mail::Message *) my $nr = $part->partnr; - All parts shall be sequentially numbered within the message, even when the multipart is nested. But I'm sure more functionality is required here, for instance to support that attachments reside outside the folder-file to improve speed in opening the folder. = Mail::Message::Body::NotParsed isa Mail::Message::Body but will autoload on any method performed on the body. Does not convert body from file to memory-structures, but only collects info to read it later. *) my $realbody = $body->load returns a real subclass of Mail::Message::Body. = Mail::Message::Body::Scalar isa Mail::Message::Body Reads the whole message body into one scalar. = Mail::Message::Body::Lines isa Mail::Message::Body Reads the whole message body into a list of scalars, each containing one line. = Mail::Message::Body::Multipart isa Mail::Message::Body Each part is a Mail::Message (-subclass) by itself. *) print $body->separator || 'no sep yet'; $body->separator(time . "--$me--$$"); Get/set part boundary. *) print $body->preamble ->string Get/set preamble. Should be empty, but not always is. Returns a Mail::Message::Body instance *) print $body->epilogue ->string Get/set epiloque. Returns a Mail::Message::Body instance. *) my @parts = $body->parts() get/set all parts *) my $part = $body->part(42) get/set one part (set to undef means removal) *) $body->addPart(-1, @parts) $body->addPart(@parts) Add parts before the specified place, or at the end. = Mail::Message::Head Header-fields are used case-insensitive. *) my $mime = $msg->head->get('Subject') my @mime = $head->get('Received') return the content of the header-field without trailing newline *) my @fields = $head->fields; ordered list of read headers. The order is used when write a message to a file, while the data is stored in an (unordered) hash with lowercased field-names. *) my Mail::Message::Head::Field $set = $header->set('Field', contents) $header->set($mime); $header->set(@mime); removes old values (when present). Adds name to end in field-order, when new. *) my Mail::Message::Head::Field @set = $head->add('Received', contents) $head->add($mime); $head->add(@mime); Adds after header-lines with the same name. Returns all. = Mail::Message::Head::Field One line from the header. This module will supply some methods to simplify understanding the headerlines, but not as far as Mail::Field has implemented. *) my $mime = Mail::Message::Head::Field->new( Content-Type => 'text/plain', charset => 'US-ASCII'); my $mime = Mail::Message::Head::Field->new( 'Content-Type: text/plain; charset=US-ASCII'); my $mime = Mail::Message::Head::Field->new( Content-Type => 'text/plain; charset=US-ASCII'); *) my $name = $mime->field; => content-type [lowercased] *) my $content = $mime->content; => 'text/plain; charset=US-ASCII' *) my $value = $mime->value; => 'text/plain' *) my $charset = $mime->option('charset'); => US-ASCII *) my %options = $mime->options; *) print $mime->toString; => Content-Type: text/plain; charset=US-ASCII --LQksG6bCIzRHxTLp-- Mail-MboxParser-0.55/t/4_index.t0000755000175000017500000000233510346002752016614 0ustar ethanethan00000000000000use Test; use File::Spec; use strict; use Mail::MboxParser; my $src = File::Spec->catfile('t', 'testbox'); BEGIN { plan tests => 28 }; my $mb = Mail::MboxParser->new($src); my @mails; for (0 .. $mb->nmsgs - 1) { push @mails, $mb->get_message($_); } # 1 print "Testing num of messages...\n"; ok(scalar @mails, $mb->nmsgs); # 2 - 9 print "Testing subjects...\n"; ok($mails[1]->header->{subject}, 'Welcome new user VPARSEVAL'); ok($mails[2]->header->{subject}, 'Welcome new user VPARSEVAL'); ok($mails[3]->header->{subject}, 'Password Update'); ok($mails[4]->header->{subject}, 'Notification from PAUSE'); ok($mails[5]->header->{subject}, 'CPAN Upload: V/VP/VPARSEVAL/Mail-MboxParser-0.01.tar.gz'); ok($mails[6]->header->{subject}, 'Module submission Mail::MboxParser'); ok($mails[7]->header->{subject}, 'Module submission Mail::MboxParser'); ok($mails[8]->header->{subject}, 'Re: Mail::MboxParser'); # 10-25 print "Testing attachments...there should be none\n"; for my $msg (@mails[0..7]) { ok($msg->num_entities, 1); ok($msg->get_attachments, undef); } # 25-28 print "Testing attachments on multipart...\n"; ok($mails[8]->num_entities, 3); ok($mails[8]->get_attachments); ok($mails[8]->get_attachments('Plans'), 2); Mail-MboxParser-0.55/t/9_direct_invok.t0000755000175000017500000000645410346002752020200 0ustar ethanethan00000000000000use Test; use strict; BEGIN { plan tests => 6 }; use Mail::MboxParser::Mail; ok(1); my ($header, $body, $all) = do { local $/ = ""; my $hd = ; local $/; my $bd = ; my $al = "$hd\n$bd"; ("$hd\n", $bd, $al) }; ok(my $m1 = Mail::MboxParser::Mail->new($header, $body)); ok(my $m2 = Mail::MboxParser::Mail->new( [ split /\n/, $header ], [ split /\n/, $body ] )); ok($m1->body eq $m2->body); ok($m1->header->{subject} eq $m2->header->{subject}); ok($m1 eq $m2); __DATA__ Received: from ethan ([127.0.0.1] helo=localhost) by ethan with esmtp (Exim 3.35 #1 (Debian)) id 18Fw3L-0001G1-00 for ; Sun, 24 Nov 2002 13:39:59 +0100 Received: from ms-dienst.rz.rwth-aachen.de [134.130.3.132] by localhost with POP3 (fetchmail-5.9.11) for ethan@localhost (single-drop); Sun, 24 Nov 2002 13:39:59 +0100 (CET) Received: from ue250-1.rz.RWTH-Aachen.DE (ue250-1.rz.RWTH-Aachen.DE [134.130.3.33]) by ms-dienst.rz.rwth-aachen.de (iPlanet Messaging Server 5.2 (built Feb 21 2002)) with ESMTP id <0H62009MSYYOED@ms-dienst.rz.rwth-aachen.de> for tp517810@ims-ms-daemon (ORCPT tassilo.parseval@post.rwth-aachen.de); Sun, 24 Nov 2002 13:35:12 +0100 (MET) Received: from ms-1 (ms-1.rz.RWTH-Aachen.DE [134.130.3.130]) by ue250-1.rz.RWTH-Aachen.DE (8.12.1/8.11.3-3) with ESMTP id gAOCZCsc016474 for ; Sun, 24 Nov 2002 13:35:12 +0100 (MET) Received: from ue250-1.rz.RWTH-Aachen.DE ([134.130.3.33]) by ms-1 (MailMonitor for SMTP v1.2.0 Beta3) ; Sun, 24 Nov 2002 13:35:11 +0100 (MET) Received: from onion.perl.org (onion.valueclick.com [64.70.54.95]) by ue250-1.rz.RWTH-Aachen.DE (8.12.1/8.11.3/24) with SMTP id gAOCZ5BU016407 for ; Sun, 24 Nov 2002 13:35:10 +0100 (MET) Received: (qmail 26579 invoked by uid 1008); Sun, 24 Nov 2002 12:35:04 +0000 Received: (qmail 26569 invoked by uid 76); Sun, 24 Nov 2002 12:35:04 +0000 Received: from root@[212.40.160.59] (HELO pause.perl.org) (212.40.160.59) by onion.perl.org (qpsmtpd/0.12) with SMTP; 2002-11-24 12:35:03Z Received: (from root@localhost) by pause.perl.org (8.11.6/8.11.6) id gAOCZ0f29640; Sun, 24 Nov 2002 13:35:00 +0100 Date: Sun, 24 Nov 2002 13:35:00 +0100 From: PAUSE Subject: CPAN Upload: V/VP/VPARSEVAL/Mail-MboxParser-0.36.tar.gz To: Tassilo von Parseval , cpan-testers@perl.org Reply-to: cpan-testers@perl.org Message-id: <200211241235.gAOCZ0f29640@pause.perl.org> MIME-version: 1.0 Content-type: Text/Plain; Charset=UTF-8 Content-transfer-encoding: 8bit Delivered-to: cpanmail-VPARSEVAL@cpan.org X-SMTPD: qpsmtpd/0.12, http://develooper.com/code/qpsmtpd/ X-Spam-Status: No, hits=1.0 required=5.0 tests=FROM_NAME_NO_SPACES,DOUBLE_CAPSWORD version=2.31 X-Spam-Level: * Status: RO Content-Length: 459 Lines: 18 The uploaded file Mail-MboxParser-0.36.tar.gz has entered CPAN as file: $CPAN/authors/id/V/VP/VPARSEVAL/Mail-MboxParser-0.36.tar.gz size: 35589 bytes md5: 8d278ce52fb4fb018905084c273281b5 No action is required on your part Request entered by: VPARSEVAL (Tassilo von Parseval) Request entered on: Sun, 24 Nov 2002 12:34:21 GMT Request completed: Sun, 24 Nov 2002 12:35:00 GMT Virtually Yours, Id: paused,v 1.81 2002/08/02 11:34:24 k Exp k Mail-MboxParser-0.55/t/7_attach.t0000755000175000017500000000147410346002752016757 0ustar ethanethan00000000000000use Test; use File::Spec; use strict; use Mail::MboxParser; my $src = File::Spec->catfile('t', 'testbox'); BEGIN { plan tests => 19 }; my $mb = Mail::MboxParser->new($src, parseropts => { cache_file_name => File::Spec->catfile(qw/t cache/), enable_cache => 1, }); # 1 - 9 my $c = 0; for my $msg ($mb->get_messages) { if ($c == 8) { ok($msg->get_attachments('Plans'), 2); } else { ok ($msg->get_attachments, undef); } $c++; } # 10 - 18 $c = 0; while (my $msg = $mb->next_message) { if ($c == 8) { ok($msg->get_attachments('Plans'), 2); } else { ok ($msg->get_attachments, undef); } $c++; } # 19 ok($mb->get_message(8)->get_attachments('Plans'), 2); Mail-MboxParser-0.55/t/old_1_mmb.t0000755000175000017500000000040410346002752017106 0ustar ethanethan00000000000000use Test; use File::Spec; use strict; use Mail::MboxParser; my $src = File::Spec->catfile('t', 'testbox'); BEGIN { plan tests => 3 }; my $mb = Mail::MboxParser->new($src, oldparser => 1); ok(defined $mb); ok($mb->nmsgs == 9); ok($mb->current_pos == 0); Mail-MboxParser-0.55/t/old_4_index.t0000755000175000017500000000235510346002752017454 0ustar ethanethan00000000000000use Test; use File::Spec; use strict; use Mail::MboxParser; my $src = File::Spec->catfile('t', 'testbox'); BEGIN { plan tests => 28 }; my $mb = Mail::MboxParser->new($src, oldparser => 1); my @mails; for (0 .. $mb->nmsgs - 1) { push @mails, $mb->get_message($_); } # 1 print "Testing num of messages...\n"; ok(scalar @mails, $mb->nmsgs); # 2 - 9 print "Testing subjects...\n"; ok($mails[1]->header->{subject}, 'Welcome new user VPARSEVAL'); ok($mails[2]->header->{subject}, 'Welcome new user VPARSEVAL'); ok($mails[3]->header->{subject}, 'Password Update'); ok($mails[4]->header->{subject}, 'Notification from PAUSE'); ok($mails[5]->header->{subject}, 'CPAN Upload: V/VP/VPARSEVAL/Mail-MboxParser-0.01.tar.gz'); ok($mails[6]->header->{subject}, 'Module submission Mail::MboxParser'); ok($mails[7]->header->{subject}, 'Module submission Mail::MboxParser'); ok($mails[8]->header->{subject}, 'Re: Mail::MboxParser'); # 10-25 print "Testing attachments...there should be none\n"; for my $msg (@mails[0..7]) { ok($msg->num_entities, 1); ok($msg->get_attachments, undef); } # 25-28 print "Testing attachments on multipart...\n"; ok($mails[8]->num_entities, 3); ok($mails[8]->get_attachments); ok($mails[8]->get_attachments('Plans'), 2); Mail-MboxParser-0.55/t/old_6_autoload.t0000755000175000017500000000062410346002752020154 0ustar ethanethan00000000000000use Test; use File::Spec; use strict; use Mail::MboxParser; my $src = File::Spec->catfile('t', 'testbox'); BEGIN { plan tests => 5 }; my $mb = Mail::MboxParser->new($src, oldparser => 1); my @a = $mb->get_messages; my $msg = $a[8]; ok(defined $mb); ok($msg->effective_type, 'multipart/mixed'); ok($msg->num_entities, 3); ok($msg->parts_DFS, 2); ok($msg->parts(1)->make_singlepart eq 'ALREADY'); Mail-MboxParser-0.55/t/old_9_direct_invok.t0000755000175000017500000000645410346002752021036 0ustar ethanethan00000000000000use Test; use strict; BEGIN { plan tests => 6 }; use Mail::MboxParser::Mail; ok(1); my ($header, $body, $all) = do { local $/ = ""; my $hd = ; local $/; my $bd = ; my $al = "$hd\n$bd"; ("$hd\n", $bd, $al) }; ok(my $m1 = Mail::MboxParser::Mail->new($header, $body)); ok(my $m2 = Mail::MboxParser::Mail->new( [ split /\n/, $header ], [ split /\n/, $body ] )); ok($m1->body eq $m2->body); ok($m1->header->{subject} eq $m2->header->{subject}); ok($m1 eq $m2); __DATA__ Received: from ethan ([127.0.0.1] helo=localhost) by ethan with esmtp (Exim 3.35 #1 (Debian)) id 18Fw3L-0001G1-00 for ; Sun, 24 Nov 2002 13:39:59 +0100 Received: from ms-dienst.rz.rwth-aachen.de [134.130.3.132] by localhost with POP3 (fetchmail-5.9.11) for ethan@localhost (single-drop); Sun, 24 Nov 2002 13:39:59 +0100 (CET) Received: from ue250-1.rz.RWTH-Aachen.DE (ue250-1.rz.RWTH-Aachen.DE [134.130.3.33]) by ms-dienst.rz.rwth-aachen.de (iPlanet Messaging Server 5.2 (built Feb 21 2002)) with ESMTP id <0H62009MSYYOED@ms-dienst.rz.rwth-aachen.de> for tp517810@ims-ms-daemon (ORCPT tassilo.parseval@post.rwth-aachen.de); Sun, 24 Nov 2002 13:35:12 +0100 (MET) Received: from ms-1 (ms-1.rz.RWTH-Aachen.DE [134.130.3.130]) by ue250-1.rz.RWTH-Aachen.DE (8.12.1/8.11.3-3) with ESMTP id gAOCZCsc016474 for ; Sun, 24 Nov 2002 13:35:12 +0100 (MET) Received: from ue250-1.rz.RWTH-Aachen.DE ([134.130.3.33]) by ms-1 (MailMonitor for SMTP v1.2.0 Beta3) ; Sun, 24 Nov 2002 13:35:11 +0100 (MET) Received: from onion.perl.org (onion.valueclick.com [64.70.54.95]) by ue250-1.rz.RWTH-Aachen.DE (8.12.1/8.11.3/24) with SMTP id gAOCZ5BU016407 for ; Sun, 24 Nov 2002 13:35:10 +0100 (MET) Received: (qmail 26579 invoked by uid 1008); Sun, 24 Nov 2002 12:35:04 +0000 Received: (qmail 26569 invoked by uid 76); Sun, 24 Nov 2002 12:35:04 +0000 Received: from root@[212.40.160.59] (HELO pause.perl.org) (212.40.160.59) by onion.perl.org (qpsmtpd/0.12) with SMTP; 2002-11-24 12:35:03Z Received: (from root@localhost) by pause.perl.org (8.11.6/8.11.6) id gAOCZ0f29640; Sun, 24 Nov 2002 13:35:00 +0100 Date: Sun, 24 Nov 2002 13:35:00 +0100 From: PAUSE Subject: CPAN Upload: V/VP/VPARSEVAL/Mail-MboxParser-0.36.tar.gz To: Tassilo von Parseval , cpan-testers@perl.org Reply-to: cpan-testers@perl.org Message-id: <200211241235.gAOCZ0f29640@pause.perl.org> MIME-version: 1.0 Content-type: Text/Plain; Charset=UTF-8 Content-transfer-encoding: 8bit Delivered-to: cpanmail-VPARSEVAL@cpan.org X-SMTPD: qpsmtpd/0.12, http://develooper.com/code/qpsmtpd/ X-Spam-Status: No, hits=1.0 required=5.0 tests=FROM_NAME_NO_SPACES,DOUBLE_CAPSWORD version=2.31 X-Spam-Level: * Status: RO Content-Length: 459 Lines: 18 The uploaded file Mail-MboxParser-0.36.tar.gz has entered CPAN as file: $CPAN/authors/id/V/VP/VPARSEVAL/Mail-MboxParser-0.36.tar.gz size: 35589 bytes md5: 8d278ce52fb4fb018905084c273281b5 No action is required on your part Request entered by: VPARSEVAL (Tassilo von Parseval) Request entered on: Sun, 24 Nov 2002 12:34:21 GMT Request completed: Sun, 24 Nov 2002 12:35:00 GMT Virtually Yours, Id: paused,v 1.81 2002/08/02 11:34:24 k Exp k Mail-MboxParser-0.55/t/3_while.t0000755000175000017500000000232710346002752016615 0ustar ethanethan00000000000000use Test; use File::Spec; use strict; use Mail::MboxParser; my $src = File::Spec->catfile('t', 'testbox'); BEGIN { plan tests => 28 }; my $mb = Mail::MboxParser->new($src); my @mails; while (my $msg = $mb->next_message) { push @mails, $msg; } # 1 print "Testing num of messages...\n"; ok(scalar @mails, $mb->nmsgs); # 2 - 9 print "Testing subjects...\n"; ok($mails[1]->header->{subject}, 'Welcome new user VPARSEVAL'); ok($mails[2]->header->{subject}, 'Welcome new user VPARSEVAL'); ok($mails[3]->header->{subject}, 'Password Update'); ok($mails[4]->header->{subject}, 'Notification from PAUSE'); ok($mails[5]->header->{subject}, 'CPAN Upload: V/VP/VPARSEVAL/Mail-MboxParser-0.01.tar.gz'); ok($mails[6]->header->{subject}, 'Module submission Mail::MboxParser'); ok($mails[7]->header->{subject}, 'Module submission Mail::MboxParser'); ok($mails[8]->header->{subject}, 'Re: Mail::MboxParser'); # 10-25 print "Testing attachments...there should be none\n"; for my $msg (@mails[0..7]) { ok($msg->num_entities, 1); ok($msg->get_attachments, undef); } # 10-28 print "Testing attachments on multipart...\n"; ok($mails[8]->num_entities, 3); ok($mails[8]->get_attachments); ok($mails[8]->get_attachments('Plans'), 2); Mail-MboxParser-0.55/t/qpname0000644000175000017500000000664510346002752016306 0ustar ethanethan00000000000000From - Mon Jul 11 11:29:52 2005 X-UIDL: 3a9500470000b54b X-Mozilla-Status: 0001 X-Mozilla-Status2: 00000000 Return-Path: X-Original-To: xxx@xxx.edu Delivered-To: xxx@xxx.edu Received: from localhost (localhost [127.0.0.1]) by mail.xxxxxxxxxxxxxxxx.edu (Postfix) with ESMTP id CC30433669 for ; Mon, 11 Jul 2005 11:29:53 +0300 (EEST) Received: from smtp.xxxxxxxxxxxxxx.edu (smtp.xxxxxxxxxx.edu.tr [192.168.1.91]) by mail.xxxxxxxxxxxxxx.edu (Postfix) with ESMTP id 638B533668 for ; Mon, 11 Jul 2005 11:29:53 +0300 (EEST) Received: from sabanciuniv.edu (xxxx.xxxxxxxxxxxxx.edu [10.10.1.173]) (authenticated as xxxxx bits=0) by smtp.xxxxxxxxxxxxxxx.edu with ESMTP id j6B8TruC018406 for ; Mon, 11 Jul 2005 11:29:53 +0300 Message-ID: <42D22DFE.6050106@xxx.edu> Date: Mon, 11 Jul 2005 11:29:50 +0300 From: =?ISO-8859-9?Q?Xxxxx_Xxx=FD?= User-Agent: Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.4) Gecko/20030624 Netscape/7.1 (ax) X-Accept-Language: tr, en-us, en MIME-Version: 1.0 To: Alper Sari Subject: test with Turkish characters iso-8859-9 Content-Type: multipart/mixed; boundary="------------080204030105050406030001" X-Virus-Scanned: by AMaViS Status: This is a multi-part message in MIME format. --------------080204030105050406030001 Content-Type: multipart/alternative; boundary="------------030509000709060208040801" --------------030509000709060208040801 Content-Type: text/plain; charset=ISO-8859-9; format=flowed Content-Transfer-Encoding: 8bit The attachment's name includes some turkish characters like (þðüýçö) Thank you best -- --------------030509000709060208040801 Content-Type: text/html; charset=ISO-8859-9 Content-Transfer-Encoding: 8bit The attachment's name includes some turkish characters like (þðüýçö)
Thank you
best

--




--------------030509000709060208040801-- --------------080204030105050406030001 Content-Type: text/plain; name="test =?ISO-8859-9?Q?=FE=F0=FC=FD=E7=F6_characters=2Etxt?=" Content-Transfer-Encoding: 8bit Content-Disposition: inline; filename="test =?ISO-8859-9?Q?=FE=F0=FC=FD=E7=F6_characters=2Etxt?=" some text for test some Turkish characters as ðüþöçý sd asdf asdf Note that the query also selects records with dates that lie in the future. Functions that expect date values usually accept datetime values and ignore the time part. Functions that expect time values usually accept datetime values and ignore the date part. Functions that return the current date or time each are evaluated only once per query at the start of query execution. This means that multiple references to a function such as NOW() within a single query always produce the same result. This principle also applies to CURDATE(), CURTIME(), UTC_DATE(), UTC_TIME(), UTC_TIMESTAMP(), and to any of their synonyms. --------------080204030105050406030001-- Mail-MboxParser-0.55/MANIFEST0000644000175000017500000000112710346002752015756 0ustar ethanethan00000000000000Changelog MANIFEST Makefile.PL MboxParser.pm MboxParser/Base.pm MboxParser/Mail.pm MboxParser/Mail/Body.pm MboxParser/Mail/Convertable.pm README eg/store_att.pl eg/store_att_while.pl t/0_pod.t t/0_pod_coverage.t t/1_mmb.t t/10_qpnames.t t/2_for.t t/3_while.t t/4_index.t t/5_body.t t/6_autoload.t t/7_attach.t t/8_from_trace.t t/9_direct_invok.t t/old_1_mmb.t t/old_2_for.t t/old_3_while.t t/old_4_index.t t/old_5_body.t t/old_6_autoload.t t/old_7_attach.t t/old_8_from_trace.t t/old_9_direct_invok.t t/qpname t/testbox META.yml Module meta-data (added by MakeMaker) Mail-MboxParser-0.55/META.yml0000644000175000017500000000070510346004147016077 0ustar ethanethan00000000000000# http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: Mail-MboxParser version: 0.55 version_from: MboxParser.pm installdirs: site requires: File::Temp: 0 MIME::Base64: 0 MIME::QuotedPrint: 0 MIME::Tools: 5 distribution_type: module generated_by: ExtUtils::MakeMaker version 6.17 Mail-MboxParser-0.55/eg/0000755000175000017500000000000010346004150015211 5ustar ethanethan00000000000000Mail-MboxParser-0.55/eg/store_att.pl0000755000175000017500000000101710346002752017562 0ustar ethanethan00000000000000#! /usr/bin/perl # $Id: store_att.pl,v 1.3 2001/09/07 11:06:15 parkerpine Exp $ use strict; use lib "../../"; use Mail::MboxParser; my @Mboxes; my $Dir = shift; if (-d $Dir) { opendir DIR, $Dir or die "Error: Could not open $Dir: $!"; @Mboxes = readdir DIR ; } else { push @Mboxes, $Dir; } my $Mb = Mail::MboxParser->new($Mboxes[0]); for my $m (@Mboxes) { my $mbox; if (-e $m) { $mbox = $m } else { $mbox = "$Dir/$m" } $Mb->open($mbox); $_->store_all_attachements(path => '/tmp') for ($Mb->get_messages); } Mail-MboxParser-0.55/eg/store_att_while.pl0000755000175000017500000000105610346002752020755 0ustar ethanethan00000000000000#! /usr/bin/perl # $Id: store_att.pl,v 1.3 2001/09/07 11:06:15 parkerpine Exp $ use strict; use lib "../../"; use Mail::MboxParser; my @Mboxes; my $Dir = shift; if (-d $Dir) { opendir DIR, $Dir or die "Error: Could not open $Dir: $!"; @Mboxes = readdir DIR ; } else { push @Mboxes, $Dir; } my $Mb = Mail::MboxParser->new($Mboxes[0]); for my $m (@Mboxes) { my $mbox; if (-e $m) { $mbox = $m } else { $mbox = "$Dir/$m" } $Mb->open($mbox); while (my $msg = $Mb->next_message) { $msg->store_all_attachements(path => '/tmp'); } } Mail-MboxParser-0.55/MboxParser/0000755000175000017500000000000010346004150016700 5ustar ethanethan00000000000000Mail-MboxParser-0.55/MboxParser/Mail.pm0000644000175000017500000007206210346003310020124 0ustar ethanethan00000000000000# Mail::MboxParser - object-oriented access to UNIX-mailboxes # # Copyright (C) 2001 Tassilo v. Parseval # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. # Version: $Id: Mail.pm,v 1.53 2005/11/23 09:30:12 parkerpine Exp $ package Mail::MboxParser::Mail; require 5.004; use base qw(Exporter Mail::MboxParser::Base); # ---------------------------------------------------------------- =head1 NAME Mail::MboxParser::Mail - Provide mail-objects and methods upon =head1 SYNOPSIS See L for an outline on usage. Examples however are also provided in this manpage further below. =head1 DESCRIPTION Mail::MboxParser::Mail objects are usually not created directly though, in theory, they could be. A description of the provided methods can be found in L. However, go on reading if you want to use methods from MIME::Entity and learn about overloading. =head1 METHODS =cut use Mail::MboxParser::Mail::Body; use Mail::MboxParser::Mail::Convertable; use Carp; use strict; use vars qw($VERSION @EXPORT $AUTOLOAD $NL); $VERSION = "0.45"; @EXPORT = qw(); # we'll use it to store the MIME::Parser my $Parser; use overload '""' => \&as_string, fallback => 1; BEGIN { $Mail::MboxParser::Mail::NL = "\n" } use constant HAVE_ENCODE => eval { require Encode; 1 } || 0; use constant HAVE_MIMEWORDS => eval { require MIME::Words; 1 } || 0; # ---------------------------------------------------------------- =over 4 =item B This is usually not called directly but instead by C. You could however create a mail-object manually providing the header and body each as either one string or as an array-ref representing the lines. Here is a common scenario: Retrieving mails from a remote POP-server using Mail::POP3Client and directly feeding each mail to Cnew>: use Mail::POP3Client; use Mail::MboxParser::Mail; my $pop = new Mail::POP3Client (...); for my $i (1 .. $pop->Count) { my $msg = Mail::MboxParser::Mail->new( [ $pop->Head($i) ], [ $pop->Body($i) ] ); $msg->store_all_attachments( path => '/home/user/dump' ); } The above effectively behaves like an attachment-only retriever. =back =cut sub init (@) { my ($self, @args) = @_; my ($header, $body, $conf) = @args; $self->{HEADER} = ref $header ? $header : [ split /$NL/, $header ]; $self->{HEADER_HASH} = \&_split_header; $self->{BODY} = ref $body ? $body : [ split /$NL/, $body ]; $self->{TOP_ENTITY} = 0; $self->{ARGS} = $conf; if (! $self->{ARGS}->{uudecode} ) { # set default for 'uudecode' option $self->{ARGS}->{uudecode} = 0; } # make sure line-endings are ok if called directly if (caller(1) ne 'Mail::MboxParser') { $self->{ARGS}->{join_string} = ''; for (@{ $self->{HEADER} }, @{ $self->{BODY} }) { $_ .= "\n" unless /.*\n$/; } push @{ $self->{HEADER} }, "\n" if $self->{HEADER}->[-1] ne "\n"; } $self; } # ---------------------------------------------------------------- =over 4 =item B
Returns the mail-header as a hash-ref with header-fields as keys. All keys are turned to lower-case, so C<$header{Subject}> has to be written as C<$header{subject}>. If a header-field occurs more than once in the header, the value of the key is an array_ref. Example: my $field = $msg->header->{field}; print $field->[0]; # first occurance of 'field' print $field->[1]; # second one ... =back =cut sub header() { my $self = shift; my $decode = $self->{ARGS}->{decode} || 'NEVER'; $self->reset_last; return $self->{HEADER_HASH}->($self, $self->{HEADER}, $decode); } # ---------------------------------------------------------------- =over 4 =item B Returns the "From "-line of the message. =back =cut sub from_line() { my $self = shift; $self->reset_last; $self->{HEADER_HASH}->($self, $self->{HEADER}, 'NEVER') if !exists $self->{FROM}; if (! exists $self->{FROM}) { $self->{LAST_ERR} = "Message did not contain a From-line"; return; } $self->{FROM}; } # ---------------------------------------------------------------- =over 4 =item B This method returns the "Received: "-lines of the message as a list. =back =cut sub trace () { my $self = shift; $self->reset_last; $self->{HEADER_HASH}->($self, $self->{HEADER}, 'NEVER') if ! exists $self->{TRACE}; if (! exists $self->{TRACE}) { $self->{LAST_ERR} = "Message did not contain any Received-lines"; return; } @{ $self->{TRACE} }; } # ---------------------------------------------------------------- =over 4 =item B =item B Returns a Mail::MboxParser::Mail::Body object. For methods upon that see further below. When called with the argument n, the n-th body of the message is retrieved. That is, the body of the n-th entity. Sets C<$mail-Eerror> if something went wrong. =back =cut sub body(;$) { my ($self, $num) = @_; $self->reset_last; if (defined $num && $num >= $self->num_entities) { $self->{LAST_ERR} = "No such body"; return; } # body needs the "Content-type: ... boundary=" stuff # in order to decide which lines are part of signature and # which lines are not (ie denote a MIME-part) my $bound; # particular entity desired? # we need to read the header of this entity then :-( if (defined $num) { my $ent = $self->get_entities($num); if ($bound = $ent->head->get('content-type')) { $bound =~ /boundary="(.*)"/; $bound = $1; } return Mail::MboxParser::Mail::Body->new($ent, $bound, $self->{ARGS}); } # else if ($bound = $self->header->{'content-type'}) { $bound =~ /boundary="(.*)"/; $bound = $1; } return ref $self->{TOP_ENTITY} eq 'MIME::Entity' ? Mail::MboxParser::Mail::Body->new($self->{TOP_ENTITY}, $bound, $self->{ARGS}) : Mail::MboxParser::Mail::Body->new(scalar $self->get_entities(0), $bound, $self->{ARGS}); } # ---------------------------------------------------------------- =over 4 =item B This will return an index number that represents what Mail::MboxParser::Mail considers to be the actual (main)-body of an email. This is useful if you don't know about the structure of a message but want to retrieve the message's signature for instance: $signature = $msg->body($msg->find_body)->signature; Changes are good that find_body does what it is supposed to do. =back =cut sub find_body() { my $self = shift; $self->{LAST_ERR} = "Could not find a suitable body at all"; my $num = -1; for my $part ($self->parts_DFS) { $num++; if ($part->effective_type eq 'text/plain') { $self->reset_last; last; } } return $num; } # ---------------------------------------------------------------- =over 4 =item B Returns a Mail::MboxParser::Mail::Convertable object. For details on what you can do with it, read L. =back =cut sub make_convertable(@) { my $self = shift; return ref $self->{TOP_ENTITY} eq 'MIME::Entity' ? Mail::MboxParser::Mail::Convertable->new($self->{TOP_ENTITY}) : Mail::MboxParser::Mail::Convertable->new($self->get_entities(0)); } # ---------------------------------------------------------------- =over 4 =item B Returns the specified raw field from the message header, that is: the fieldname is not stripped off nor is any decoding done. Returns multiple lines as needed if the field is "Received" or another multi-line field. Not case sensitive. C always returns one string regardless of how many times the field occured in the header. Multiple occurances are separated by a newline and multiple whitespaces squeezed to one. That means you can process each occurance of the field thusly: for my $field ( split /\n/, $msg->get_field('received') ) { # do something with $field } Sets C<$mail-Eerror> if the field was not found in which case C returns C. =back =cut sub get_field($) { my ($self, $fieldname) = @_; $self->reset_last; my @headerlines = ref $self->{HEADER} ? @{$self->{HEADER}} : split /$NL/, $self->{HEADER}; chomp @headerlines; my ($ret, $inretfield); foreach my $bit (@headerlines) { if ($bit =~ /^\s/) { if ($inretfield) { $bit =~ s/\s+/ /g; $ret .= $bit; } } elsif ($bit =~ /^$fieldname/i) { $bit =~ s/\s+/ /g; $inretfield++; if (defined $ret) { $ret .= "\n" . $bit } else { $ret .= $bit } } else { $inretfield = 0; } } $self->{LAST_ERR} = "No such field" if not $ret; return $ret; } # ---------------------------------------------------------------- =over 4 =item B Returns a hash-ref with the two fields 'name' and 'email'. Returns C if empty. The name-field does not necessarily contain a value either. Example: print $mail->from->{email}; On behalf of suggestions I received from users, from() tries to be smart when 'name'is empty and 'email' has the form 'first.name@host.com'. In this case, 'name' is set to "First Name". =back =cut sub from() { my $self = shift; $self->reset_last; my $from = $self->header->{from}; my ($name, $email) = split /\s\$//g unless not $email; if ($name && ! $email) { $email = $name; $name = ""; $name = ucfirst($1) . " " . ucfirst($2) if $email =~ /^(.*?)\.(.*)@/; } return {(name => $name, email => $email)}; } # ---------------------------------------------------------------- =over 4 =item B Returns an array of hash-references of all to-fields in the mail-header. Fields are the same as those of C<$mail-Efrom>. Example: for my $recipient ($mail->to) { print $recipient->{name} || "", "\n"; print $recipient->{email}; } The same 'name'-smartness applies here as described under C. =back =cut sub to() { shift->_recipients("to") } # ---------------------------------------------------------------- =over 4 =item B Identical with to() but returning the hash-refed "Cc: "-line. The same 'name'-smartness applies here as described under C. =back =cut sub cc() { shift->_recipients("cc") } # ---------------------------------------------------------------- =over 4 =item B Returns the message-id of a message cutting off the leading and trailing '<' and '>' respectively. =back =cut sub id() { my $self = shift; $self->reset_last; $self->header->{'message-id'} =~ /\<(.*)\>/; $1; } # ---------------------------------------------------------------- # -------------------- # MIME-related methods #--------------------- # ---------------------------------------------------------------- =over 4 =item B Returns the number of MIME-entities. That is, the number of sub-entitities actually. If 0 is returned and you think this is wrong, check C<$mail-Elog>. =back =cut sub num_entities() { my $self = shift; $self->reset_last; # force list contest becaus of wantarray in get_entities $self->{NUM_ENT} = () = $self->get_entities unless defined $self->{NUM_ENT}; return $self->{NUM_ENT}; } # ---------------------------------------------------------------- =over 4 =item B =item B Either returns an array of all MIME::Entity objects or one particular if called with a number. If no entity whatsoever could be found, an empty list is returned. C<$mail-Elog> instantly called after get_entities will give you some information of what internally may have failed. If set, this will be an error raised by MIME::Entity but you don't need to worry about it at all. It's just for the record. =back =cut sub get_entities(@) { my ($self, $num) = @_; $self->reset_last; if (defined $num && $num >= $self->num_entities) { $self->{LAST_ERR} = "No such entity"; return; } if (ref $self->{TOP_ENTITY} ne 'MIME::Entity') { if (! defined $Parser) { eval { require MIME::Parser; }; $Parser = new MIME::Parser; $Parser->output_to_core(1); $Parser->extract_uuencode($self->{ARGS}->{uudecode}); } my $data = $self->as_string; $self->{TOP_ENTITY} = $Parser->parse_data($data); } my @parts = eval { $self->{TOP_ENTITY}->parts_DFS; }; $self->{LAST_LOG} = $@ if $@; return wantarray ? @parts : $parts[$num]; } # ---------------------------------------------------------------- # just overriding MIME::Entity::parts() # to work around its strange behaviour sub parts(@) { shift->get_entities(@_) } # ---------------------------------------------------------------- =over 4 =item B Returns the body of the n-th MIME::Entity as a single string, undef otherwise in which case you could check C<$mail-Eerror>. =back =cut sub get_entity_body($) { my $self = shift; my $num = shift; $self->reset_last; if ($num < $self->num_entities && $self->get_entities($num)->bodyhandle) { return $self->get_entities($num)->bodyhandle->as_string; } else { $self->{LAST_ERR} = "$num: No such entity"; return; } } # ---------------------------------------------------------------- =over 4 =item B FILEHANDLE)> Stores the stringified body of n-th entity to the specified filehandle. That's basically the same as: my $body = $mail->get_entity_body(0); print FILEHANDLE $body; and could be shortened to this: $mail->store_entity_body(0, handle => \*FILEHANDLE); It returns a true value on success and undef on failure. In this case, examine the value of $mail->error since the entity you specified with 'n' might not exist. =back =cut sub store_entity_body($@) { my $self = shift; my ($num, %args) = @_; $self->reset_last; if (not $num || (not exists $args{handle} && ref $args{handle} ne 'GLOB')) { croak < \*FILEHANDLE. EOC } binmode $args{handle}; my $b = $self->get_entity_body($num); print { $args{handle} } $b if defined $b; return 1; } # ---------------------------------------------------------------- =over 4 =item B =item B It is really just a call to store_entity_body but it will take care that the n-th entity really is a saveable attachment. That is, it wont save anything with a MIME-type of, say, text/html or so. Unless further 'options' have been given, an attachment (if found) is stored into the current directory under the recommended filename given in the MIME-header. 'options' are specified in key/value pairs: key: | value: | description: ===========|================|=============================== path | relative or | directory to store attachment (".") | absolute | | path | -----------|----------------|------------------------------- encode | encoding | Some platforms store files | suitable for | in e.g. UTF-8. Specify the | Encode::encode | appropriate encoding here and | | and the filename will be en- | | coded accordingly. -----------|----------------|------------------------------- store_only | a compiled | store only files whose file | regex-pattern | names match this pattern -----------|----------------|------------------------------- code | an anonym | first argument will be the | subroutine | $msg-object, second one the | | index-number of the current | | MIME-part | | should return a filename for | | the attachment -----------|----------------|------------------------------- prefix | prefix for | all filenames are prefixed | filenames | with this value -----------|----------------|------------------------------- args | additional | this array-ref will be passed | arguments as | on to the 'code' subroutine | array-ref | as a dereferenced array Example: $msg->store_attachment(1, path => "/home/ethan/", code => sub { my ($msg, $n, @args) = @_; return $msg->id."+$n"; }, args => [ "Foo", "Bar" ]); This will save the attachment found in the second entity under the name that consists of the message-ID and the appendix "+1" since the above code works on the second entity (that is, with index = 1). 'args' isn't used in this example but should demonstrate how to pass additional arguments. Inside the 'code' sub, @args equals ("Foo", "Bar"). If 'path' does not exist, it will try to create the directory for you. You can specify to save only files matching a certain pattern. To do that, use the store-only switch: $msg->store_attachment(1, path => "/home/ethan/", store_only => qr/\.jpg$/i); The above will only save files that end on '.jpg', not case-sensitive. You could also use a non-compiled pattern if you want, but that would make for instance case-insensitive matching a little cumbersome: store_only => '(?i)\.jpg$' If you are working on a platform that requires a certain encoding for filenames on disk, you can use the 'encode' option. This becomes necessary for instance on Mac OS X which internally is UTF-8 based. If the filename contains 8bit characters (like the German umlauts or French accented characters as in 'é'), storing the attachment under a non-encoded name will most likely fail. In this case, use something like this: $msg->store_attachment(1, path => '/tmp', encode => 'utf-8'); See L for a list of encodings that you may use. Returns the filename under which the attachment has been saved. undef is returned in case the entity did not contain a saveable attachement, there was no such entity at all or there was something wrong with the 'path' you specified. Check C<$mail-Eerror> to find out which of these possibilities apply. =back =cut sub store_attachment($@) { my $self = shift; my ($num, %args) = @_; $self->reset_last; my $path = $args{path} || "."; $path =~ s/\/$//; my $prefix = $args{prefix} || ""; if (defined $args{code} && ref $args{code} ne 'CODE') { carp <num_entities) { my $file = $self->_get_attachment( $num ); return if ! defined $file; if (-e $path && not -d _) { $self->{LAST_ERR} = "$path is a file"; return; } if (not -e _) { if (not mkdir $path, 0755) { $self->{LAST_ERR} = "Could not create directory $path: $!"; return; } } if (defined $args{code}) { $file = $args{code}->($self, $num, @{$args{args}}) } #if ($file =~ /=\?.*\?=/ and HAVE_MIMEWORDS) { # decode qp if possible # $file = MIME::Words::decode_mimewords($file); #} return if defined $args{store_only} and $file !~ /$args{store_only}/; if ($args{encode} and HAVE_ENCODE) { $file = Encode::encode($args{encode}, $file); } local *ATT; if (open ATT, ">$path/$prefix$file") { $self->store_entity_body($num, handle => \*ATT); close ATT ; return "$prefix$file"; } else { $self->{LAST_ERR} = "Could not create $path/$prefix$file: $!"; return; } } else { $self->{LAST_ERR} = "$num: No such entity"; return; } } # ---------------------------------------------------------------- =over 4 =item B =item B Walks through an entire mail and stores all apparent attachments. 'options' are exactly the same as in C with the same behaviour if no options are given. Returns a list of files that have been succesfully saved and an empty list if no attachment could be extracted. C<$mail-Eerror> will tell you possible failures and a possible explanation for that. =back =cut sub store_all_attachments(@) { my $self = shift; my %args = @_; $self->reset_last; if (defined $args{code} and ref $args{code} ne 'CODE') { carp <num_entities - 1) { push @files, $self->store_attachment($_, %args); } $self->{LAST_ERR} = "Found no attachment at all" if ! @files; return @files; } # ---------------------------------------------------------------- =over 4 =item B =item B This method returns a mapping from attachment-names (if those are savable) to index-numbers of the MIME-part that represents this attachment. It returns a hash-reference, the file-names being the key and the index the value: my $mapping = $msg->get_attachments; for my $filename (keys %$mapping) { print "$filename => $mapping->{$filename}\n"; } If called with a string as argument, it tries to look up this filename. If it can't be found, undef is returned. In this case you also should have an error-message patiently awaiting you in the return value of C<$mail-Eerror>. Even though it looks tempting, don't do the following: # BAD! for my $file (qw/file1.ext file2.ext file3.ext file4.ext/) { print "$file is in message ", $msg->id, "\n" if defined $msg->get_attachments($file); } The reason is that C is currently B optimized to cache the filename mapping. So, each time you call it on (even the same) message, it will scan it from beginning to end. Better would be: # GOOD! my $mapping = $msg->get_attachments; for my $file (qw/file1.ext file2.ext file3.ext file4.ext/) { print "$file is in message ", $msg->id, "\n" if exists $mapping->{$file}; } =back =cut sub get_attachments(;$) { my ($self, $name) = @_; $self->reset_last; my %mapping; for my $num (0 .. $self->num_entities - 1) { my $file = $self->_get_attachment($num); $mapping{ $file } = $num if defined $file; } if ($name) { if (! exists $mapping{$name}) { $self->{LAST_ERR} = "$name: No such attachment"; return; } else { return $mapping{$name} } } if (keys %mapping == 0) { $self->{LAST_ERR} = "No attachments at all"; return; } return \%mapping; } sub _get_attachment { my ($self, $num) = @_; my $file = eval { $self->get_entities($num)->head->recommended_filename }; $self->{LAST_LOG} = $@; if (! $file) { # test for Content-Disposition if (! $self->get_entities($num)->head->get('content-disposition')) { return; } else { my ($type, $filename) = split /;\s*/, $self->get_entities($num)->head->get('content-disposition'); if ($type eq 'attachment') { if ($filename =~ /filename\*?=(.*?''?)?(.*)$/) { ($file = $2) =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg; } } } } return if not $file; if ($file =~ /=\?.*\?=/ and HAVE_MIMEWORDS) { # decode qp if possible $file = MIME::Words::decode_mimewords($file); } return $file; } # ---------------------------------------------------------------- =over 4 =item B Returns the message as one string. This is the method that string overloading depends on, so these two are the same: print $msg; print $msg->as_string; =back =cut sub as_string { my $self = shift; my $js = $self->{ARGS}->{join_string}; return join $js, @{ $self->{HEADER} }, @{ $self->{BODY} }; } sub _recipients($) { my ($self, $field) = @_; $self->reset_last; my $rec = $self->header->{$field}; if (! $rec) { $self->{LAST_ERR} = "'$field' not in header"; return; } $rec =~ s/(?<=\@)(.*?),/$1\n/g; my @recs = split /\n/, $rec; s/^\s+//, s/\s+$// for @recs; # remove leading or trailing whitespaces my @rec_line; for my $pair (@recs) { my ($name, $email) = split /\s$//g if $email; if ($name && ! $email) { $email = $name; $name = ""; $name = ucfirst($1) . " " . ucfirst($2) if $email =~ /^(.*?)\.(.*)@/; } push @rec_line, {(name => $name, email => $email)}; } return @rec_line; } # patch provided by Kenn Frankel # additional corrections by Nathan Uno sub _split_header { local $/ = $NL; my ($self, $header, $decode) = @_; my @headerlines = @{ $header }; my @header; chomp @headerlines if ref $header; foreach my $bit (@headerlines) { $bit =~ s/\s+$//; # discard trailing whitespace if ($bit =~ s/^\s+/ /) { $header[-1] .= $bit } else { push @header, $bit } } my ($key, $value); my %header; for (@header) { if (/^Received:\s/) { push @{$self->{TRACE}}, substr($_, 10) } elsif (/^From /) { $self->{FROM} = $_ } else { my $idx = index $_, ": "; $key = substr $_, 0, $idx; $value = $idx != -1 ? substr $_, $idx + 2 : ""; if ($decode eq 'ALL' || $decode eq 'HEADER') { use MIME::Words qw(:all); $value = decode_mimewords($value); } # if such a field is already there => make array-ref if (exists $header{lc($key)}) { my $elem = $header{lc($key)}; my @data = ref $elem ? @$elem : $elem; push @data, $value; $header{lc($key)} = [ @data ]; } else { $header{lc($key)} = $value; } } } return \%header; } sub AUTOLOAD { my ($self, @args) = @_; (my $call = $AUTOLOAD) =~ s/.*:://; # for backward-compatibility if ($call eq 'store_attachement') { return $self->store_attachment(@args); } if ($call eq 'store_all_attachements') { return $self->store_all_attachments(@args); } # test some potential classes that might implement $call { no strict 'refs'; for my $class (qw/MIME::Entity Mail::Internet/) { eval "require $class"; # we found a Class that implements $call if ($class->can($call)) { # MIME::Entity needed if ($class eq 'MIME::Entity') { if (! defined $Parser) { eval { require MIME::Parser }; $Parser = new MIME::Parser; $Parser->output_to_core(1); $Parser->extract_uuencode($self->{ARGS}->{uudecode}); } my $js = $self->{ARGS}->{join_string}; $self->{TOP_ENTITY} = $Parser->parse_data(join $js, @{$self->{HEADER}}, @{$self->{BODY}}) if ref $self->{TOP_ENTITY} ne 'MIME::Entity'; return $self->{TOP_ENTITY}->$call(@args); } # Mail::Internet needed if ($class eq 'Mail::Internet') { return Mail::Internet->new([ split /\n/, join "", ref $self->{HEADER} ? @{$self->{HEADER}} : $self->{HEADER} . $self->{BODY} ]); } } } # end 'for' } # end 'no strict refs' block } sub DESTROY { } 1; __END__ =head1 EXTERNAL METHODS Mail::MboxParser::Mail implements an autoloader that will do the appropriate type-casts for you if you invoke methods from external modules. This, however, currently only works with MIME::Entity. Support for other modules will follow. Example: my $mb = Mail::MboxParser->new("/home/user/Mail/received"); for my $msg ($mb->get_messages) { print $msg->effective_type, "\n"; } C is not implemented by Mail::MboxParser::Mail and thus the corresponding method of MIME::Entity is automatically called. To learn about what methods might be useful for you, you should read the "Access"-part of the section "PUBLIC INTERFACE" in the MIME::Entity manpage. It may become handy if you have mails with a lot of MIME-parts and you not just want to handle binary-attachments but any kind of MIME-data. =head1 OVERLOADING Mail::MboxParser::Mail overloads the " " operator. Overloading operators is a fancy feature of Perl and some other languages (C++ for instance) which will change the behaviour of an object when one of those overloaded operators is applied onto it. Here you get the stringified mail when you write C<$mail> while otherwise you'd get the stringified reference: C. =head1 VERSION This is version 0.55. =head1 AUTHOR AND COPYRIGHT Tassilo von Parseval Copyright (c) 2001-2005 Tassilo von Parseval. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L L, L, L =cut Mail-MboxParser-0.55/MboxParser/Mail/0000755000175000017500000000000010346004150017562 5ustar ethanethan00000000000000Mail-MboxParser-0.55/MboxParser/Mail/Body.pm0000644000175000017500000002062210346003331021017 0ustar ethanethan00000000000000# Mail::MboxParser - object-oriented access to UNIX-mailboxes # Body.pm - the (textual) body of an email # # Copyright (C) 2001 Tassilo v. Parseval # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. # Version: $Id: Body.pm,v 1.14 2002/02/21 09:06:14 parkerpine Exp $ package Mail::MboxParser::Mail::Body; require 5.004; use Carp; use strict; use base qw(Exporter); use vars qw($VERSION @EXPORT @ISA $AUTOLOAD $_HAVE_NOT_URI_FIND); $VERSION = "0.15"; @EXPORT = qw(); @ISA = qw(Mail::MboxParser::Base Mail::MboxParser::Mail); use overload '""' => sub { shift->as_string }, fallback => 1; BEGIN { eval { require URI::Find; }; if ($@) { $_HAVE_NOT_URI_FIND = 1; } } sub init(@) { my ($self, $ent, $bound, $conf) = @_; $self->{CONTENT} = $ent->body; $self->{BOUNDARY} = $bound; # the one in Content-type $self->{ARGS} = $conf; $self->{ARGS}->{decode} ||= 'NEVER'; $self->_make_decoder($ent->head->mime_encoding) if $self->{ARGS}->{decode} =~ /BODY|ALL/;; $self; } sub _make_decoder { my ($self, $enc) = @_; if ($enc eq 'base64') { require MIME::Base64; return $self->{DECODER} = sub { MIME::Base64::decode_base64(shift) }; } if ($enc eq 'quoted-printable') { require MIME::QuotedPrint; return $self->{DECODER} = sub { MIME::QuotedPrint::decode_qp(shift) }; } $self->{DECODER} = sub { $_[0] }; } sub as_string { my ($self, %args) = @_; $self->reset_last; return join "", $self->as_lines(strip_sig => 1) if $args{strip_sig}; my $decode = $self->{ARGS}->{decode}; if ($decode eq 'BODY' || $decode eq 'ALL') { return join "", map { $self->{DECODER}->($_) } @{$self->{CONTENT}}; } return join "", @{$self->{CONTENT}}; } sub as_lines() { my ($self, %args) = @_; $self->reset_last; my $decode = $self->{ARGS}->{decode}; if ($decode eq 'BODY' || $decode eq 'ALL') { return map { $self->{DECODER}->($_) } @{$self->{CONTENT}}; } return @{$self->{CONTENT}} if ! $args{strip_sig}; my @lines; for (@{ $self->{CONTENT} }) { last if /^--\040?[\r\n]?$/; push @lines, $_; } return @lines; } sub signature() { my $self = shift; $self->reset_last; my $decode = $self->{ARGS}->{decode}; my $bound = $self->{BOUNDARY}; my @signature; my $seperator = 0; for (@{$self->{CONTENT}}) { # we are still outside the signature if (! /^--\040?[\r\n]?$/ && not $seperator) { next; } # we hit the signature delimiter (--) elsif (not $seperator) { $seperator = 1; next } chomp; # we are inside signature: is line perhaps MIME-boundary? last if $bound && /^--\Q$bound\E/ && $seperator; # none of the above => signature line push @signature, $_; } $self->{LAST_ERR} = "No signature found" if !@signature; if ($decode eq 'BODY' || $decode eq 'ALL') { $_ = $self->{DECODER}->($_) for @signature; } return @signature if $seperator; return (); } sub extract_urls(@) { my ($self, %args) = @_; $self->reset_last; $args{unique} = 0 if not exists $args{unique}; if ($_HAVE_NOT_URI_FIND) { carp <{CONTENT}}) { chomp $line; URI::Find::find_uris($line, sub { my (undef, $url) = @_; $line =~ s/^\s+|\s+$//; if (not $seen{$url}) { push @uris, { url => $url, context => $line }; } $seen{$url}++ if $args{unique}; } ); } $self->{LAST_ERR} = "No URLs found" if @uris == 0; return @uris; } } sub quotes() { my $self = shift; my $decode = $self->{ARGS}->{decode}; $self->reset_last; my %ret; my $q = 0; # num of '>' my $in = 0; # being inside a quote my $last = 0; # num of quotes in last line for (@{$self->{CONTENT}}) { if ($decode eq 'ALL' || $decode eq 'BODY') { $_ = $self->{DECODER}->($_); } # count quotation signs $q = 0; my $t = "a" x length; for my $c (unpack $t, $_) { if ($c eq '>') { $q++ } if ($c ne '>' && $c ne ' ') { last } } # first: create a hash-element for level $q if (! exists $ret{$q}) { $ret{$q} = []; } # if last line had the same level as current one: # attach the line to the last one if ($last == $q) { if (@{$ret{$q}} == 0) { $ret{$q}->[$q] .= $_ } else { $ret{$q}->[-1] .= $_ } } # if not: # create a new array-element in the appropriate hash-element else { push @{$ret{$q}}, $_; } $last = $q; } return \%ret; } 1; __END__ =head1 NAME Mail::MboxParser::Mail::Body - rudimentary mail-body object =head1 SYNOPSIS use Mail::MboxParser; [...] # $msg is a Mail::MboxParser::Mail my $body = $msg->body(0); # or preferably my $body = $msg->body($msg->find_body); for my $line ($body->signature) { print $line, "\n" } for my $url ($body->extract_urls(unique => 1)) { print $url->{url}, "\n"; print $url->{context}, "\n"; } =head1 DESCRIPTION This class represents the body of an email-message. Since emails can have multiple MIME-parts and each of these parts has a body it is not always easy to say which part actually holds the text of the message (if there is any at all). Mail::MboxParser::Mail::find_body will help and suggest a part. =head1 METHODS =over 4 =item B 1])> Returns the textual representation of the body as one string. Decoding takes place when the mailbox has been opened using the decode => 'BODY' | 'ALL' option. If 'strip_sig' is set to a true value, the signature is stripped from the string. =item B 1])> Sames as as_string() just that you get an array of lines with newlines attached to each line. B When the body is actually some encoded binary data (most commonly such a body is base64-encoded), you can still use this method. Then you wont really get proper lines. Instead you get chunks of binary data that you should concatenate as in my $binary = join "", $body->as_lines; If 'strip_sig' is set to a true value, the signature is stripped from the string. =item B Returns the signature of a message as an array of lines. Trailing newlines are already removed. $body->error returns a string if no signature has been found. =item B =item B 1)> Returns an array of hash-refs. Each hash-ref has two fields: 'url' and 'context' where context is the line in which the 'url' appeared. When calling it like $mail->extract_urls(unique => 1), duplicate URLs will be filtered out regardless of the 'context'. That's useful if you just want a list of all URLs that can be found in your mails. $body->error() will return a string if no URLs could be found within the body. =item B Returns a hash-ref of array-refs where the hash-keys are the several levels of quotation. Each array-element contains the paragraphs of this quotation-level as one string. Example: my $quotes = $msg->body($msg->find_body)->quotes; print $quotes->{1}->[0], "\n"; print $quotes->{0}->[0], "\n"; This should print the first paragraph of the mail-body that has been quoted once and below that the paragraph that supposedly is the reply to this paragraph. Perhaps thus: > I had been trying to work with the CGI module > but I didn't yet fully understand it. Ah, it is tricky. Have you read the CGI-FAQ that comes with the module? Mark that empty lines will not be ignored and are part of the lines contained in the array of $quotes->{0}. So below is a little code-snippet that should, in most cases, restore the first 5 paragraphs (containing quote-level 0 and 1) of an email: for (0 .. 4) { print $quotes->{0}->[$_]; print $quotes->{1}->[$_]; } Since quotes() considers an empty line between two quotes paragraphs as a paragraph in $quotes->{0}, the paragraphs with one quote and those with zero are balanced. That means: scalar @{$quotes->{0}} - DIFF == scalar @{$quotes->{1}} where DIFF is element of {-1, 0, 1}. Unfortunately, quotes() can up to now only deal with '>' as quotation-marks. =back =head1 VERSION This is version 0.55. =head1 AUTHOR AND COPYRIGHT Tassilo von Parseval Copyright (c) 2001-2005 Tassilo von Parseval. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO =cut Mail-MboxParser-0.55/MboxParser/Mail/Convertable.pm0000644000175000017500000001023610346003352022371 0ustar ethanethan00000000000000# Mail::MboxParser - object-oriented access to UNIX-mailboxes # Convertable.pm - allow altering of mail for multiple purposes # # Copyright (C) 2001 Tassilo v. Parseval # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. # Version: $Id: Convertable.pm,v 1.6 2002/02/21 09:06:15 parkerpine Exp $ package Mail::MboxParser::Mail::Convertable; require 5.004; use Carp; use strict; use base qw(Exporter); use vars qw($VERSION @EXPORT @ISA $AUTOLOAD); $VERSION = "0.06"; @EXPORT = qw(); @ISA = qw(Mail::MboxParser::Base Mail::MboxParser::Mail); sub init(@) { my ($self, $ent, @args) = @_; $self->{TOP_ENTITY} = $ent; $self; } sub delete_from_header(@) { my $self = shift; $self->{TOP_ENTITY}->head->delete($_) for @_; } sub add_to_header(@) { my ($self, $what) = (shift, shift); if (not ref $what) { croak <{TOP_ENTITY}->head->add(@{$what}); } sub replace_in_header($$) { if (@_ != 3) { croak <{TOP_ENTITY}->head->replace(shift, shift); } 1; __END__ =head1 NAME Mail::MboxParser::Mail::Convertable - convert mail for sending etc. =head1 SYNOPSIS use Mail::MboxParser; [...] # $msg is a Mail::MboxParser::Mail-object my $mail = $msg->make_convertable; $mail->delete_from_header('date', 'message-id'); $mail->replace_in_header('to', 'john.doe@foobar.com'); $mail->add_to_header( ['cc', 'john.does.brother@foobar.com'], where => 'BEHIND' ); $mail->send('sendmail'); =head1 DESCRIPTION This class adds means to convert an email object into something that could be send via SMTP, NNTP or dumped to a file or filehandle. Therefore, methods are provided that change the structure of an email which includes adding and removing of header-fields, MIME-parts etc and transforming them into objects of related modules. Currently, only basic manipulation of the header and sending using Mail::Mailer is provided. More is to come soon. This class works non-destructive. You first create a Convertable-object and do any modifications on this while the Mail-object from which it was derived will not be touched. =head1 METHODS =over 4 =item delete_from_header(header-fields) Given a list of header-field names, these fields will be removed from the header. If you want to re-send a message, you could for instance remove the cc-field cause otherwise the message would be carbon-copied to the addresses listed in the cc-field. =item add_to_header(array-ref) =item add_to_header(array-ref, where => 'BEFORE' | 'BEHIND') add_to_header() takes a reference to a two-element list whose first element specifies the header-field to add or to add to while the second elements specifies the data that should be added. 'where' specifies whether to add at the beginning or at the end of the header. Defaults to 'BEHIND' if not given. =item replace_in_header(header-field, new_data) First element must be the header-field to be replaced while the second argument must be a string indicating what will be the new content of the header-field. =item send(command, args) Literally inherited from Mail::Internet. Commands can be "mail" (using the UNIX-mail program), "sendmail" (using a configured sendmail or compatible MTA like exim), "smtp" (for using Net::SMTP) and "test" which will only display what would be sent using /bin/echo. Additional arguments will be passed on to Mail::Mailer->new() which is in fact what Mail::Internet->send() uses. For more details, see L =back =head1 VERSION This is version 0.55. =head1 AUTHOR AND COPYRIGHT Tassilo von Parseval Copyright (c) 2001-2005 Tassilo von Parseval. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L, L Mail-MboxParser-0.55/MboxParser/Base.pm0000644000175000017500000000263510346003320020114 0ustar ethanethan00000000000000# Mail::MboxParser - object-oriented access to UNIX-mailboxes # base-class for all other classes in Mail::MboxParser # # Copyright (C) 2001 Tassilo v. Parseval # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. # Version: $Id: Base.pm,v 1.6 2002/02/21 09:06:14 parkerpine Exp $ package Mail::MboxParser::Base; require 5.004; use strict; use vars qw($VERSION); $VERSION = "0.07"; sub new(@) { my ($class, @args) = @_; if ($class eq __PACKAGE__) { use Carp; my $package = __PACKAGE__; croak <init(@args); } sub error() { shift->{LAST_ERR} } sub log() { shift->{LAST_LOG} } sub reset_last { my $self = shift; ($self->{LAST_ERR}, $self->{LAST_LOG}) = (undef, undef); } 1; __END__ =head1 NAME Mail::MboxParser::Base - base clase for all other classes =head1 DESCRIPTION Nothing to describe nor to document here. Read L on how to use the module. =head1 VERSION This is version 0.55. =head1 AUTHOR AND COPYRIGHT Tassilo von Parseval Copyright (c) 2001-2005 Tassilo von Parseval. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Mail-MboxParser-0.55/MboxParser.pm0000644000175000017500000007064510346003713017256 0ustar ethanethan00000000000000# Mail::MboxParser - object-oriented access to UNIX-mailboxes # # Copyright (C) 2001 Tassilo v. Parseval # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. # Version: $Id: MboxParser.pm,v 1.54 2002/03/01 09:34:39 parkerpine Exp $ package Mail::MboxParser; require 5.004; use base 'Mail::MboxParser::Base'; # ---------------------------------------------------------------- =head1 NAME Mail::MboxParser - read-only access to UNIX-mailboxes =head1 SYNOPSIS use Mail::MboxParser; my $parseropts = { enable_cache => 1, enable_grep => 1, cache_file_name => 'mail/cache-file', }; my $mb = Mail::MboxParser->new('some_mailbox', decode => 'ALL', parseropts => $parseropts); # ----------- # slurping for my $msg ($mb->get_messages) { print $msg->header->{subject}, "\n"; $msg->store_all_attachments(path => '/tmp'); } # iterating while (my $msg = $mb->next_message) { print $msg->header->{subject}, "\n"; # ... } # we forgot to do something with the messages $mb->rewind; while (my $msg = $mb->next_message) { # iterate again # ... } # subscripting one message after the other for my $idx (0 .. $mb->nmsgs - 1) { my $msg = $mb->get_message($idx); } =head1 DESCRIPTION This module attempts to provide a simplified access to standard UNIX-mailboxes. It offers only a subset of methods to get 'straight to the point'. More sophisticated things can still be done by invoking any method from MIME::Tools on the appropriate return values. Mail::MboxParser has not been derived from Mail::Box and thus isn't acquainted with it in any way. It, however, incorporates some invaluable hints by the author of Mail::Box, Mark Overmeer. =head1 METHODS See also the section ERROR-HANDLING much further below. More to that, see the relevant manpages of Mail::MboxParser::Mail, Mail::MboxParser::Mail::Body and Mail::MboxParser::Mail::Convertable for a description of the methods for these objects. =cut use strict; use Mail::MboxParser::Mail; use File::Temp qw/tempfile/; use Symbol; use Carp; use IO::Seekable; use base qw(Exporter); use vars qw($VERSION @EXPORT @ISA); $VERSION = "0.55"; @EXPORT = qw(); @ISA = qw(Mail::MboxParser::Base); use constant HAVE_MSGPARSER => eval { require Mail::Mbox::MessageParser; 1 } || 0; my $from_date = qr/^From (.*)\d{4}\015?$/; my $empty_line = qr/^\015?$/; # ---------------------------------------------------------------- =over 4 =item B =item B =item B =item B This creates a new MboxParser-object opening the specified 'mailbox' with either absolute or relative path. new() can also take a reference to a variable containing the mailbox either as one string (reference to a scalar) or linewise (reference to an array), or a filehandle from which to read the mailbox. The following option(s) may be useful. The value in brackets below the key is the default if none given. key: | value: | description: ==========|============|=============================== decode | 'NEVER' | never decode transfer-encoded (NEVER) | | data |------------|------------------------------- | 'BODY' | will decode body into a human- | | readable format |------------|------------------------------- | 'HEADER' | will decode header fields if | | any is encoded |------------|------------------------------- | 'ALL' | decode any data ==========|============|=============================== uudecode | 1 | enable extraction of uuencoded (0) | | attachments in MIME::Parser |------------|------------------------------- | 0 | uuencoded attachments are | | treated as plain body text ==========|============|=============================== newline | 'UNIX' | UNIXish line-endings (AUTO) | | ("\n" aka \012) |------------|------------------------------- | 'WIN' | Win32 line-endings | | ("\n\r" aka \012\015) |------------|------------------------------- | 'AUTO' | try to do autodetection |------------|------------------------------- | custom | a user-given value for totally | | borked mailboxes ==========|============|=============================== oldparser | 1 | uses the old (and slower) (0) | | parser (but guaranteed to show | | the old behaviour) |------------|------------------------------- | 0 | uses Mail::Mbox::MessageParser ==========|============|=============================== parseropts| | see "Specifying parser opts" | | below ==========|============|=============================== The I option comes in handy if you have a mbox-file that happens to not conform to the rules of your operating-system's character semantics one way or another. One such scenario: You are using the module under Win but deliberately have mailboxes with UNIX-newlines (or the other way round). If you do not give this option, 'AUTO' is assumed and some basic tests on the mailbox are performed. This autoedection is of course not capable of detecting cases where you use something like '#DELIMITER' as line-ending. It can as to yet only distinguish between UNIX and Win32ish newlines. You may be lucky and it even works for Macintoshs. If you have more extravagant wishes, pass a costum value: my $mb = new Mail::MboxParser ("mbox", newline => '#DELIMITER'); You can't use regexes here since internally this relies on the $/ var ($INPUT_RECORD_SEPERATOR, that is). When passing either a scalar-, array-ref or \*STDIN as first-argument, an anonymous tmp-file is created to hold the data. This procedure is hidden away from the user so there is no need to worry about it. Since a tmp-file acts just like an ordinary mailbox-file you don't need to be concerned about loss of data or so once you have been walking through the mailbox-data. No data will be lost and it'll all be fine and smooth. =back =head2 Specifying parser options When available, the module will use C to do the parsing. To get the most speed out of it, you can tweak some of its options. Arguably, you even have to do that in order to make it use caching. Options for the parser are given via the I switch that expects a reference to a hash as values. The values you can specify are: =over 8 =item enable_cache When set to a true value, caching is used B if you gave I. There is no default value here! =item cache_file_name The file used for caching. This option is mandatory if I is true. =item enable_grep When set to a true value (which is the default), the extern grep(1) is used to speed up parsing. If your system does not provide a usable grep implementation, it silently falls back to the pure Perl parser. =back When the module was unable to create a C object, it will fall back to the old parser in the hope that the construction of the object then succeeds. =cut sub init (@) { my ($self, @args) = @_; if (@args == 0) { croak <open(@args); $self; } # ---------------------------------------------------------------- =over 4 =item B Takes exactly the same arguments as new() does just that it can be used to change the characteristics of a mailbox on the fly. =back =cut sub open (@) { my ($self, @args) = @_; local *_; my $source = shift @args; $self->{CONFIG} = { @args }; $self->{CURR_POS} = 0; my ($file_name, $old_filepos); # supposedly a filename if (! ref $source) { if (! -f $source) { croak <{READER} = $handle; $file_name = $source; } # a filehandle elsif (ref $source eq 'GLOB' && seek $source, 0, SEEK_CUR) { $old_filepos = tell $source; $self->{READER} = $source; } # else else { (my $fh, $file_name) = tempfile(UNLINK => 1) or croak < } seek $fh, 0, SEEK_SET; $self->{READER} = $fh; } if ($self->{CONFIG}->{oldparser} or ! HAVE_MSGPARSER or ! defined $file_name) { binmode $self->{READER}; local $^W = 0; *get_messages = \&get_messages_old; *get_message = \&get_message_old; *next_message = \&next_message_old; $self->{CONFIG}->{join_string} = ""; } else { local $^W = 0; *get_messages = \&get_messages_new; *get_message = \&get_message_new; *next_message = \&next_message_new; $self->{CONFIG}->{join_string} = "\n"; # check sanity of arguments and capabilities of system: # clean options accordingly my $opts = delete($self->{CONFIG}->{parseropts}) || {enable_grep => 1}; $opts->{enable_grep} = 1 if ! exists $self->{enable_grep}; if ($opts->{enable_grep}) { eval { require Mail::Mbox::MessageParser::Grep }; delete $opts->{enable_grep} if $@; } if ($opts->{enable_cache}) { delete $opts->{enable_cache} if ! exists $opts->{cache_file_name}; eval { require Mail::Mbox::MessageParser::Cache }; delete $opts->{enable_cache} if $@; } Mail::Mbox::MessageParser::SETUP_CACHE( { file_name => $opts->{cache_file_name} } ) if $opts->{enable_cache}; $opts->{enable_cache} ||= 0; $opts->{file_handle} = $self->{READER}; $opts->{file_name} = $file_name; if (not ref($self->{PARSER} = Mail::Mbox::MessageParser->new($opts))) { # when Mail::Mbox::MessageParser object could not be created, # try to fall back to the old parser my %opt = @args; $opt{ oldparser } = 1; delete $opt{ parseropts }; # $source could be a GLOB which we need to rewind # if it isn't, the BLOCK-eval should catch it. eval { seek $source, $old_filepos, SEEK_SET }; return Mail::MboxParser->new($source, %opt); } } # do line-ending stuff if (! exists $self->{CONFIG}->{newline}) { $self->{CONFIG}->{newline} = 'AUTO'; } my $nl = $self->{CONFIG}->{newline}; if ($nl eq 'UNIX') { $self->{NL} = "\012" } elsif ($nl eq 'WIN') { $self->{NL} = "\015\012" } elsif ($nl eq 'AUTO') { $self->{NL} = $self->_detect_nl } else { $self->{NL} = $nl } $Mail::MboxParser::Mail::NL = $self->{NL}; seek $self->{READER}, 0, SEEK_SET if ! $self->{PARSER}; return; } # ---------------------------------------------------------------- =over 4 =item B Returns an array containing all messages in the mailbox respresented as Mail::MboxParser::Mail objects. This method is _minimally_ quicker than iterating over the mailbox using C but eats much more memory. Memory-usage will grow linearly for each new message detected since this method creates a huge array containing all messages. After creating this array, it will be returned. =back =cut sub get_messages_new() { my $self = shift; my $nl = $self->{NL}; my @messages; my $p = $self->parser; $p->reset; while (! $p->end_of_file) { my $mailref = $p->read_next_email; my ($header, $body) = split /$nl$nl/, $$mailref, 2; push @messages, Mail::MboxParser::Mail->new([ split(/$nl/, $header), '' ], [ split /$nl/, $body ], $self->{CONFIG}); } $p->reset; return @messages; } sub get_messages_old() { my $self = shift; local $/ = $self->{NL}; my ($in_header, $in_body) = (0, 0); my $header; my (@header, @body); my $h = $self->{READER}; my $got_header; my @messages; seek $h, 0, SEEK_SET; local *_; while (<$h>) { # entering header if (!$in_body && /$from_date/) { ($in_header, $in_body) = (1, 0); $got_header = 0; } # entering body if ($in_header && /$empty_line/) { ($in_header, $in_body) = (0, 1); $got_header = 1; } # just before entering next mail-header or running # out of data, store message in Mail-object if ((/$from_date/ || eof) && $got_header) { push @body, $_ if eof; # don't forget last line!! my $m = Mail::MboxParser::Mail->new([ @header ], [ @body ], $self->{CONFIG}); push @messages, $m; ($in_header, $in_body) = (1, 0); undef $header; (@header, @body) = (); $got_header = 0; } if ($_) { push @header, $_ if $in_header && !$got_header; push @body, $_ if $in_body && $got_header; } } if (exists $self->{CONFIG}->{decode}) { $Mail::MboxParser::Mail::Config->{decode} = $self->{CONFIG}->{decode}; } return @messages; } # ---------------------------------------------------------------- =over 4 =item B Returns the n-th message (first message has index 0) in a mailbox. Examine C<$mb-Eerror> which contains an error-string if the message does not exist. In this case, C returns undef. =back =cut sub get_message_new($) { my ($self, $num) = @_; my $oldpos = tell $self->{READER}; my $msg = $self->get_message_old($num); seek $self->{READER}, $oldpos, SEEK_SET; return $msg; } sub get_message_old($) { my ($self, $num) = @_; local $/ = $self->{NL}; $self->reset_last; $self->make_index if ! exists $self->{MSG_IDX}; my $tmp_idx = $self->current_pos; my $pos = $self->get_pos($num); if (my $err = $self->error) { $self->set_pos($tmp_idx); $self->{LAST_ERR} = $err; return; } $self->set_pos($pos); my $msg = $self->next_message_old; $self->set_pos($tmp_idx); return $msg; } # ---------------------------------------------------------------- =over 4 =item B This lets you iterate over a mailbox one mail after another. The great advantage over C is the very low memory-comsumption. It will be at a constant level throughout the execution of your script. Secondly, it almost instantly begins spitting out Mail::MboxParser::Mail-objects since it doesn't have to slurp in all mails before returing them. =back =cut sub next_message_new() { my $self = shift; $self->reset_last; my $p = $self->parser; return undef if ref(\$p) eq 'SCALAR' or $p->end_of_file; seek $self->{READER}, $self->{CURR_POS}, SEEK_SET; my $nl = $self->{NL}; my $mailref = $p->read_next_email; my ($header, $body) = split /$nl$nl/, $$mailref, 2; my $msg = Mail::MboxParser::Mail->new([ split(/$nl/, $header), '' ], [ split /$nl/, $body ], $self->{CONFIG}); $self->{CURR_POS} = $p->offset + $p->length; return $msg; } sub next_message_old() { my $self = shift; $self->reset_last; local $/ = $self->{NL}; my $h = $self->{READER}; my ($in_header, $in_body) = (0, 0); my $header; my (@header, @body); my $got_header = 0; seek $h, $self->{CURR_POS}, SEEK_SET; # we need to force join_string to "" here because # this method is also invoked by get_message_new(): my %newopts = %{ $self->{CONFIG} }; $newopts{ join_string } = ''; local *_; while (<$h>) { $got_header = 1 if eof($h) || /$empty_line/ and $in_header; if (/$from_date/ || eof $h) { push @body, $_ if eof $h; if (! $got_header) { ($in_header, $in_body) = (1, 0); } else { $self->{CURR_POS} = tell($h) - length; return Mail::MboxParser::Mail->new(\@header, \@body, \%newopts); } } if (/$empty_line/ && $got_header) { ($in_header, $in_body) = (0, 1); $got_header = 1; } push @header, $_ if $in_header; push @body, $_ if $in_body; } } # ---------------------------------------------------------------- =over 4 =item B =item B =item B These three methods deal with the position of the internal filehandle backening the mailbox. Once you have iterated over the whole mailbox using C MboxParser has reached the end of the mailbox and you have to do repositioning if you want to iterate again. You could do this with either C or C. $mb->rewind; # equivalent to $mb->set_pos(0); C reveals the current position in the mailbox and can be used to later return to this position if you want to do tricky things. Mark that C does *not* return the current line but rather the current character as returned by Perl's tell() function. my $last_pos; while (my $msg = $mb->next_message) { # ... if ($msg->header->{subject} eq 'I was looking for this') { $last_pos = $mb->current_pos; last; # bail out here and do something else } } # ... # ... # now continue where we stopped: $mb->set_pos($last_pos) while (my $msg = $mb->next_message) { # ... } B Be very careful with these methods when using the parser of C. This parser maintains its own state and you shouldn't expect it to always be in sync with the state of C. If you need some finer control over the parsing, better consider to use the public interface as described in L. Use C to get the underlying parser object. This however may expose you to the same problems turned around: C may loose its sync with its parser when you do that. Therefore: Just avoid any of the above for now and wait till C has a stable interface. =back =cut sub set_pos($) { my ($self, $pos) = @_; $self->reset_last; $self->{CURR_POS} = $pos; } # ---------------------------------------------------------------- sub rewind() { my $self = shift; $self->reset_last; $self->set_pos(0); } # ---------------------------------------------------------------- sub current_pos() { my $self = shift; $self->reset_last; return $self->{CURR_POS}; } # ---------------------------------------------------------------- =over 4 =item B You can force the creation of a message-index with this method. The message-index is a mapping between the index-number of a message (0 .. $mb->nmsgs - 1) and the byte-position of the filehandle. This is usually done automatically for you once you call C hence the first call for a particular message will be a little slower since the message-index first has to be built. This is, however, done rather quickly. You can have a peek at the index if you are interested. The following produces a nicely padded table (suitable for mailboxes up to 9.9999...GB ;-). $mb->make_index; for (0 .. $mb->nmsgs - 1) { printf "%5.5d => %10.10d\n", $_, $mb->get_pos($_); } =back =cut sub make_index() { my $self = shift; local $/ = $self->{NL}; $self->reset_last; my $h = $self->{READER}; seek $h, 0, SEEK_SET; my $c = 0; local *_; while (<$h>) { $self->{MSG_IDX}->{$c} = tell($h) - length, $c++ if /$from_date/; } seek $h, 0, SEEK_SET; } # ---------------------------------------------------------------- =over 4 =item B This method takes the index-number of a certain message within the mailbox and returns the corresponding position of the filehandle that represents that start of the file. It is mainly used by C and you wouldn't really have to bother using it yourself except for statistical purpose as demonstrated above along with B. =back =cut sub get_pos($) { my ($self, $num) = @_; $self->reset_last; if (exists $self->{MSG_IDX}) { if (! exists $self->{MSG_IDX}{$num}) { $self->{LAST_ERR} = "$num: No such message"; } return $self->{MSG_IDX}{$num} } else { return } } # ---------------------------------------------------------------- =over 4 =item B Returns the number of messages in a mailbox. You could naturally also call get_messages in scalar-context, but this one wont create new objects. It just counts them and thus it is much quicker and wont eat a lot of memory. =back =cut sub nmsgs() { my $self = shift; local $/ = $self->{NL}; if (not $self->{READER}) { return "No mbox opened" } if (not $self->{NMSGS}) { my $h = $self->{READER}; seek $h, 0, SEEK_SET; local *_; while (<$h>) { $self->{NMSGS}++ if /$from_date/; } } return $self->{NMSGS} || 0; } # ---------------------------------------------------------------- =over 4 =item B Returns the bare C object. If no such object exists returns C. You can use this method to check whether the module actually uses the old or new parser. If C returns a false value, it is using the old parsing routines. =back =cut sub parser { shift->{PARSER} } # ---------------------------------------------------------------- sub _detect_nl { my $self = shift; my $h = $self->{READER}; my $newline; seek $h, 0, SEEK_SET; while (sysread $h, (my $c), 1) { if (ord($c) == 13) { $newline = "\015"; sysread $h, (my $next), 1; $newline .= "\012" if ord($next) == 10; last; } elsif (ord($c) == 10) { $newline = "\012"; last; } } return $newline; } # ---------------------------------------------------------------- sub DESTROY { my $self = shift; $self->{NMSGS} = undef; close $self->{READER} if defined $self->{READER}; } # ---------------------------------------------------------------- 1; __END__ =head2 METHODS SHARED BY ALL OBJECTS =over 4 =item B Call this immediately after one of the methods above that mention a possible error-message. =item B Sort of internal weirdnesses are recorded here. Again only the last event is saved. =back =head1 ERROR-HANDLING Mail::MboxParser provides a mechanism for you to figure out why some methods did not function as you expected. There are four classes of unexpected behavior: =over 4 =item B<(1) bad arguments > In this case you called a method with arguments that did not make sense, hence you confused Mail::MboxParser. Example: $mail->store_entity_body; # wrong, needs two arguments $mail->store_entity_body(0); # wrong, still needs one more In any of the above two cases, you'll get an error message and your script will exit. The message will, however, tell you in which line of your script this error occured. =item B<(2) correct arguments but...> Consider this line: $mail->store_entity_body(50, \*FH); # could be wrong Obviously you did call store_entity_body with the correct number of arguments. That's good because now your script wont just exit. Unfortunately, your program can't know in advance whether the particular mail ($mail) has a 51st entity. So, what to do? Just be brave: Write the above line and do the error-checking afterwards by calling $mail->error immediately after store_entity_body: $mail->store_entity_body(50, *\FH); if ($mail->error) { print "Oups, something wrong:", $mail->error; } In the description of the available methods above, you always find a remark when you could use $mail->error. It always returns a string that you can print out and investigate any further. =item B<(3) errors, that never get visible> Well, they exist. When you handle MIME-stuff a lot such as attachments etc., Mail::MboxParser internally calls a lot of methods provided by the MIME::Tools package. These work splendidly in most cases, but the MIME::Tools may fail to produce something sensible if you have a very queer or even screwed up mailbox. If this happens you might find information on that when calling $mail->log. This will give you the more or less unfiltered error-messages produced by MIME::Tools. My advice: Ignore them! If there really is something in $mail->log it is either because you're mails are totally weird (there is nothing you can do about that then) or these errors are smoothly catched inside Mail::MboxParser in which case all should be fine for you. =item B<(4) the apocalyps> If nothing seems to work the way it should and $mail->error is empty, then the worst case has set in: Mail::MboxParser has a bug. Needless to say that there is any way to get around of this. In this case you should contact and I'll examine that. =back =head1 CAVEATS I have been working hard on making Mail::MboxParser eat less memory and as quick as possible. Due to that, two time and memory consuming matters are now called on demand. That is, parsing out the MIME-parts and turning the raw header into a hash have become closures. The drawback of that is that it may get inefficient if you often call $mail->header->{field} In this case you should probably save the return value of $mail->header (a hashref) into a variable since each time you call it the raw header is parsed. On the other hand, if you have a mailbox of, say, 25MB, and hold each header of each message in memory, you'll quickly run out of that. So, you can now choose between more performance and more memory. This all does not happen if you just parse a mailbox to extract one header-field (eg. subject), work with that and exit. In this case it will need both less memory and is still considerably quicker. :-) =head1 BUGS Some mailers have a fancy idea of how a "To: "- or "Cc: "-line should look. I have seen things like: To: "\"John Doe"\" The splitting into name and email, however, does still work here, but you have to remove these silly double-quotes and backslashes yourself. The way of counting the messages and detecting them now complies to RFC 822. This is, however, no guarentee that it all works seamlessly. There are just so many mailboxes that get screwed up by mal-formated mails. =head1 TODO Apart from new bugs that almost certainly have been introduced with this release, following things still need to be done: =over 4 =item Transfer-Encoding Still, only quoted-printable encoding is correctly handled. =item Tests Clean-up of the test-scripts is desperately needed. Now they represent rather an arbitrary selection of tested functions. Some are tested several times while others don't show up at all in the suits. =back =head1 THANKS Thanks to a number of people who gave me invaluable hints that helped me with Mail::Box, notably Mark Overmeer for his hints on more object-orientedness. Kenn Frankel (kenn AT kenn DOT cc) kindly patched the broken split-header routine and added get_field(). David Coppit for making me aware of C and designing it the way I needed to make it work for my module. =head1 VERSION This is version 0.55. =head1 AUTHOR AND COPYRIGHT Tassilo von Parseval Copyright (c) 2001-2005 Tassilo von Parseval. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L L, L, L L =cut Mail-MboxParser-0.55/Changelog0000644000175000017500000003424010346003532016436 0ustar ethanethan00000000000000v0.55 ( Thu Dec 8 11:12:15 CET 2005) + new prefix option for store_attachment() (patch by Christian Winter ) + fixed a problem with skipping tests (spotted by Sunit M. Das v0.54 (Tue Jul 12 09:40:20 CEST 2005) + wrong assumptions about quoted-printable encoded header-fields were made which lead to attachment filenames often not decoded properly (Alper Sari ) v0.53 (Thu Mar 31 09:27:59 CEST 2005) + Adds tests for pod-correctness and -coverage v0.52 (Thu Feb 10 08:21:54 CET 2005) + now decodes both base64 and quoted-printable data in the body v0.51 (Tue Jan 4 17:36:26 CET 2005) + Mail::MboxParser::new() didn't check the return value of Mail::Mbox::MessageParser's constructor which could lead to fatal errors at runtime. When a M::M::MessageParser object could not be created, it now silently falls back to the old parser. (Nigel Horne ) v0.50 (Sun Dec 12 09:38:47 CET 2004) + At some point in the past this module must have stopped working on 5.5.x perls, fixed now v0.49 (Wed Aug 11 09:43:22 CEST 2004) + Dealing with uuencoded MIME parts added + a slight internal clean-up (patch by Ed Huott ) v0.48 (Wed May 19 07:36:34 CEST 2004) + The previous patch was only a partial solution. If an attachment wasn't saved, most of the time it meant that it wasn't even recognized as such. store_attachment() and store_all_attachments() should now find more attachments (not more than there are, hopefully;-) + Mark Mykkanen made me aware that the module wouldn't deal correctly with non-seekable filehandles. Fixed now + Localized *_ properly + Replaced 0 with SEEK_SET where it wasn't already used v0.47 (Mon May 3 08:38:45 CEST 2004) + store_attachment/store_all_attachment have new parameter 'encoding' to allow filename encoding on platforms that require this step (Mac OS X apparently) v0.46 (Fri Apr 2 09:51:34 CEST 2004) + When using the Mail::Mbox::MessageParser, the script would die on a file with zero length (patch by Lance Cleveland ) v0.45 (Thu Feb 5 10:18:30 CET 2004) + Mail::MboxParser::Mail::get_field() wasn't properly dealing with multiple occurances of a field when it was interleaved with another field (patch by Martin Zuziak + Mail::MboxParser::get_message() and ::next_message() ignored mails with no body v0.44 (Sat Jan 3 09:40:02 CET 2004) + Mail::MboxParser had problems with older versions of FileHandle::Unget. Makefile.PL now checks that a useable version is installed v0.43 (Sat Oct 18 16:23:29 CEST 2003) + Return values of File::Temp::tempfile() were mistakenly swapped (patch by Lyon Lemmens ) v0.42 (Tue Oct 14 10:46:11 CEST 2003) + fixed "Call SETUP_CACHE() before calling new()..." warning injected by Mail::Mbox::MessageParser + hopefully removed function-redefinition warnings v0.41 (Thu Sep 4 09:52:04 CEST 2003) + forgot to import tempfile() from File::Temp: this resulted in an "Undefined subroutine &Mail::MboxParser::tempfile called at..." + wrong SYNOPSIS: store_all_attachments() receives key/value pairs as arguments v0.40 (Tue Aug 19 09:14:08 CEST 2003) + next_message() and get_message() dropped last line of body if it did not end with a newline (spotted by ) v0.39 (Tue Aug 5 08:06:50 CEST 2003) + now uses David Coppit's new Mail::Mbox::MessageParser module which provides much faster and more robust parsing (the old parser can still be used (see docs)) !! therefore 0.39 should probably be marked as beta !! + removed the silly benchmark results from the PODs (they are no longer up-to-date) v0.38 (Wed Jan 15 14:34:49 CET 2003) + fixed wrong splittal: in to(), cc(), from() '"name, first" ' would be split even though the comma is within double quotes (patched by Robert McArthur ) + in same methods: 'name' is set to "First Name" if it was previously empty and the email address looks like "first.name@email.com" (suggested and patched by Robert McArthur) + fixed a mysterious "Uninitialized value in list assignment" warning in Body.pm + localized a filehandle inside Mail.pm + fixed typo in Makefile.PL v0.37 (Tue Nov 26 10:10:18 CET 2002) + fixed some inconsistencies when constructing a Mail::MboxParser::Mail object manually (thanks to Premjit Nair for tracking that down) + some of the PODs in Mail::MboxParser::Mail were really horrible, a lot of minor errors along with bad formatting fixed v0.36 (Sun Nov 24 13:24:59 CET 2002) + Mail::MboxParser::Mail::Body did not overload stringification (patched by Steven W McDougall ) v0.35 (Thu Aug 22 08:54:01 CEST 2002) + 0.34 forgot to bump the version number v0.34 (Sun Aug 11 16:25:53 CEST 2002) + new option to strip signature on output (implicitely suggested by David Bryson) + on unfolding of continuation header-lines, whitespaces disappeared (fix by Nathan Uno () + added MIME::QuotedPrint to prerequisites v0.33 (Thu Jun 20 07:26:25 CEST 2002) This is a bug-fix only release: + multiple occurances of a header-field were incorrectly handled: only the last occurance was returned, now you get an array_ref + localizing of file-handles + fixed $msg->as_string (broken in 0.32) + store_attachment() and store_all_attachments() fixed to work without the 'store_only' argument + list/scalar context issue fixed in get_entities(), that could break $msg->body under circumstances + fixed a wrong prototype in Body.pm to make Perl 5.8.0 happy v0.32 (Fri Mar 1 10:34:46 CET 2002) + fixed Mail::MboxParser::Mail::get_field() which was broken in between, behaviour of it also changed a little to make it more useful (see docs) + added fix for header-fields that only contained the name, eg. 'Subject:' + minimal corrections in some docs + added two tests for get_field() v0.31 (Thu Feb 21 09:54:11 CET 2002) + new option 'newline' for MboxParser-constructor, defaults to 'AUTO' which can distinguish between UNIXish and Win32-alike endings + fixed a problem with saving non-text attachments under Win (Aaron Johnson, Marco Trudel) + added store_only switch to store_(all_)attachment(s) to only save files matching a custom regex-pattern (Aaron Johnson) v0.30 (Thu Jan 31 10:28:42 CET 2002) + new methods for accessing the "From "-line and "Received: "-lines + I did not receive any complains about the new features introduced in the previous beta-release and so I assume they work pretty well v0.30_4 (Thu Dec 13 14:27:35 CET 2001) ----------------------- THIS IS A BETA RELEASE! ----------------------- + There had been problems with mboxes under Win having UNIXish line-ending, should be fixed now (should!) + a speed-gain of 6% on overage when parsing a mailbox and accessing header-elements v0.30_3 (Sun Dec 9 10:41:26 CET 2001) ----------------------- THIS IS A BETA RELEASE! ----------------------- + bugifx in MboxParser.pm: under Win each second mail was skipped (Marco Trudel) + removed silly debug-print in Mail.pm + minor fixes of the PODs in Mail.pm (duplicate =back directive) v0.30_1 (Mon Dec 3 12:04:00 CET 2001) ----------------------- THIS IS A BETA RELEASE! ----------------------- I added a lot of new stuff and I can't thoroughly test them all. I really need feedback from the users now whether there are stealth-bugs in it....hmmh, bugs are always sort of stealth, aren't they? Beware that store_attachement() and store_all_attachements() have been renamed to their corrected spellings. The (incorrect) old names are still there for backward-compatibility, though. ----------- New things: ----------- + new next_message mechanism (very memory-friendly) plus needed helper-functions $mb->rewind, ->set_pos, ->current_pos + new get_message(n) method along with more messages dealing with file-handle positioning and reporting (suggested by Marco Trudel ) + get_attachment method that maps attachments to idx-nums (suggested by Marco Trudel) + some fixes: - long-header lines contained wrong number of whitespaces when decoded, fixed - fix of nmsgs when mailbox has already been traversed (filehandle had to be rewinded) - 'attachement'-typos throughout the whole module, both in method-names as well as docs (long outstanding bug reported by Kenn Frankel ), 'get_entitities'-typo in Mail.pm docs fixed - Removed $^W++ even though it nicely revealed warnings raised in other modules (hehe...) v0.24 (Wed Nov 28 14:48:05 CET 2001) + mailboxes with DOSish line-endings (\015\012) can now also be parsed (Bill Moseley) v0.23 (Mon Nov 26 12:07:41 CET 2001) + bugfix in MboxParser.pm, last line of message sometimes ommited (Christian Wendt) + decoding of qp-encoded filenames for store_(all_)attachement(s) v0.22 (Tue Sep 20 13:23:38 CEST 2001) + new get_field method that returns a raw headerfield, so that even the "Received"-line is no longer lost (Kenn Frankel) v0.21 (Sun Sep 9 10:37:46 CEST 2001) + decoding is now pretty complete (whole header, body, quotes, signature) + split up the documentation to the respective modules + $obj->error and $obj->log is now correctly reseted on each method invokation v0.20 (Sat Sep 8 10:03:23 CEST 2001) + Mail::MboxParser::new() can now read from virtually anything (filename, filehandle, scalar/array-ref) + introduction of named parameters coming as key/value pairs + new class: Mail::MboxParser::Mail::Convertable + decoding of header-fields and body v0.17 (Sat Sep 1 08:36:59 CEST 2001) + new Mail::MboxParser::Mail::Body::quotes() method + some corrections in the PODs v0.16 (Tue Aug 28 11:56:17 CEST 2001) + 'make test' will no longer fail if URI::Find is not installed v0.15 (Mon Aug 27 08:30:18 CEST 2001) + an important change in indexing of MIME-parts: the message itself is now the entity with the index 0, as it should be. CHECK your scripts if you did a lot of MIME-stuff so that they reflect the changes + new class Mail::MboxParser::Mail::Body with methods for retrieving the signature and URLs from text v0.14 (Fri Aug 24 12:23:36 CEST 2001): + added an AUTOLOADer for Mail::MboxParser::Mail which will usually care that any methods inherited from MIME::Entity work (mostly) in the expected way nice side-effect: saves memory + overloading of " " for Mail::MboxParser::Mail + fixed some factually wrong documentation + finally a MANIFEST in the package v0.13 (Sat Aug 18 11:04:54 CEST 2001): + new to()-equivalent cc() + id() now also resets $mail->error as it should do + extended documentation for Mail::MboxParser::Mail + made Mail::MboxParser-docs more eye-friendly v0.12 (Fri Aug 17 08:35:15 CEST 2001): + new base-class Mail::MboxParser::Base + new methods $obj->error, $obj->log + Mail::MboxParser::Mail now extends MIME::Entity so $mail->effective_type and stuff should work + eventually using carp/croak instead of warn/die + removed a very unpleasant memory-leak which did not allow for a proper destruction of Mail::MboxParser objects, happened when doing something like: @mbs = map { Mail::MboxParser->new($_) } @mboxes; undef $mbs[0]; # etc... v0.11 (Mon Aug 13 17:52:22 CEST 2001): + new arguments for store_attachement and store_all_attachements so that filenames for saving can be dynamically assigned (suggestion by Angeline Koh ) + Mail::Box::SpamDetector class included but not yet properly working, hence not documented either v0.10 (Sun Aug 5 12:24:56 CEST 2001): + new method Mail::MboxParser::Mail->to + additional tests for the above v0.09 (Sat Aug 4 13:58:47 CEST 2001): + multi-line header-fields are now correctly reckognized (Kenn Frankel ) v0.08 (Wed Aug 1 09:58:18 CEST 2001): + $self->{ENTITY} now destroys itself once called, reduces mem-usage when MIME is processed + new test-suits + updated PODs v0.07 (Sun Jul 29 11:37:43 CEST 2001): + as the MIME stuff, headers are now only parsed on demand (40% less memory, 25% quicker under normal conditions) v0.06 (Sat Jul 28 09:46:35 CEST 2001): + on-demand parsing of entities by using closures -> performance-gain of at least 900% + rewinding of mailbox-filehandle, so a second call to get_messages will work v0.05 (Fri Jul 27 20:28:04 CEST 2001): + rework of the pattern-matching, should now be minimally quicker + nmsgs now compliant to RFC 822 + added little script isspam (undocumented) + this time the correct $VERSION !! v0.04 (Mon Jul 23 17:52:29 CEST 2001): + fixed wrong parsing of header lines if line contains a colon + increased reliability of get_entity_body v0.03 (Thu Jul 19 15:09:18 CEST 2001): + $mail->{HEADER} returning a string broke everything, fixed + added tests on install v0.02 (Fri Jul 6 08:04:34 CEST 2001): + $mail->{HEADER} now returns a string + eg-directory included in the package + now works on Perl >= 5.004 v0.01 (Thu Jul 5 08:19:40 CEST 2001): + upload to CPAN Mail-MboxParser-0.55/Makefile.PL0000644000175000017500000000241210346002752016575 0ustar ethanethan00000000000000use ExtUtils::MakeMaker; use constant MMMPARSER => eval { require Mail::Mbox::MessageParser; 1 } || 0; if (!MMMPARSER) { warn <VERSION < 0.13) { die < 'Tassilo v. Parseval 'Mail::MboxParser', PMLIBDIRS => ['MboxParser'], VERSION_FROM => 'MboxParser.pm', PREREQ_PM => { MIME::Tools => 5.0, MIME::QuotedPrint => 0, MIME::Base64 => 0, File::Temp => 0, }, DISTNAME => 'Mail-MboxParser', clean => { FILES => "t/cache" }, ); Mail-MboxParser-0.55/README0000644000175000017500000000221710346003363015505 0ustar ethanethan00000000000000Mail::MboxParser is a module for working with UNIX-flavoured mailboxes. This document describes version 0.55. Its purpose is to _easily_ extract messages from a mailbox with _simple_ access to header fields, body and MIME-parts. It is particularly easy to deal with any kind of attached files. See the supplied store_att.pl script for an example. Prerequisites: -------------- + MIME::Tools (probably >= 5.0) + MIME::QuotedPrint (don't know which version) optional: + Mail::Mbox::MessageParser (highly recommended but not necessary) + URI::Find if you want to use Mail::MboxParser::Mail::Body->extract_urls + Encode (standard module for >= perl5.8.0) Installation: ------------- Un'tar xfz' the module and 'cd' into the new directory Mail-MboxParser-$VERSION. Then install: perl Makefile.PL make make test make install Win-users having an 'nmake' installed can also do the above, given the fact they replace 'make' with 'nmake' in the above list. Contact: -------- Bugs, feature requests, questions, comments etc. should be directly mailed to me. Tassilo v. Parseval