Mail-Message-3.006/0000755000175000001440000000000013232126172014503 5ustar00markovusers00000000000000Mail-Message-3.006/t/0000755000175000001440000000000013232126172014746 5ustar00markovusers00000000000000Mail-Message-3.006/t/421msgconv-mimeent.t0000644000175000001440000000633413200571125020475 0ustar00markovusers00000000000000#!/usr/bin/env perl # # Test conversions between Mail::Message and MIME::Entity # # MIME::Parser::Filer produces msg-????-1.txt files in the # test directory :( # use strict; use warnings; use Mail::Message; use Mail::Message::Test; use Test::More; BEGIN { eval {require MIME::Entity}; if($@) { plan skip_all => "requires MIME::Entity."; exit 0; } require Mail::Message::Convert::MimeEntity; plan tests => 28; } my $me = MIME::Entity->build ( From => 'mailtools@overmeer.net' , To => 'the users' , Subject => 'use Mail::Box' , 'In-Reply-To' => '<023984hjlur29420@sruoiu.nl>' , 'X-Again' => 'repeating header' , 'X-Again' => 'repeating header again' , 'X-Again' => 'repeating header and again' , Data => [ ] ); close DATA; ok($me); my $convert = Mail::Message::Convert::MimeEntity->new; ok($convert); # # Convert MIME::Entity to Mail::Message # my $msg = $convert->from($me); ok($msg); my $head = $msg->head; ok($head); # MIME::Entity makes a mess on the headers: not usefull to test the # order of the returned. my @from = $head->get('From'); cmp_ok(@from, "==", 1); my @again = $head->get('X-again'); # cmp_ok(@again, "==", 3); # Should be 3, but bug in MIME::Entity cmp_ok(@again, "==", 1); # Wrong, but to check improvements in ME my $body = $msg->body; ok($body); my @lines = $body->lines; cmp_ok(@lines, "==", 6); is($lines[-1], "use it anymore!\n"); # # Convert message back to a MIME::Entity # my $back = $convert->export($msg); ok(defined $back); $head = $back->head; is($head->get('to'), "the users\n"); @from = $head->get('from'); cmp_ok(@from, "==", 1); @again = $head->get('x-again'); cmp_ok(@again, "==", 1); $body = $back->bodyhandle; ok($body); @lines = $body->as_lines; cmp_ok(@lines, "==", 6); $back->purge; $me->purge; # # and now: MULTIPARTS! Convert MIME::Entity to Mail::Message # $me = MIME::Entity->build ( From => 'me', To => 'you', Type => 'multipart/mixed' , Subject => 'Test mp conv' , Data => [ "Some\n", "Lines\n" ] ); $me->preamble( [ "Pre1\n", "Pre2\n" ]); $me->attach(Data => [ "First part\n" ] ); $me->attach(Data => [ "Second part\n" ] ); $me->epilogue( [ "Epi1\n", "Epi2\n" ]); $msg = $convert->from($me); ok(defined $msg); ok($msg->isMultipart); my @parts = $msg->parts; cmp_ok(@parts, "==", 2); isa_ok($msg, 'Mail::Message'); isa_ok($parts[0], 'Mail::Message::Part'); isa_ok($parts[1], 'Mail::Message::Part'); $body = $msg->body; cmp_ok($body->preamble->nrLines, "==", 2); cmp_ok($body->epilogue->nrLines, "==", 2); #$msg->print(\*STDERR); $me->purge; # # Convert MULTIPART message back to a MIME::Entity # $me = $convert->export($msg); #$me->print; isa_ok($me, 'MIME::Entity'); ok($me->is_multipart); @parts = $me->parts; cmp_ok(@parts, "==", 2); isa_ok($parts[0], 'MIME::Entity'); isa_ok($parts[1], 'MIME::Entity'); $me->purge; 1; __DATA__ MIME::Entity is written by Eriq, and extends Mail::Internet with many new capabilities, like multipart bodies. Actually, although it says to extend, it more or less reimplements most methods and conflicts with the other. Even the Mail::Internet constructor does not work: only the build() can be used to safely construct a message. Do not use it anymore! Mail-Message-3.006/t/420msgconv-mailint.t0000644000175000001440000000360113200571125020465 0ustar00markovusers00000000000000#!/usr/bin/env perl # # Test conversions between Mail::Internet and Mail::Message # use strict; use warnings; use Mail::Message; use Mail::Message::Test; use Mail::Message::Convert::MailInternet; use Test::More; BEGIN { eval {require Mail::Internet}; if($@) { warn "requires Mail::Internet.\n"; plan tests => 0; exit 0; } plan tests => 21; } my $mi = Mail::Internet->new(\*DATA); ok($mi); my $convert = Mail::Message::Convert::MailInternet->new; ok($convert); # # Convert Mail::Internet to Mail::Message # my $msg = $convert->from($mi); ok($msg); my $head = $msg->head; ok($head); my @fields = sort $head->names; cmp_ok(@fields, "==", 5); is($fields[0], 'again'); is($fields[1], 'from'); is($fields[2], 'in-reply-to'); is($fields[3], 'subject'); is($fields[4], 'to'); my @from = $head->get('from'); cmp_ok(@from, "==", 1); my @again = $head->get('again'); cmp_ok(@again, "==", 3); my $body = $msg->body; ok($body); my @lines = $body->lines; cmp_ok(@lines, "==", 6); is($lines[-1], "that.\n"); # # Convert message back to a Mail::Internet # my $back = $convert->export($msg); ok($back); $head = $back->head; @fields = $head->tags; cmp_ok(@fields, "==", 5); is($head->get('to'), "the users\n"); @from = $head->get('from'); cmp_ok(@from, "==", 1); @again = $head->get('again'); cmp_ok(@again, "==", 3); $body = $back->body; cmp_ok(@$body, "==", 6); 1; __DATA__ From: mailtools@overmeer.net To: the users Subject: use Mail::Box In-Reply-To: <023984hjlur29420@sruoiu.nl> Again: repeating header Again: repeating header again Again: repeating header and again Mail::Internet was conceived in 1995, or even earlier, and written by Graham Barr. At that time, e-mail was not very wide-spread (the beginning of WWW) and e-mails where not poluted by graphics. Attachments were even so rare that Mail::Internet cannot handle them: see MIME::Entity for that. Mail-Message-3.006/t/403msg-bounce.t0000644000175000001440000000326613200571125017425 0ustar00markovusers00000000000000#!/usr/bin/env perl # # Test the creation of bounce messages # use strict; use warnings; use Mail::Message; use Mail::Message::Test; use Mail::Message::Head; use Mail::Message::Body::Lines; use Mail::Message::Construct::Bounce; use Test::More tests => 2; use IO::Scalar; # # First produce a message to reply to. # my $head = Mail::Message::Head->build ( To => 'me@example.com (Me the receiver)' , From => 'him@somewhere.else.nl (Original Sender)' , Cc => 'the.rest@world.net' , Subject => 'Test of Bounce' , Date => 'Wed, 9 Feb 2000 15:44:05 -0500' , 'Content-Something' => 'something' ); my $body = Mail::Message::Body::Lines->new ( mime_type => 'text/plain' , data => <<'TEXT' First line of orig message. Another line of message. TEXT ); my $msg = Mail::Message->new(head => $head); $msg->body($body); ok(defined $msg); # # Create a bounce # my $bounce = $msg->bounce ( To => 'new@receivers.world' , From => 'I was between' , Received => 'by me' , Date => 'Fri, 7 Dec 2001 15:44:05 -0100' , 'Message-ID' => '' ); my $filedata; my $file = IO::Scalar->new(\$filedata); $bounce->print($file); compare_message_prints($filedata, <<'EXPECTED', 'bounce print') To: me@example.com (Me the receiver) From: him@somewhere.else.nl (Original Sender) Cc: the.rest@world.net Subject: Test of Bounce Date: Wed, 9 Feb 2000 15:44:05 -0500 Content-Something: something Content-Type: text/plain; charset="utf-8" Content-Transfer-Encoding: 8bit Received: by me Resent-Date: Fri, 7 Dec 2001 15:44:05 -0100 Resent-From: I was between Resent-To: new@receivers.world Resent-Message-ID: First line of orig message. Another line of message. EXPECTED Mail-Message-3.006/t/310encode-base64.t0000644000175000001440000000233113200571125017672 0ustar00markovusers00000000000000#!/usr/bin/env perl # # Encoding and Decoding of Base64 # Could use some more tests.... # use strict; use warnings; use Mail::Message::Test; use Mail::Message::Body::Lines; use Mail::Message::TransferEnc::Base64; use Test::More tests => 11; my $decoded = <new; ok(defined $codec); is($codec->name, 'base64'); # Test encoding my $body = Mail::Message::Body::Lines->new ( mime_type => 'text/html' , data => $decoded ); is($body->mimeType, 'text/html'); my $enc = $codec->encode($body); ok($body!=$enc); is($enc->mimeType, 'text/html'); is($enc->transferEncoding, 'base64'); is($enc->string, $encoded); # Test decoding $body = Mail::Message::Body::Lines->new ( transfer_encoding => 'base64' , mime_type => 'text/html' , data => $encoded ); my $dec = $codec->decode($body); ok($dec!=$body); is($enc->mimeType, 'text/html'); is($dec->transferEncoding, 'none'); is($dec->string, $decoded); Mail-Message-3.006/t/400msg-stripsig.t0000644000175000001440000000570013200571125020006 0ustar00markovusers00000000000000#!/usr/bin/env perl # # Test stripping signatures # use strict; use warnings; use Mail::Message::Test; use Mail::Message::Body::Construct; use Mail::Message::Body; use Test::More tests => 37; # # No strip possible # my @lines = map { "$_\n" } qw/1 2 3 4 5/; my $body = Mail::Message::Body::Lines->new(data => \@lines); my ($stripped, $sig) = $body->stripSignature; my $equal = $stripped==$body; ok($equal, 'stripped 1'); ok(!defined $sig); cmp_ok($stripped->nrLines, "==", @lines); my $stripped2 = $body->stripSignature; $equal = $stripped2==$body; ok($equal, 'stripped 2'); # # Simple strip # @lines = map { "$_\n" } qw(a b -- sig); $body = Mail::Message::Body::Lines->new(data => \@lines); ($stripped, $sig) = $body->stripSignature; ok($stripped!=$body); ok($sig!=$body); cmp_ok($stripped->nrLines, "==", 2); my @stripped_lines = $stripped->lines; cmp_ok(@stripped_lines, "==", 2); is($stripped_lines[0], $lines[0]); is($stripped_lines[1], $lines[1]); cmp_ok($sig->nrLines, "==", 2); my @sig_lines = $sig->lines; cmp_ok(@sig_lines, "==", 2); is($sig_lines[0], $lines[2]); is($sig_lines[1], $lines[3]); # # Try signature too large # @lines = map { "$_\n" } qw/1 2 3 -- 4 5 6 7 8 9 10/; $body = Mail::Message::Body::Lines->new(data => \@lines); ($stripped, $sig) = $body->stripSignature(max_lines => 7); ok(!defined $sig); cmp_ok($stripped->nrLines, "==", 11); ($stripped, $sig) = $body->stripSignature(max_lines => 8); cmp_ok($sig->nrLines, "==", 8); @sig_lines = $sig->lines; cmp_ok(@sig_lines, "==", 8); is($sig_lines[0], $lines[3]); is($sig_lines[1], $lines[4]); is($sig_lines[-1], $lines[-1]); cmp_ok($stripped->nrLines, "==", 3); @stripped_lines = $stripped->lines; cmp_ok(@stripped_lines, "==", 3); is($stripped_lines[0], $lines[0]); is($stripped_lines[1], $lines[1]); is($stripped_lines[2], $lines[2]); # # Try whole body is signature # @lines = map { "$_\n" } qw/-- 1 2 3 4/; $body = Mail::Message::Body::Lines->new(data => \@lines); ($stripped, $sig) = $body->stripSignature(max_lines => 7); cmp_ok($sig->nrLines , "==", 5); ok(defined $stripped); cmp_ok($stripped->nrLines , "==", 0); # # Try string to find sep # @lines = map { "$_\n" } qw/1 2 3 abc 4 5 6/; $body = Mail::Message::Body::Lines->new(data => \@lines); ($stripped, $sig) = $body->stripSignature(pattern => 'b'); ok(!defined $sig); ($stripped, $sig) = $body->stripSignature(pattern => 'a'); cmp_ok($sig->nrLines , "==", 4); # # Try regexp to find sep # @lines = map { "$_\n" } qw/1 2 3 abba baab 4 5 6/; $body = Mail::Message::Body::Lines->new(data => \@lines); ($stripped, $sig) = $body->stripSignature(pattern => qr/b{2}/); ok($sig); cmp_ok($sig->nrLines , "==", 5); cmp_ok($stripped->nrLines , "==", 3); # # Try code to find sep # @lines = map { "$_\n" } qw/1 2 3 ab 4 5 6/; $body = Mail::Message::Body::Lines->new(data => \@lines); ($stripped, $sig) = $body->stripSignature(pattern => sub {$_[0] eq "ab\n"}); ok($sig); cmp_ok($sig->nrLines , "==", 4); cmp_ok($stripped->nrLines , "==", 3); Mail-Message-3.006/t/323bodyconv-htmltxt.t0000644000175000001440000000276413200571125020716 0ustar00markovusers00000000000000#!/usr/bin/env perl # # Test conversions from HTML/XHTML to plain text with HTML::FormatText # use strict; use warnings; use Mail::Message::Test; use Mail::Message::Body::Lines; use Test::More; BEGIN { eval 'require HTML::FormatText'; if($@) { plan skip_all => "requires HTML::FormatText.\n"; exit 0; } require Mail::Message::Convert::HtmlFormatText; plan tests => 7; } my $html = Mail::Message::Convert::HtmlFormatText->new; my $body = Mail::Message::Body::Lines->new ( type => 'text/html' , data => $raw_html_data ); my $f = $html->format($body); ok(defined $f); ok(ref $f); isa_ok($f, 'Mail::Message::Body'); is($f->mimeType, 'text/plain'); is($f->charset, 'iso-8859-1'); is($f->transferEncoding, 'none'); is($f->string, <<'EXPECTED'); Life according to Brian ======================= This is normal text, but not in a paragraph. New paragraph in a bad way. And this is just a continuation. When texts get long, they must be auto-wrapped; and even that is working already. Silly subsection at once and another chapter =================== again a section --------------- Normal paragraph, which contains an [IMAGE], some italics with linebreak and code And now for the preformatted stuff it should stay as it was even with strange blanks and indentations And back to normal text... * list item 1 1. list item 1.1 2. list item 1.2 * list item 2 EXPECTED exit 0; Mail-Message-3.006/t/313encode-seven.t0000644000175000001440000000142513200571125017734 0ustar00markovusers00000000000000#!/usr/bin/env perl # # Encoding and Decoding of 7bit # use strict; use warnings; use Mail::Message::Test; use Mail::Message::Body::Lines; use Mail::Message::TransferEnc::SevenBit; use Test::More tests => 6; my $decoded = <new; ok(defined $codec); is($codec->name, '7bit'); # Test encoding my $body = Mail::Message::Body::Lines->new ( mime_type => 'text/html' , data => $decoded ); my $enc = $codec->encode($body); ok($body!=$enc); is($enc->mimeType, 'text/html'); is($enc->transferEncoding, '7bit'); is($enc->string, $encoded); # Test decoding Mail-Message-3.006/t/321bodyconv-html.t0000644000175000001440000000706713200571125020155 0ustar00markovusers00000000000000#!/usr/bin/env perl # # Test conversions as HTML/XHTML without help of external modules # use strict; use warnings; use Mail::Message; use Mail::Message::Test; use Mail::Message::Head::Complete; use Mail::Message::Field::Fast; use Mail::Message::Convert::Html; use Test::More tests => 7; my $html = Mail::Message::Convert::Html->new; my $xhtml = Mail::Message::Convert::Html->new(produce => 'XHTML'); # # test fieldToHtml # my $to = Mail::Message::Field::Fast->new(To => 'me@example.com (Mark Overmeer)'); is($html->fieldToHtml($to), 'To: me@example.com (Mark Overmeer)'); my $to2 = Mail::Message::Field::Fast->new('reply-to' => 'me@example.com, you@tux.aq'); is($html->fieldToHtml($to2), 'Reply-To: me@example.com, you@tux.aq'); # # test headToHtmlTable # my $head = Mail::Message::Head::Complete->new; $head->add(To => 'me@example.com (Mark Overmeer)'); $head->add(From => 'you@tux.aq, john.doe@some.where.else (Doe, John)'); $head->add('X-Sender' => 'Mail::Box software cooperation'); $head->add(Subject => 'No e-mail@at.this.line'); my $table_dump = <<'TABLE-DUMP'; "50%">
To: me@example.com (Mark Overmeer)
From: you@tux.aq, john.doe@some.where.else (Doe, John)
Subject: No e-mail@at.this.line
TABLE-DUMP my $table = $html->headToHtmlTable($head, 'width=>"50%"'); is($table, $table_dump); my $xtable = $xhtml->headToHtmlTable($head, 'width=>"50%"'); is($xtable, $table_dump); # # test headToHtmlHead # my $html_head_dump = <<'HTML_HEAD_DUMP'; No e-mail@at.this.line HTML_HEAD_DUMP my $html_head = $html->headToHtmlHead($head); is($html_head, $html_head_dump); (my $xhtml_head_dump = $html_head_dump) =~ s!"\>!" />!g; my $xhtml_head = $xhtml->headToHtmlHead($head); is($xhtml_head, $xhtml_head_dump); $html_head = $html->headToHtmlHead ( $head , title => 'Title, not subject' , keywords => 'html tags like < and >, & and ", must be encoded' ); $html_head_dump = <<'HTML_HEAD_DUMP'; Title, not subject HTML_HEAD_DUMP is($html_head, $html_head_dump); $html_head = $html->headToHtmlHead ( $head , title => 'Title, not subject' , keywords => 'html tags' , subject => '' , extra => 'new one' , TO => 'overrule' ); $html_head_dump = <<'HTML_HEAD_DUMP'; Title, not subject HTML_HEAD_DUMP exit 0; Mail-Message-3.006/t/101field-fast.t0000644000175000001440000001142513200571125017373 0ustar00markovusers00000000000000#!/usr/bin/env perl # # Test processing of header-fields with Mail::Message::Field::Fast. # Only single fields, not whole headers. This also doesn't cover reading # headers from file. # use strict; use warnings; use Mail::Message::Test; use Mail::Message::Field::Fast; use Test::More tests => 72; use Mail::Address; # # Processing unstructured lines. # my $a = Mail::Message::Field::Fast->new('A: B ; C'); is($a->name, 'a'); is($a->body, 'B ; C'); ok(not defined $a->comment); # No folding permitted. my $b1 = ' B ; C234290iwfjoj w etuwou toiwutoi'; my $b2 = ' wtwoetuw oiurotu 3 ouwout 2 oueotu2'; my $b3 = ' fqweortu3'; my $bbody = "$b1$b2$b3"; my $b = Mail::Message::Field::Fast->new("A: $bbody"); my @lines = $b->toString(100); cmp_ok(@lines, '==', 1); is($lines[0], "A:$bbody\n"); @lines = $b->toString(42); cmp_ok(@lines, '==', 3); is($lines[0], "A:$b1\n"); is($lines[1], "$b2\n"); is($lines[2], "$b3\n"); is(' '.$b->body, $bbody); # # Processing of structured lines. # my $f = Mail::Message::Field::Fast->new('Sender: B ; C'); ok($f->isStructured); is($f->name, 'sender'); is($f->body, 'B'); is($f, 'B ; C'); is($f->comment, 'C'); # No comment, strip CR LF my $g = Mail::Message::Field::Fast->new("Sender: B\015\012\n"); is($g->body, 'B'); is($g->comment, ''); # Separate head and body. my $h = Mail::Message::Field::Fast->new("Sender", "B\015\012\n"); is($h->body, 'B'); is($h->comment, ''); my $i = Mail::Message::Field::Fast->new('Sender', 'B ; C'); is($i->name, 'sender'); is($i->body, 'B'); like($i->comment, qr/^\s*C\s*/); my $j = Mail::Message::Field::Fast->new('Sender', 'B', 'C'); is($j->name, 'sender'); is($j->body, 'B'); like($j->comment, qr/^\s*C\s*/); # Check toString (for unstructured field, so no folding) my $k = Mail::Message::Field::Fast->new(A => 'short line'); is($k->toString, "A: short line\n"); my @klines = $k->toString; cmp_ok(@klines, '==', 1); my $l = Mail::Message::Field::Fast->new(A => 'oijfjslkgjhius2rehtpo2uwpefnwlsjfh2oireuqfqlkhfjowtropqhflksjhflkjhoiewurpq'); my @llines = $k->toString; cmp_ok(@llines, '==', 1); my $m = Mail::Message::Field::Fast->new(A => 'roijfjslkgjhiu, rehtpo2uwpe, fnwlsjfh2oire, uqfqlkhfjowtrop, qhflksjhflkj, hoiewurpq'); my @mlines = $m->toString; cmp_ok(@mlines, '==', 2); is($mlines[1], " hoiewurpq\n"); my $n = Mail::Message::Field::Fast->new(A => 7); my $x = $n + 0; ok($n ? 1 : 0); ok($x==7); ok($n > 6); ok($n < 8); cmp_ok($n, '==', 7); ok(6 < $n); ok(8 > $n); # # Check gluing addresses # my @mb = Mail::Address->parse('me@localhost, you@somewhere.nl'); cmp_ok(scalar @mb, '==', 2); my $r = Mail::Message::Field::Fast->new(Cc => $mb[0]); is($r->toString, "Cc: me\@localhost\n"); $r = Mail::Message::Field::Fast->new(Cc => \@mb); is($r->toString, "Cc: me\@localhost, you\@somewhere.nl\n"); my $r2 = Mail::Message::Field::Fast->new(Bcc => $r); is($r2->toString, "Bcc: me\@localhost, you\@somewhere.nl\n"); # # Checking attributes # my $charset = 'iso-8859-1'; my $comment = qq(charset="iso-8859-1"; format=flowed); my $p = Mail::Message::Field::Fast->new("Content-Type: text/plain; $comment"); is($p->comment, $comment); is($p->body, 'text/plain'); is($p->attribute('charset'), $charset); is($p->attribute('format'), 'flowed'); ok(!defined $p->attribute('boundary')); is($p->attribute(charset => 'us-ascii'), 'us-ascii'); is($p->attribute('charset'), 'us-ascii'); is($p->comment, 'charset="us-ascii"; format=flowed'); is($p->attribute(format => 'newform'), 'newform'); is($p->comment, 'charset="us-ascii"; format="newform"'); is($p->attribute(newfield => 'bull'), 'bull'); is($p->attribute('newfield'), 'bull'); is($p->comment, 'charset="us-ascii"; format="newform"; newfield="bull"'); my %attrs = $p->attributes; cmp_ok(keys %attrs, '==', 3, "list of attributes"); is($attrs{charset}, 'us-ascii'); is($attrs{format}, 'newform'); is($attrs{newfield}, 'bull'); my $q = Mail::Message::Field::Fast->new('Content-Type: text/plain'); is($q->toString, "Content-Type: text/plain\n"); is($q->attribute(charset => 'iso-10646'), 'iso-10646'); is($q->attribute('charset'), 'iso-10646'); is($q->comment, 'charset="iso-10646"'); is($q->toString, qq(Content-Type: text/plain; charset="iso-10646"\n)); # # Check preferred capitization of Labels # my @tests = ( 'Content-Transfer-Encoding' => 'Content-Transfer-Encoding' , 'content-transfer-encoding' => 'Content-Transfer-Encoding' , 'CONTENT-TRANSFER-ENCODING' => 'Content-Transfer-Encoding' , 'cONTENT-tRANSFER-eNCODING' => 'Content-Transfer-Encoding' , 'mime-version' => 'MIME-Version' , 'MIME-VERSION' => 'MIME-Version' , 'Mime-vERSION' => 'MIME-Version' , 'src-label' => 'SRC-Label' , 'my-src-label' => 'My-SRC-Label' ); while(@tests) { my ($from, $to) = (shift @tests, shift @tests); is(Mail::Message::Field->wellformedName($from), $to); } Mail-Message-3.006/t/200head-create.t0000644000175000001440000000375513200571125017526 0ustar00markovusers00000000000000#!/usr/bin/env perl # # Test the processing of a whole message header, not the reading of a # header from file. # use strict; use warnings; use Mail::Message::Test; use Mail::Message::Head::Complete; use Test::More tests => 25; use IO::Scalar; my $h = Mail::Message::Head::Complete->new; { my @o = $h->names; cmp_ok(scalar @o, '==', 0); } # Adding a first. { my $a = $h->add(From => 'me@home'); ok(ref $a); isa_ok($a, 'Mail::Message::Field'); } { my @o = $h->names; cmp_ok(@o, '==', 1); } { my @f = $h->get('From'); # list context cmp_ok(@f, '==', 1); ok(ref $f[0]); isa_ok($f[0], 'Mail::Message::Field'); is($f[0]->body, 'me@home'); } { my $f = $h->get('From'); # scalar context is($f->body, 'me@home'); } # Adding a second. $h->add(From => 'you2me'); { my @o = $h->names; cmp_ok(@o, '==', 1); } { my @f = $h->get('From'); # list context cmp_ok(@f, '==', 2); is($f[0]->body, 'me@home'); is($f[1]->body, 'you2me'); } { my $f = $h->get('From'); # scalar context is($f->body, 'you2me'); } # Missing { my @f = $h->get('unknown'); cmp_ok(@f, '==', 0); } { my $f = $h->get('unknown'); ok(! defined $f); } # Set { $h->set(From => 'perl'); my @f = $h->get('From'); cmp_ok(@f, '==', 1); } { my @o = $h->names; cmp_ok(@o, '==', 1); } $h->set(New => 'test'); { my @o = sort $h->names; cmp_ok(@o, '==', 2); is($o[0], 'from'); is($o[1], 'new'); } # Reset $h->reset('From'); { my @f = $h->get('From'); cmp_ok(@f, '==', 0); } { my $l = Mail::Message::Field->new(New => 'other'); $h->reset('NEW', $h->get('new'), $l); } { my @f = $h->get('neW'); cmp_ok(@f, '==', 2); } # Print $h->add(Subject => 'hallo!'); $h->add(To => 'the world'); $h->add(From => 'me'); my $output; my $fakefile = new IO::Scalar \$output; $h->print($fakefile, 0); my $expected = <<'EXPECTED_OUTPUT'; New: test New: other Subject: hallo! To: the world From: me EXPECTED_OUTPUT is($output, $expected); is($h->toString, $expected); $fakefile->close; Mail-Message-3.006/t/202head-resentgroup.t0000644000175000001440000000554113200571125020635 0ustar00markovusers00000000000000#!/usr/bin/env perl # # Test the processing of resent groups. # use strict; use warnings; use Mail::Message::Test; use Mail::Message::Head::ResentGroup; use Mail::Message::Head::Complete; use Test::More tests => 26; use IO::Scalar; # # Creation of a group # my $h = Mail::Message::Head::Complete->new; ok(defined $h); my $rg = Mail::Message::Head::ResentGroup->new ( head => $h , From => 'the.rg.group@example.com' , Received => 'obligatory field' ); ok(defined $rg); isa_ok($rg, 'Mail::Message::Head::ResentGroup'); my @fn = $rg->fieldNames; cmp_ok(scalar(@fn), '==', 2, "Two fields"); is($fn[0], 'Received'); is($fn[1], 'Resent-From'); { my $from = $rg->from; ok(ref $from); isa_ok($from, 'Mail::Message::Field'); is($from->name, 'resent-from'); } # # Interaction with a header # $h->add(From => 'me'); $h->add(To => 'you'); $h->addResentGroup($rg); { my $output; my $fh = IO::Scalar->new(\$output); $h->print($fh); $fh->close; is($output, <<'EXPECTED'); From: me To: you Received: obligatory field Resent-From: the.rg.group@example.com EXPECTED } my $rg2 = $h->addResentGroup ( Received => 'now or never' , Cc => 'cc to everyone' , Bcc => 'undisclosed' , 'Return-Path' => 'Appears before everything else' , 'Message-ID' => '' , Sender => 'do not believe it' , From => 'should be added' , To => 'just to check every single field' ); ok(defined $rg2); ok(ref $rg2); isa_ok($rg2, 'Mail::Message::Head::ResentGroup'); { my $output; my $fh = IO::Scalar->new(\$output); $h->print($fh); $fh->close; is($output, <<'EXPECTED'); From: me To: you Return-Path: Appears before everything else Received: now or never Resent-From: should be added Resent-Sender: do not believe it Resent-To: just to check every single field Resent-Cc: cc to everyone Resent-Bcc: undisclosed Resent-Message-ID: Received: obligatory field Resent-From: the.rg.group@example.com EXPECTED } my $h2 = $h->clone; ok(defined $h2); isa_ok($h2, 'Mail::Message::Head::Complete'); { my @rgs = $h2->resentGroups; cmp_ok(@rgs, '==', 2); ok(defined $rgs[0]); ok(ref $rgs[0]); ok($rgs[0]->isa('Mail::Message::Head::ResentGroup')); my $rg1 = $rgs[0]; is($rg1->messageId, ''); my @of = $rg1->orderedFields; cmp_ok(@of, '==', 8); @of = $rgs[1]->orderedFields; cmp_ok(@of, '==', 2); # Now delete, and close scope to avoid accidental reference to # fields which should get cleaned-up. $rgs[0]->delete; } { my @rgs = $h2->resentGroups; cmp_ok(@rgs, '==', 1); my @of = $rgs[0]->orderedFields; cmp_ok(@of, '==', 2); my $output; my $fh = IO::Scalar->new(\$output); $h2->print($fh); $fh->close; is($output, <<'EXPECTED'); From: me To: you Received: obligatory field Resent-From: the.rg.group@example.com EXPECTED } Mail-Message-3.006/t/010reporter-errors.t0000644000175000001440000000456213200571125020534 0ustar00markovusers00000000000000#!/usr/bin/env perl # # Test producing warnings, errors and family. # use strict; use warnings; use Mail::Reporter; use Mail::Message::Test; use Test::More tests => 41; # # Dualvar logPriority # my $a = Mail::Reporter->logPriority('WARNING'); ok(defined $a); ok($a == 4); is($a, 'WARNING'); my $b = Mail::Reporter->logPriority('WARNINGS'); ok(defined $b); ok($b == 4); is($b, 'WARNING'); my $c = Mail::Reporter->logPriority(4); ok(defined $c); ok($c == 4); is($c, 'WARNING'); my $d = Mail::Reporter->logPriority('AAP'); ok(!defined $d); my $e = Mail::Reporter->logPriority(8); ok(!defined $e); # # Initial default trace # my ($l, $t) = Mail::Reporter->defaultTrace; ok(defined $l); ok(defined $t); is($l, 'WARNING', 'string log level'); cmp_ok($l, '==', 4, 'numeric log level'); is($t, 'WARNING', 'string trace level'); cmp_ok($t, '==', 4, 'string trace level'); # # Set default trace # ($l, $t) = Mail::Reporter->defaultTrace('DEBUG', 'ERRORS'); ok(defined $l); ok(defined $t); is($l, 'DEBUG', 'string log level'); cmp_ok($l, '==', 1, 'numeric log level'); is($t, 'ERROR', 'string trace level'); cmp_ok($t, '==', 5, 'string trace level'); ($l, $t) = Mail::Reporter->defaultTrace('PROGRESS'); is($l, 'PROGRESS', 'string log level'); cmp_ok($l, '==', 3, 'numeric log level'); is($t, 'PROGRESS', 'string trace level'); cmp_ok($t, '==', 3, 'string trace level'); ($l, $t) = Mail::Reporter->defaultTrace('WARNING', 'WARNINGS'); is($l, 'WARNING', 'string log level'); cmp_ok($l, '==', 4, 'numeric log level'); is($t, 'WARNING', 'string trace level'); cmp_ok($t, '==', 4, 'string trace level'); # # Reporting levels based on objects # my $rep = Mail::Reporter->new; ok(defined $rep); is($rep->log, 'WARNING', 'Default log-level'); cmp_ok($rep->log, '==', 4); $l = $rep->log; is($l, 'WARNING', 'Default log-level'); cmp_ok($l, '==', 4); is($rep->trace, 'WARNING', 'Default trace-level'); cmp_ok($rep->trace, '==', 4); $t = $rep->trace; is($t, 'WARNING', 'Default trace-level'); cmp_ok($t, '==', 4); cmp_ok($rep->trace('ERROR'), '==', 5, 'Check error level numbers'); Mail-Message-3.006/t/406msg-rebuild.t0000644000175000001440000001753113200571125017603 0ustar00markovusers00000000000000#!/usr/bin/env perl # # Test rebuilding existing messages # use strict; use warnings; use Mail::Message; use Mail::Message::Test; use Mail::Message::Construct::Rebuild; use Test::More; my $has_htmlFormatText; BEGIN { eval "require Mail::Message::Convert::HtmlFormatText"; $has_htmlFormatText = not $@; plan tests => 55 + ($has_htmlFormatText ? 6 : 1); } # # First, produce a single level multipart message to rebuild # my $message = Mail::Message->build ( To => 'me@example.com (Me the receiver)' , From => 'him@somewhere.else.nl (Original Sender)' , Subject => 'Test of rebuild' , Date => 'Wed, 9 Feb 2000 15:44:05 -0500' , data => "part 1\n" , data => "part 2\n" ); ok(defined $message, "build success"); ok($message->isMultipart, "have a multipart"); cmp_ok($message->parts, '==', 2, "have two parts"); # # Test the deletion of parts in a 1 level multipart # my $rebuild = $message->rebuild; ok(defined $rebuild, "rebuild success"); ok($rebuild==$message, "message unchanged"); my $part = $message->body->part(0); $part->delete; ok($part->isDeleted, "delete first part"); # test to keep level with one multipart $rebuild = $message->rebuild( rules => [ qw/removeDeletedParts descendMultiparts/ ]); ok(defined $rebuild, "rebuild success"); ok($rebuild!=$message, "message has changed"); ok($rebuild->isMultipart, "still has a multipart"); cmp_ok($rebuild->body->parts, '==', 1, "has only one part left"); cmp_ok($message->body->parts, '==', 2, "original still has two parts"); is($rebuild->body->mimeType, 'multipart/mixed'); # test remove multipart level when only one is left $rebuild = $message->rebuild ( extraRules => [ qw/removeDeletedParts removeEmptyMultiparts/ ] ); ok(defined $rebuild, "rebuild success"); ok($rebuild!=$message, "message has changed"); ok(! $rebuild->isMultipart, "multipart level removed"); cmp_ok($message->body->parts, '==', 2, "original still has two parts"); is($rebuild->body->string, "part 2\n", "text found"); is($rebuild->body->mimeType, 'text/plain'); # test remove all parts, which will remove level $part = $message->body->part(1); $part->delete; ok($part->isDeleted, "delete second part as well"); $rebuild = $message->rebuild ( extraRules => [ qw/removeDeletedParts removeEmptyMultiparts/ ] ); ok(!$rebuild->isMultipart, "rebuild nothing left"); like($rebuild->decoded, qr/did not contain any parts/, 'added warning'); # # Now, we play around with a nested message # $message->body->part(0)->deleted(0); $message->body->part(1)->deleted(0); my $nested = Mail::Message::Body::Nested->new ( nested => $message ); my $message2 = Mail::Message->buildFromBody ( $nested , To => 'me@example.com (Me the receiver)' , From => 'him@somewhere.else.nl (Original Sender)' , Subject => 'Test of rebuild' , Date => 'Wed, 9 Feb 2000 15:44:05 -0500' ); ok(defined $message2, "succesfully build the message2"); ok($message2->isNested, "succesfully build the nested message2"); ok($message2->body->nested->isMultipart, "a multipart within the nested"); $rebuild = $message2->rebuild ( extraRules => [ qw/removeDeletedParts removeEmptyMultiparts/ ] ); ok($rebuild==$message2, "message2 unchanged"); # only remove the wrapper $rebuild = $message2->rebuild( extraRules => [ 'flattenNesting' ] ); ok(defined $rebuild, "rebuilding message2 success"); ok($rebuild!=$message2, "message has changed"); ok($rebuild->isMultipart, "wrapper removed, multipart visible"); cmp_ok($rebuild->parts, '==', 2, "both parts are present"); # remove one part of the multipart, leaving everything else unchanged $message2->body->nested->body->part(0)->delete; $rebuild = $message2->rebuild ( rules => [ qw/removeDeletedParts descendMultiparts descendNested/ ] ); ok(defined $rebuild, "rebuilding from message2 success"); ok($rebuild!=$message2, "message has changed"); isa_ok($rebuild->body, 'Mail::Message::Body::Nested'); ok($rebuild->body->nested->isMultipart, "still has a multipart"); cmp_ok($rebuild->body->nested->body->parts, '==', 1, "has only one part left"); cmp_ok($message2->body->nested->body->parts, '==', 2, "original still has two parts"); # have the multipart level to disappear $rebuild = $message2->rebuild ( extraRules => [ qw/removeDeletedParts removeEmptyMultiparts flattenMultiparts/ ] ); ok(defined $rebuild, "rebuilding message2 without multipart success"); ok($rebuild!=$message2, "message has changed"); isa_ok($rebuild->body, 'Mail::Message::Body::Nested'); ok(! $rebuild->body->nested->isMultipart, "multipart removed"); cmp_ok($message2->body->nested->body->parts, '==', 2, "original still has two parts"); is($rebuild->body->nested->body->string, "part 2\n", "text found in message2"); # Now delete the second multipart thing as welll. $message2->body->nested->body->part(1)->delete; $rebuild = $message2->rebuild ( extraRules => [ qw/removeDeletedParts removeEmptyMultiparts flattenMultiparts/ ] ); ok(!$rebuild->isMultipart, "whole structure collapsed"); like($rebuild->decoded, qr/did not contain any parts/, 'added warning'); # # More complex rules # Create an text/plain -- text/html multipart/alternative # and then automatically remove the html alternative. my $alttext = Mail::Message::Body->new(data => "text version\n"); my $althtml = Mail::Message::Body->new ( mime_type => 'text/html' , data => "html version\n" ); my $altmp = Mail::Message::Body::Multipart->new ( mime_type => 'multipart/alternative' , parts => [ $althtml, $alttext ] ); my $alt = Mail::Message->buildFromBody($altmp, To => 'you'); ok(defined $alt, "Succesfully created an alternative"); $rebuild = $alt->rebuild; ok($rebuild==$alt, "No rule matches by default"); $rebuild = $alt->rebuild(rules => [ 'textAlternativeForHtml']); ok($rebuild==$alt, "Already has alternative"); $rebuild = $alt->rebuild ( rules => [ qw/removeHtmlAlternativeToText descendMultiparts/ ] ); ok($rebuild!=$alt, "alt must change"); ok($rebuild->isMultipart, "alt still a multipart"); cmp_ok($rebuild->body->parts, '==', 1,"only one alternative left"); is($rebuild->body->part(0)->body->mimeType, 'text/plain' , "only text alternative survived"); # now include multipart flattening $rebuild = $alt->rebuild ( rules => [ qw/removeHtmlAlternativeToText descendMultiparts flattenMultiparts/ ] ); ok($rebuild!=$alt, "flattened alt must change"); ok(!$rebuild->isMultipart, "alt is not a multipart anymore"); is($rebuild->body->mimeType,'text/plain', "text body"); # # Create an html message, and have this translated into a # multipart with text alternative. # my $html = Mail::Message::Body->new(mime_type => 'text/html', data => <

Hi there

this is it

HTML $message = Mail::Message->buildFromBody($html, To => 'you', Subject => 'hi!'); ok(defined $message, "created html message"); $rebuild = $message->rebuild( rules => [ qw/textAlternativeForHtml/ ] ); # even if htmlFromText does not work, something must be returned ok(defined $rebuild, "rebuild with html->text succesful"); if($has_htmlFormatText) { ok($rebuild!=$message, "rebuild has changed it"); ok($rebuild->isMultipart, "Changed into multipart"); my @parts = $rebuild->parts; is($parts[0]->body->mimeType, 'text/plain', "Found plain text"); is($parts[1]->body->mimeType, 'text/html', "Found html"); is($rebuild->subject, 'hi!', "Subject to main message"); ok(! $parts[1]->get('subject'), "removed subject from html"); } else { ok($rebuild==$message, "rebuild has not changed it"); } Mail-Message-3.006/t/501parser-readmp.t0000644000175000001440000000555013200571125020125 0ustar00markovusers00000000000000#!/usr/bin/env perl # # Test the reading from file of message bodies which are multiparts # use strict; use warnings; use Mail::Message; use Mail::Message::Test; use Test::More tests => 66; use IO::File; # # From scalar # my $msg1 = Mail::Message->read("Subject: hello world\n\nbody1\nbody2\n"); ok(defined $msg1); is(ref $msg1, 'Mail::Message'); ok(defined $msg1->head); isa_ok($msg1->head, 'Mail::Message::Head'); my $body1 = $msg1->body; ok(defined $body1); isa_ok($body1, 'Mail::Message::Body'); ok(!$body1->isDelayed); cmp_ok(@$body1, "==", 2); is($body1->[0], "body1\n"); is($body1->[1], "body2\n"); is($msg1->subject, 'hello world'); ok($msg1->messageId); ok($msg1->get('message-id')); # # From ref scalar # my $scalar = "Subject: hello world\n\nbody1\nbody2\n"; my $msg2 = Mail::Message->read(\$scalar); ok(defined $msg2); is(ref $msg2, 'Mail::Message'); ok(defined $msg2->head); isa_ok($msg2->head, 'Mail::Message::Head'); my $body2 = $msg2->body; ok(defined $body2); isa_ok($body2, 'Mail::Message::Body'); ok(!$body2->isDelayed); cmp_ok(@$body2, "==", 2); is($body2->[0], "body1\n"); is($body2->[1], "body2\n"); is($msg2->subject, 'hello world'); ok($msg2->messageId); ok($msg2->get('message-id')); # # From array # my $array = [ "Subject: hello world\n", "\n", "body1\n", "body2\n" ]; my $msg3 = Mail::Message->read($array); ok(defined $msg3); is(ref $msg3, 'Mail::Message'); ok(defined $msg3->head); isa_ok($msg3->head, 'Mail::Message::Head'); my $body3 = $msg3->body; ok(defined $body3); isa_ok($body3, 'Mail::Message::Body'); ok(!$body3->isDelayed); cmp_ok(@$body3, "==", 2); is($body3->[0], "body1\n"); is($body3->[1], "body2\n"); is($msg3->subject, 'hello world'); ok($msg3->messageId); ok($msg3->get('message-id')); # # From file glob # open OUT, '>', 'tmp' or die $!; print OUT $scalar; close OUT; open IN, '<', 'tmp' or die $!; my $msg4 = Mail::Message->read(\*IN); close IN; ok(defined $msg4); is(ref $msg4, 'Mail::Message'); ok(defined $msg4->head); isa_ok($msg4->head, 'Mail::Message::Head'); my $body4 = $msg4->body; ok(defined $body4); isa_ok($body4, 'Mail::Message::Body'); ok(!$body4->isDelayed); cmp_ok(@$body4, "==", 2); is($body4->[0], "body1\n"); is($body4->[1], "body2\n"); is($msg4->subject, 'hello world'); ok($msg4->messageId); ok($msg4->get('message-id')); # # From file handle # open OUT, '>', 'tmp' or die $!; print OUT $scalar; close OUT; my $in = IO::File->new('tmp', 'r'); ok(defined $in); my $msg5 = Mail::Message->read($in); $in->close; ok(defined $msg5); is(ref $msg5, 'Mail::Message'); ok(defined $msg5->head); isa_ok($msg5->head, 'Mail::Message::Head'); my $body5 = $msg5->body; ok(defined $body5); isa_ok($body5, 'Mail::Message::Body'); ok(!$body5->isDelayed); cmp_ok(@$body5, "==", 2); is($body5->[0], "body1\n"); is($body5->[1], "body2\n"); is($msg5->subject, 'hello world'); ok($msg5->messageId); ok($msg5->get('message-id')); unlink 'tmp'; Mail-Message-3.006/t/502parser-nested.t0000644000175000001440000000446513200571125020144 0ustar00markovusers00000000000000#!/usr/bin/env perl # # Test processing a message/rfc822 # use strict; use warnings; use Mail::Message::Test; use Mail::Message; use Test::More tests => 2; use IO::Scalar; # # Reading a very complicate message from scalar # my $msg = Mail::Message->read(<<'END-OF-MESSAGE', strip_status_fields => 0); From: "you" MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="3/Cnt5Mj2+" Content-Transfer-Encoding: 7bit Message-ID: <15375.28519.265629.832146@tradef1-fe> Date: Thu, 6 Dec 2001 14:15:19 +0100 (MET) To: me@example.com Subject: forwarded message from Pietje Puk Status: RO --3/Cnt5Mj2+ Content-Type: text/plain; charset=us-ascii Content-Description: message body text Content-Transfer-Encoding: 7bit This is some text before a forwarded multipart!! --3/Cnt5Mj2+ Content-Type: message/rfc822 Content-Description: forwarded message Content-Transfer-Encoding: 7bit MIME-Version: 1.0 Content-Type: multipart/alternative; boundary="----=_NextPart_000_0017_01C17E5E.A5657580" Message-ID: <001a01c17e56$5fc02640$5f23643e@ibm5522ccd> From: "Someone" To: "Me" Subject: A multipart alternative This is a multi-part message in MIME format. ------=_NextPart_000_0017_01C17E5E.A5657580 CONTENT-TRANSFER-ENCODING: quoted-printable Content-Type: text/plain; charset="iso-8859-1" Send me a postcard if you read this. Oh, another line. ------=_NextPart_000_0017_01C17E5E.A5657580 CONTENT-TRANSFER-ENCODING: quoted-printable Content-Type: text/html; charset="iso-8859-1" Send me a postcard if you read this.
Oh, another line.
------=_NextPart_000_0017_01C17E5E.A5657580-- --3/Cnt5Mj2+-- END-OF-MESSAGE ok(defined $msg); my $dump; my $catch = IO::Scalar->new(\$dump); $msg->printStructure($catch); # if 1550 bytes is reported for the whole message, then the Status # field hasn't been removed after reading. is($dump, <<'DUMP'); multipart/mixed: forwarded message from Pietje Puk (1551 bytes) text/plain (164 bytes) message/rfc822 (1044 bytes) multipart/alternative: A multipart alternative (943 bytes) text/plain (148 bytes) text/html (358 bytes) DUMP Mail-Message-3.006/t/401msg-replsubj.t0000644000175000001440000000316313200571125017772 0ustar00markovusers00000000000000#!/usr/bin/env perl # # Test the creation of reply subjects # use strict; use warnings; use Mail::Message::Test; use Mail::Message::Construct::Reply; use Test::More tests => 21; is(Mail::Message->replySubject('subject'), 'Re: subject'); is(Mail::Message->replySubject('Re: subject'), 'Re[2]: subject'); is(Mail::Message->replySubject('Re[1]: subject'), 'Re[2]: subject'); is(Mail::Message->replySubject('Re[2]: subject'), 'Re[3]: subject'); is(Mail::Message->replySubject('Re: Re: subject'), 'Re[3]: subject'); is(Mail::Message->replySubject('Re: Re[2]: subject'), 'Re[4]: subject'); is(Mail::Message->replySubject('Re Re: subject'), 'Re[3]: subject'); is(Mail::Message->replySubject('Re,Re: subject'), 'Re[3]: subject'); is(Mail::Message->replySubject('Re Re[2]: subject'), 'Re[4]: subject'); is(Mail::Message->replySubject('subject (Re)'), 'Re[2]: subject'); is(Mail::Message->replySubject('subject (Re) (Re)'), 'Re[3]: subject'); is(Mail::Message->replySubject('Re: subject (Re)'), 'Re[3]: subject'); is(Mail::Message->replySubject('subject (Forw)'), 'Re[2]: subject'); is(Mail::Message->replySubject('subject (Re) (Forw)'), 'Re[3]: subject'); is(Mail::Message->replySubject('Re: subject (Forw)'), 'Re[3]: subject'); is(Mail::Message->replySubject('subject: sub2'), 'Re: subject: sub2'); is(Mail::Message->replySubject('Re: subject: sub2'), 'Re[2]: subject: sub2'); is(Mail::Message->replySubject('subject : sub2'), 'Re: subject : sub2'); ok(Mail::Message->replySubject('Re: subject : sub2 (Forw)') eq 'Re[3]: subject : sub2'); is(Mail::Message->replySubject(''), 'Re: your mail'); is(Mail::Message->replySubject(undef), 'Re: your mail'); Mail-Message-3.006/t/113fieldu-unstr.t0000644000175000001440000000673513200571125020011 0ustar00markovusers00000000000000#!/usr/bin/env perl # # Test processing of unstructured fields # use strict; use warnings; use utf8; use Mail::Message::Test; use Mail::Message::Field::Unstructured; use Test::More tests => 32; my $mmff = 'Mail::Message::Field::Full'; my $mmfu = 'Mail::Message::Field::Unstructured'; # # Test construction with simple body # my $a = $mmfu->new('a', 'new'); ok(defined $a, "Created simplest version"); isa_ok($a, $mmfu); isa_ok($a, $mmff); is($a->name, 'a', "Name of a"); is($a->unfoldedBody, 'new', "Unfolded body a"); my @al = $a->foldedBody; cmp_ok(@al, '==', 1, "Folded body of a"); is($al[0], " new\n"); my $b = $mmfu->new('b'); ok(defined $b, "No body specified: later"); # # LINE without new lines (no folds) # $b = $mmfu->new('b: new'); ok(defined $b, "Created b with body split"); isa_ok($b, $mmfu); isa_ok($b, $mmff); is($b->name, 'b', "Name of b"); is($b->unfoldedBody, 'new', "Unfolded body b"); my @bl = $b->foldedBody; cmp_ok(@bl, '==', 1, "Folded body of b"); is($bl[0], " new\n"); # # LINE with new-lines (folds) # my $c = $mmfu->new("c: new\n line\n"); ok(defined $c, "Created c with body split"); isa_ok($c, $mmfu); isa_ok($c, $mmff); is($c->name, 'c', "Name of c"); is($c->unfoldedBody, 'new line', "Unfolded body c"); my @cl = $c->foldedBody; cmp_ok(@cl, '==', 2, "Folded body of c"); is($cl[0], " new\n", "Folded c line 1"); is($cl[1], " line\n", "Folded c line 2"); # # Test encoding of line with separate body # my $d = $mmfu->new("d", "a\x{E4}b", charset => 'iso-8859-1'); ok(defined $d, "Created d with included stranger"); isa_ok($d, $mmfu); is($d->name, 'd', "Name of d"); is($d->unfoldedBody, '=?iso-8859-1?q?a=E4b?=', "Unfolded body d"); my @dl = $d->foldedBody; cmp_ok(@dl, '==', 1, "Folded body of d"); is($dl[0], " =?iso-8859-1?q?a=E4b?=\n", "Folded d line 0"); is($d->decodedBody, "a\x{E4}b"); # # Test folding of very long lines with unicode and fieldname # added 3.002 my $e = $mmfu->new(Subject => 'Ẇåƫ įś Ûņįĉóɖé ¿ Ŵąť ïŝ Ḝṋɕòḑǐꞑĝ, Ẇåƫ įś Ûņįĉóɖé ¿ Ŵąť ïŝ Ḝṋɕòḑǐꞑĝ Ẇåƫ įś Ûņįĉóɖé ¿ Ŵąť ïŝ Ḝṋɕòḑǐꞑĝ, Ẇåƫ įś Ûņįĉóɖé ¿ Ŵąť ïŝ Ḝṋɕòḑǐꞑĝ', charset => 'utf-8'); ok defined $e, 'folding'; is $e->string, <<_E_ENCODED; Subject: =?utf-8?q?=E1=BA=86=C3=A5=C6=AB_=C4=AF=C5=9B_=C3=9B=C5=86=C4=AF?= =?utf-8?q?=C4=89=C3=B3=C9=96=C3=A9_=C2=BF_=C5=B4=C4=85=C5=A5_=C3=AF=C5=9D?= =?utf-8?q?_=E1=B8=9C=E1=B9=8B=C9=95=C3=B2=E1=B8=91=C7=90=EA=9E=91=C4=9D,_?= =?utf-8?q?=E1=BA=86=C3=A5=C6=AB_=C4=AF=C5=9B_=C3=9B=C5=86=C4=AF=C4=89?= =?utf-8?q?=C3=B3=C9=96=C3=A9_=C2=BF_=C5=B4=C4=85=C5=A5_=C3=AF=C5=9D_?= =?utf-8?q?=E1=B8=9C=E1=B9=8B=C9=95=C3=B2=E1=B8=91=C7=90=EA=9E=91=C4=9D_?= =?utf-8?q?=E1=BA=86=C3=A5=C6=AB_=C4=AF=C5=9B_=C3=9B=C5=86=C4=AF=C4=89?= =?utf-8?q?=C3=B3=C9=96=C3=A9_=C2=BF_=C5=B4=C4=85=C5=A5_=C3=AF=C5=9D_?= =?utf-8?q?=E1=B8=9C=E1=B9=8B=C9=95=C3=B2=E1=B8=91=C7=90=EA=9E=91=C4=9D,_?= =?utf-8?q?=E1=BA=86=C3=A5=C6=AB_=C4=AF=C5=9B_=C3=9B=C5=86=C4=AF=C4=89?= =?utf-8?q?=C3=B3=C9=96=C3=A9_=C2=BF_=C5=B4=C4=85=C5=A5_=C3=AF=C5=9D_?= =?utf-8?q?=E1=B8=9C=E1=B9=8B=C9=95=C3=B2=E1=B8=91=C7=90=EA=9E=91=C4=9D?= _E_ENCODED Mail-Message-3.006/t/011reporter-reports.t0000644000175000001440000000510013200571125020704 0ustar00markovusers00000000000000#!/usr/bin/env perl # # Test reporting warnings and errors # use strict; use warnings; use Mail::Reporter; use Mail::Message::Test; use Test::More tests => 51; my $rep = Mail::Reporter->new; ok(defined $rep); my $catch; { local $SIG{__WARN__} = sub { $catch = shift }; $rep->log(ERROR => 'a test'); # \n will be added } is($catch, "ERROR: a test\n", 'Stored one error text'); cmp_ok($rep->report('ERRORS'), '==', 1, 'Counts one error'); is(($rep->report('ERRORS'))[0], "a test", 'Correctly stored text'); undef $catch; { local $SIG{__WARN__} = sub { $catch = shift }; $rep->log(WARNING => "filter"); } ok(defined $catch, 'No visible warnings'); cmp_ok($rep->report('WARNING'), '==', 1, 'Count logged warnings'); cmp_ok($rep->report('ERROR'), '==', 1, 'Count logged errors'); cmp_ok($rep->report, '==', 2, 'Count all logged messages'); is(($rep->report('WARNINGS'))[0], "filter", 'No \n added'); my @reps = $rep->report; is($reps[0][0], 'WARNING', 'Checking report()'); is($reps[0][1], "filter"); is($reps[1][0], 'ERROR'); is($reps[1][1], "a test"); @reps = $rep->reportAll; is($reps[0][0], $rep, 'Checking reportAll()'); is($reps[0][1], 'WARNING'); is($reps[0][2], "filter"); is($reps[1][0], $rep); is($reps[1][1], 'ERROR'); is($reps[1][2], "a test"); cmp_ok($rep->errors, '==', 1, 'Check errors() short-cut'); cmp_ok($rep->warnings, '==', 1, 'Check warnings() short-cut'); # # Check merging reports # my $r2 = Mail::Reporter->new(trace => 'NONE', log => 'DEBUG'); ok(defined $r2, 'Another traceable object'); isa_ok($r2, 'Mail::Reporter'); ok($r2->log(WARNING => 'I warn you!')); ok($r2->log(ERROR => 'You are in error')); ok($r2->log(ERROR => 'I am sure!!')); ok($r2->log(NOTICE => 'Don\'t notice me')); $rep->addReport($r2); @reps = $rep->reportAll; cmp_ok(@{$reps[0]}, '==', 3); is($reps[0][0], $rep, 'Checking reportAll()'); is($reps[0][1], 'NOTICE'); is($reps[0][2], "Don't notice me"); cmp_ok(@{$reps[1]}, '==', 3); is($reps[1][0], $rep); is($reps[1][1], 'WARNING'); is($reps[1][2], "filter"); cmp_ok(@{$reps[2]}, '==', 3); is($reps[2][0], $rep); is($reps[2][1], 'WARNING'); is($reps[2][2], "I warn you!"); cmp_ok(@{$reps[3]}, '==', 3); is($reps[3][0], $rep); is($reps[3][1], 'ERROR'); is($reps[3][2], "a test"); cmp_ok(@{$reps[4]}, '==', 3); is($reps[4][0], $rep); is($reps[4][1], 'ERROR'); is($reps[4][2], "You are in error"); cmp_ok(@{$reps[5]}, '==', 3); is($reps[5][0], $rep); is($reps[5][1], 'ERROR'); is($reps[5][2], "I am sure!!"); Mail-Message-3.006/t/111fieldu-full_ru.t0000644000175000001440000000134213200571125020271 0ustar00markovusers00000000000000#!/usr/bin/env perl # # Test processing of full fields with russian chars in utf-8. # use strict; use warnings; use utf8; use Mail::Message::Test; use Mail::Message::Field::Structured; use Test::More tests => 3; my $mmfs = 'Mail::Message::Field::Structured'; my $r = $mmfs->new('r', ''); isa_ok($r, $mmfs); my $text_ru = "Раньше длинные multibyte-последовательности кодировались неправильно, теперь должно работать."; is($r->decode($r->encode($text_ru, charset => 'utf-8', encoding => 'q')), $text_ru, 'encode/decode to/from QP'); is($r->decode($r->encode($text_ru, charset => 'utf-8', encoding => 'b')), $text_ru, 'encode/decode to/from Base64'); Mail-Message-3.006/t/405msg-forward.t0000644000175000001440000001452513200571125017620 0ustar00markovusers00000000000000#!/usr/bin/env perl # # Test the creation of forwarded messages # use strict; use warnings; use Mail::Message; use Mail::Message::Test; use Mail::Message::Head; use Mail::Message::Body::Lines; use Mail::Message::Construct::Forward; use Test::More tests => 25; use Mail::Address; # # First produce a message to forward to. # my $head = Mail::Message::Head->build ( To => 'me@example.com (Me the receiver)' , From => 'him@somewhere.else.nl (Original Sender)' , Cc => 'the.rest@world.net' , Subject => 'Test of forward' , Date => 'Wed, 9 Feb 2000 15:44:05 -0500' , 'Content-Something' => 'something' ); my ($text, $sig) = (<<'TEXT', <<'SIG'); First line of orig message. Another line of message. TEXT -- And this is the signature which has a few lines too SIG my @lines = split /^/, $text.$sig; my $body = Mail::Message::Body::Lines->new ( mime_type => 'text/plain' , data => \@lines ); ok(defined $body); my $msg = Mail::Message->new(head => $head); $msg->body($body); ok(defined $msg); # # Create a simple forward # my $forward = $msg->forward ( strip_signature => undef , prelude => undef , postlude => undef , quote => undef , To => 'dest@example.com (New someone)' ); ok(defined $forward, 'created simple forward'); isa_ok($forward, 'Mail::Message'); my @f = $forward->body->string; my @g = $msg->body->string; is(@f, @g); #$forward->print(\*STDERR); # # Create a real forward, which defaults to INLINE # my $dest = 'dest@test.org (Destination)'; $forward = $msg->forward ( quote => '] ' , To => $dest ); ok($forward->body!=$msg->body); is( $forward->head->get('to'), $dest); is($forward->head->get('from'), $msg->head->get('to')); ok(! defined $forward->head->get('cc')); #$forward->print; is($forward->body->string, <<'EXPECT'); ---- BEGIN forwarded message From: him@somewhere.else.nl (Original Sender) To: me@example.com (Me the receiver) Cc: the.rest@world.net Date: Wed, 9 Feb 2000 15:44:05 -0500 ] First line of orig message. ] Another line of message. ---- END forwarded message EXPECT # # Complicated forward # my $postlude = Mail::Message::Body::Lines->new ( data => [ "added to the end\n", "two lines\n" ] ); $forward = $msg->forward ( group_forward => 0 , quote => sub {chomp; "> ".reverse."\n"} , prelude => "From me!\n" , postlude => $postlude , Cc => 'xyz' , Bcc => Mail::Address->new('username', 'user@example.com') , To => $dest ); is( $forward->head->get('to'), $dest); is($forward->head->get('from'), $msg->head->get('to')); is($forward->head->get('cc'), 'xyz'); ok(!defined $forward->head->get('skip')); is($forward->head->get('bcc'), 'username '); #$forward->print; is($forward->body->string, <<'EXPECT'); From me! > .egassem giro fo enil tsriF > .egassem fo enil rehtonA added to the end two lines EXPECT # # Try forwardAttach # $msg = Mail::Message->build(To => 'you', 'X-Loop' => 'yes', data => "greetings!\n"); my $preamble = Mail::Message::Body->new(data => "just checking\n"); my $fwd = $msg->forwardAttach(preamble => $preamble, To => 'us'); ok(defined $fwd, "create forwardAttach"); isa_ok($fwd, 'Mail::Message'); is(reproducable_text($fwd->string."\n"), < Content-Type: multipart/mixed; boundary="boundary-" Message-Id: Date: MIME-Version: 1.0 --boundary- Content-Type: text/plain; charset="utf-8" Content-Transfer-Encoding: 8bit just checking --boundary- Content-Type: text/plain; charset="utf-8" Content-Transfer-Encoding: 8bit greetings! --boundary--- ATTACH # # Try forwardEncapsulate # my $fwd2 = $msg->forwardEncapsulate(preamble => $preamble, To => 'us'); ok(defined $fwd2, "create forwardEncapsulate"); is(reproducable_text($fwd2->string."\n"), < Content-Type: multipart/mixed; boundary="boundary-" Message-Id: Date: MIME-Version: 1.0 --boundary- Content-Type: text/plain; charset="utf-8" Content-Transfer-Encoding: 8bit just checking --boundary- Content-Type: message/rfc822 To: you X-Loop: yes Content-Type: text/plain; charset="utf-8" Content-Transfer-Encoding: 8bit Message-Id: Date: MIME-Version: 1.0 greetings! --boundary--- ENCAPS # # Try complex attach # my $one = Mail::Message::Body->new(data => "this is the first\n"); my $two = Mail::Message::Body->new(data => "this is the second\n", mime_type => 'application/pgp-signature'); my $multi = Mail::Message::Body::Multipart->new(parts => [ $one, $two ]); $msg = Mail::Message->buildFromBody($multi, To => 'you'); ok(defined $msg, 'created complex multipart'); my $fwd3 = $msg->forwardAttach(preamble => $preamble, To => 'us'); is(reproducable_text($fwd3->string."\n"), < Content-Type: multipart/mixed; boundary="boundary-" Message-Id: Date: MIME-Version: 1.0 --boundary- Content-Type: text/plain; charset="utf-8" Content-Transfer-Encoding: 8bit just checking --boundary- Content-Type: text/plain; charset="utf-8" Content-Transfer-Encoding: 8bit this is the first --boundary--- ATTACH # # Binary message used with inline, which becomes an attach # $body = Mail::Message::Body->new ( mime_type => 'application/octet-stream' , data => [ "line 1\n", "line2\n" ] ); ok($body->isBinary); $msg = Mail::Message->buildFromBody($body, To => 'you'); #$msg->print(\*STDERR); my $fwd4 = $msg->forwardInline ( prelude => "Prelude\n" , postlude => "Postlude\n" #, is_attached => "My own text\n" , To => 'everyone' ); #$fwd4->print(\*STDERR); is(reproducable_text($fwd4->string."\n"), <<'EXPECTED'); From: you To: everyone Subject: Forwarded References: Content-Type: multipart/mixed; boundary="boundary-" Message-Id: Date: MIME-Version: 1.0 --boundary- Content-Type: text/plain; charset="utf-8" Content-Transfer-Encoding: 8bit Prelude [The forwarded message is attached] Postlude --boundary- Content-Type: application/octet-stream Content-Transfer-Encoding: base64 bGluZSAxCmxpbmUyCg== --boundary--- EXPECTED Mail-Message-3.006/t/320bodyconv-textaf.t0000644000175000001440000000244613232126040020474 0ustar00markovusers00000000000000#!/usr/bin/env perl # # Test formatting as plain text with Text::Autoformat # use strict; use warnings; use Mail::Message::Test; use Mail::Message::Body; use Test::More; BEGIN { eval 'require Text::Autoformat'; if($@) { plan skip_all => "requires Text::Autoformat."; exit 0; } require Mail::Message::Convert::TextAutoformat; require Text::Autoformat; Text::Autoformat->import('break_wrap'); plan tests => 3; } my $content = <<'TEXT'; This is some raw text to form the body of the message which has to be printed. I hope it is nice. > some badly formatted > input lines > are also in here, to test whether autoformat works.... This line is for instance much too long and should be spread over multiple lines. TEXT my $body = Mail::Message::Body->new ( type => 'text/html' , data => $content ); my $af = Mail::Message::Convert::TextAutoformat ->new( options => {break => break_wrap} ); ok($af); my $dump = $af->autoformatBody($body); ok(defined $dump); is("$dump", <<'DUMP'); This is some raw text to form the body of the message which has to be printed. I hope it is nice. > some badly formatted input lines are also in here, to test whether > autoformat works.... This line is for instance much too long and > should be spread over multiple lines. DUMP Mail-Message-3.006/t/204head-spamgroup.t0000644000175000001440000000716013200571125020276 0ustar00markovusers00000000000000#!/usr/bin/env perl # # Test the processing of spam groups. # use strict; use warnings; use Mail::Message::Test; use Mail::Message::Head::Complete; use Mail::Message::Head::SpamGroup; use File::Spec; use Test::More; use File::Basename qw(dirname); BEGIN { eval { require Mail::Box::Mbox }; if($@) { plan skip_all => 'these tests need Mail::Box::Mbox'; exit 0; } else { plan tests => 75; } } # # Creation of a group # my $sg = Mail::Message::Head::SpamGroup->new; ok(defined $sg, 'simple construction'); isa_ok($sg, 'Mail::Message::Head::SpamGroup'); # # Extraction of a group # my $h = Mail::Message::Head::Complete->new; ok(defined $h); my @sgs = Mail::Message::Head::SpamGroup->from($h); ok(!@sgs, "no spamgroups in empty header"); # # Open folder with example messages # my $fn = dirname(__FILE__).'/204-sgfolder.mbox'; die "Cannot find file with spam filter examples ($fn)" unless -f $fn; my $folder = Mail::Box::Mbox->new(folder => $fn, extract => 'ALWAYS'); ok(defined $folder, "open example folder"); die unless defined $folder; my @msgs = $folder->messages; cmp_ok(scalar(@msgs), '==', 11, "all expected messages present"); for(my $nr=0; $nr<5; $nr++) { my $msg = $folder->message($nr); my @sgs = $msg->head->spamGroups; cmp_ok(scalar(@sgs), '==', 1, "spam group at $nr"); my $sg = $sgs[0]; is($sg->type, "SpamAssassin"); $sg->delete; @sgs = $msg->head->spamGroups; cmp_ok(scalar(@sgs), '==', 0, "spam group $nr removed"); } for(my $nr=5; $nr<10; $nr++) { my $msg = $folder->message($nr); my $head = $msg->head; my @sgs = $head->spamGroups; cmp_ok(scalar(@sgs), '==', 1, "spam group at $nr"); my $sg0 = $sgs[0]; is($sg0->type, "Habeas-SWE"); my $sg = $msg->head->spamGroups('Habeas-SWE'); ok(defined $sg); is($sg->type, "Habeas-SWE"); my $is_correct = ($nr==5 || $nr==6) ? 1 : 0; my $found_correct = $sg->habeasSweFieldsCorrect || 0; cmp_ok($found_correct, '==', $is_correct, "spam in $nr"); $found_correct = Mail::Message::Head::SpamGroup->habeasSweFieldsCorrect($msg) || 0; cmp_ok($found_correct, '==', $is_correct, "spam in message $nr"); $found_correct = Mail::Message::Head::SpamGroup->habeasSweFieldsCorrect($head) || 0; cmp_ok($found_correct, '==', $is_correct, "spam in head of message $nr"); $sg->delete; @sgs = $msg->head->spamGroups; cmp_ok(scalar(@sgs), '==', 0, "spam group $nr removed"); } my $msg = $folder->message(10); my $head = $msg->head; ok(Mail::Message::Head::SpamGroup->habeasSweFieldsCorrect($msg)); ok(Mail::Message::Head::SpamGroup->habeasSweFieldsCorrect($head)); @sgs = sort {$a->type cmp $b->type} $head->spamGroups; cmp_ok(scalar(@sgs), '==', 2, "message 11 with 2 groups"); is($sgs[0]->type, 'Habeas-SWE'); ok($sgs[0]->habeasSweFieldsCorrect); is($sgs[1]->type, 'SpamAssassin'); my $sgs = $head->spamGroups; cmp_ok($sgs, '==', 2, "scalar context = amount"); my $sa = $head->spamGroups('SpamAssassin'); ok(defined $sa, "found spam assassin group"); my $swe = $head->spamGroups('Habeas-SWE'); ok($swe->habeasSweFieldsCorrect); ok(defined $swe, "found habeas-swe group"); $sa->delete; @sgs = $head->spamGroups; cmp_ok(scalar(@sgs), '==', 1, "message 11 still 1 group"); is($sgs[0]->type, 'Habeas-SWE'); ok($sgs[0]->habeasSweFieldsCorrect); $swe->delete; @sgs = $head->spamGroups; cmp_ok(scalar(@sgs), '==', 0, "message 11 without spam group"); Mail-Message-3.006/t/120fieldu-dkim.t0000644000175000001440000000277713200571125017562 0ustar00markovusers00000000000000#!/usr/bin/env perl # # Test processing of Authentication-Results # use strict; use warnings; use Mail::Message::Test; use Mail::Message::Field::DKIM; use Mail::Message::Field::Full; use Test::More tests => 16; my $mmff = 'Mail::Message::Field::Full'; my $mmfd = 'Mail::Message::Field::DKIM'; #use Data::Dumper; # ### constructing # # ### Parsing # # Example from RFC6376 section 3.5 my $d1 = $mmff->new( 'DKIM-Signature: v=1; a=rsa-sha256; d=example.net; s=brisbane; c=simple; q=dns/txt; i=@eng.example.net; t=1117574938; x=1118006938; h=from:to:subject:date; z=From:foo@eng.example.net|To:joe@example.com| Subject:demo=20run|Date:July=205,=202005=203:44:08=20PM=20-0700; bh=MTIzNDU2Nzg5MDEyMzQ1Njc4OTAxMjM0NTY3ODkwMTI=; b=dzdVyOfAKCdLXdJOc9G2q8LoXSlEniSbav+yuU4zGeeruD00lszZVoG4ZHRNiYzR'); ok defined $d1, '1 parse'; isa_ok $d1, $mmff; isa_ok $d1, $mmfd; is $d1->tagVersion, '1'; is $d1->tagAlgorithm, 'rsa-sha256'; is $d1->tagDomain, 'example.net'; is $d1->tagSelector, 'brisbane'; is $d1->tagC14N, 'simple'; is $d1->tagQueryMethods, 'dns/txt'; is $d1->tagAgentID, '@eng.example.net'; is $d1->tagTimestamp, 1117574938; is $d1->tagExpires, 1118006938; is $d1->tagSignedHeaders, 'from:to:subject:date'; is $d1->tagExtract, 'From:foo@eng.example.net|To:joe@example.com| Subject:demo=20run|Date:July=205,=202005=203:44:08=20PM=20-0700'; is $d1->tagSignature, 'MTIzNDU2Nzg5MDEyMzQ1Njc4OTAxMjM0NTY3ODkwMTI='; is $d1->tagSignData, 'dzdVyOfAKCdLXdJOc9G2q8LoXSlEniSbav+yuU4zGeeruD00lszZVoG4ZHRNiYzR'; Mail-Message-3.006/t/300body-file.t0000644000175000001440000000532513200571125017232 0ustar00markovusers00000000000000#!/usr/bin/env perl # # Test processing of message bodies which have their content stored # in a file. # use strict; use warnings; use Mail::Message::Test; use Mail::Message::Body::File; use Test::More tests => 33; use IO::Scalar; # Test to read a Lines from file. # Let's fake the file, for simplicity. my $filedata = <<'SIMULATED_FILE'; This is a file with five lines, and it is used to test whether the reading into a lines body would work (or not) SIMULATED_FILE # Test script has Unix line endings (LF) even under Windows. # Replace LF by CRLF if running under Windows, # so the file is truly a Windows file: $filedata =~ s/\n/\r\n/gs if $crlf_platform; my $f = IO::Scalar->new(\$filedata); my $body = Mail::Message::Body::File->new(file => $f); ok($body, 'body creation from file'); is($body->string, $filedata, 'stringify'); cmp_ok($body->nrLines, "==", 5, 'nr lines'); # Mail::Message::Body::File::size() substracts 1 per line (for CR) on Windows my $body_length = length $filedata; $body_length -= $body->nrLines if $crlf_platform; cmp_ok($body->size, "==", $body_length, 'size'); my $fakeout; my $g = IO::Scalar->new(\$fakeout); $body->print($g); is($fakeout, $filedata, 'print'); my @lines = $body->lines; cmp_ok(@lines, "==", 5, 'count of lines'); my @filedata = split /^/, $filedata; cmp_ok(@filedata, "==", 5, 'count expected lines'); foreach (0..4) { is($lines[$_], $filedata[$_], "line $_") } # Reading data from lines. $body = Mail::Message::Body::File->new(data => [@filedata]); ok($body, 'creation from array of lines'); is($body->string, $filedata, 'data'); cmp_ok($body->nrLines, "==", 5, 'nr lines'); cmp_ok($body->size, "==", $body_length, 'size'); $fakeout = ''; $body->print($g); is($fakeout, $filedata, 'result print'); @lines = $body->lines; cmp_ok(@lines, "==", 5, 'count of lines'); foreach (0..4) { is($lines[$_], $filedata[$_], "line $_") } # Test overloading is("$body", $filedata, 'overloaded stringification'); @lines = @$body; ok(@lines, 'overloaded ref array'); cmp_ok(@lines, "==", 5, 'count of lines'); foreach (0..4) { is($lines[$_], $filedata[$_], "line $_") } # Test cleanup my $filename = $body->tempFilename; ok(-f $filename, 'filename exists'); undef $body; ok(! -f $filename, 'file cleaned up'); Mail-Message-3.006/t/100field-cfws.t0000644000175000001440000000433713200571125017403 0ustar00markovusers00000000000000#!/usr/bin/env perl # # Test stripping CFWS [comments and folding white spaces] as # specified by rfc2822. # use strict; use warnings; use Mail::Message::Test; use Mail::Message::Field::Fast; use Test::More tests => 54; use Mail::Address; my @tests = ( 'aap noot mies' => 'aap noot mies' , ' aap noot mies ' => 'aap noot mies' , "aap\n noot\n" => 'aap noot' , "aap (comment) noot" => 'aap noot' , "aap () noot" => 'aap noot' , "(a) aap (comment) noot (c)" => 'aap noot' , "aap (com (nested) ment) noot" => 'aap noot' , "aap ((nested) comment) noot" => 'aap noot' , "aap (comment (nested)) noot" => 'aap noot' , "aap (comment(nested)) noot" => 'aap noot' , "aap ((nested)comment(nested)) noot" => 'aap noot' , "((nested)comment(nested)) noot" => 'noot' , "aap ((nes(ted))comment(nested)) noot" => 'aap noot' , "(nes(ted)comment(nested)) noot (aap)" => 'noot' , "aap ((nes\n\nted)co\nmment(nested)\n) noot" => 'aap noot' , '"aap" noot' => '"aap" noot' , '"aap" (noot) mies' => '"aap" mies' , '"aap" (noot) mies ' => '"aap" mies' , '"aap" noot (mies) ' => '"aap" noot' , 'aap "noot" (mies) ' => 'aap "noot"' , 'aap (noot) "mies"' => 'aap "mies"' , 'aap (noot) "mies" ' => 'aap "mies"' , 'aap (noot) "mies" (noot(nest)) aap' => 'aap "mies" aap' , 'aap \( noot' => 'aap \( noot' , 'aap "(" noot' => 'aap "(" noot' , 'aap "(noot)" mies' => 'aap "(noot)" mies' , 'aap \"(noot) mies' => 'aap \" mies' ); my @take = @tests; while(@take) { my ($from, $to) = (shift @take, shift @take); is(Mail::Message::Field->stripCFWS($from), $to ); } @take = @tests; while(@take) { my ($from, $to) = (shift @take, shift @take); my $field = Mail::Message::Field::Fast->new('Something' => $from); is($field->stripCFWS, $to); } Mail-Message-3.006/t/423msgconv-emabs.t0000644000175000001440000000271013200571125020122 0ustar00markovusers00000000000000#!/usr/bin/env perl # # Test coercion from Email::Abstract to Mail::Message use strict; use warnings; use Mail::Message; use Mail::Message::Test; use Test::More; BEGIN { eval { require Email::Abstract }; if($@) { plan skip_all => "requires Email::Abstract."; exit 0; } eval { require Email::Simple }; if($@) { plan skip_all => "requires Email::Simple."; exit 0; } plan tests => 6; } my $email = Email::Simple->new(<<'END_MESSAGE'); From: mailtools@overmeer.net To: the users Subject: use Mail::Box In-Reply-To: <023984hjlur29420@sruoiu.nl> X-Again: repeating header X-Again: repeating header again X-Again: repeating header and again MIME::Entity is written by Eriq, and extends Mail::Internet with many new capabilities, like multipart bodies. Actually, although it says to extend, it more or less reimplements most methods and conflicts with the other. Even the Mail::Internet constructor does not work: only the build() can be used to safely construct a message. Do not use it anymore! END_MESSAGE isa_ok($email, 'Email::Simple'); is($email->header('in-reply-to'), '<023984hjlur29420@sruoiu.nl>'); my $abstract = Email::Abstract->new($email); isa_ok($abstract, 'Email::Abstract'); is($abstract->get_header('in-reply-to'), '<023984hjlur29420@sruoiu.nl>'); my $message = Mail::Message->coerce($abstract); isa_ok($message, 'Mail::Message'); is($message->get('in-reply-to'), '<023984hjlur29420@sruoiu.nl>'); Mail-Message-3.006/t/103field-wrap.t0000644000175000001440000000750313200571125017413 0ustar00markovusers00000000000000#!/usr/bin/env perl # # Test the refolding of fields # use strict; use warnings; use Mail::Message::Test; use Test::More tests => 32; use Scalar::Util qw/refaddr/; # # FAST FIELDS # use Mail::Message::Field::Fast; my $fast = 'Mail::Message::Field::Fast'; my $fast1 = $fast->new(Name => 'body'); ok(defined $fast1, 'fast field created'); isa_ok($fast1, $fast); is($fast1->unfoldedBody, 'body'); is($fast1->foldedBody, " body\n"); my $fast2 = $fast1->setWrapLength; is(refaddr $fast1, refaddr $fast2, 'empty wrap'); is($fast2->unfoldedBody, 'body'); is($fast2->foldedBody, " body\n"); my $fast3 = $fast1->setWrapLength(34); is(refaddr $fast1, refaddr $fast3, 'wrap much longer'); is($fast3->unfoldedBody, 'body'); is($fast3->foldedBody, " body\n"); my $long = 'this is very long field, which has no folding yet'; my $fast4 = $fast->new(Name => $long); is($fast4->unfoldedBody, $long); is($fast4->foldedBody, " $long\n", 'long folding'); my $llong = 'this line is longer than the default fold of 78 characters. It should get folded more than once. Wow, 78 characters it quite a lot, you know! Are we on the third line already?'; my $fast5 = $fast->new(Name => $llong); is($fast5->unfoldedBody, $llong); is($fast5->foldedBody, <<__LLONG, 'llong folding'); this line is longer than the default fold of 78 characters. It should get folded more than once. Wow, 78 characters it quite a lot, you know! Are we on the third line already? __LLONG $fast5->setWrapLength(30); is($fast5->foldedBody, <<__LLONG, 'llong folding at 30'); this line is longer than the default fold of 78 characters. It should get folded more than once. Wow, 78 characters it quite a lot, you know! Are we on the third line already? __LLONG $fast5->setWrapLength(100); is($fast5->foldedBody, <<__LLONG, 'llong folding at 100'); this line is longer than the default fold of 78 characters. It should get folded more than once. Wow, 78 characters it quite a lot, you know! Are we on the third line already? __LLONG # # FLEX FIELDS # use Mail::Message::Field::Flex; my $flex = 'Mail::Message::Field::Flex'; my $flex1 = $flex->new(Name => 'body'); ok(defined $flex1, 'flex field created'); isa_ok($flex1, $flex); is($flex1->unfoldedBody, 'body'); is($flex1->foldedBody, " body\n"); my $flex2 = $flex1->setWrapLength; is(refaddr $flex1, refaddr $flex2, 'empty wrap'); is($flex2->unfoldedBody, 'body'); is($flex2->foldedBody, " body\n"); my $flex3 = $flex1->setWrapLength(34); is(refaddr $flex1, refaddr $flex3, 'wrap much longer'); is($flex3->unfoldedBody, 'body'); is($flex3->foldedBody, " body\n"); my $flex4 = $flex->new(Name => $long); is($flex4->unfoldedBody, $long); is($flex4->foldedBody, " $long\n", 'long folding'); my $flex5 = $flex->new(Name => $llong); is($flex5->unfoldedBody, $llong); is($flex5->foldedBody, <<__LLONG, 'llong folding'); this line is longer than the default fold of 78 characters. It should get folded more than once. Wow, 78 characters it quite a lot, you know! Are we on the third line already? __LLONG $flex5->setWrapLength(30); is($flex5->foldedBody, <<__LLONG, 'llong folding at 30'); this line is longer than the default fold of 78 characters. It should get folded more than once. Wow, 78 characters it quite a lot, you know! Are we on the third line already? __LLONG $flex5->setWrapLength(100); is($flex5->foldedBody, <<__LLONG, 'llong folding at 100'); this line is longer than the default fold of 78 characters. It should get folded more than once. Wow, 78 characters it quite a lot, you know! Are we on the third line already? __LLONG Mail-Message-3.006/t/302body-lines.t0000644000175000001440000000433713200571125017431 0ustar00markovusers00000000000000#!/usr/bin/env perl # # Test processing of message bodies which have their content stored # in an array. This does not test the reading of the bodies # from file. # use strict; use warnings; use Mail::Message::Test; use Mail::Message::Body::Lines; use Test::More tests => 30; use IO::Scalar; # Test to read a Lines from file. # Let's fake the file, for simplicity. my $filedata = <<'SIMULATED_FILE'; This is a file with five lines, and it is used to test whether the reading into a lines body would work (or not) SIMULATED_FILE my $f = IO::Scalar->new(\$filedata); my $body = Mail::Message::Body::Lines->new(file => $f); ok($body, "body from file is true"); is($body->string, $filedata, "body strings to data"); cmp_ok($body->nrLines, "==", 5, "body reports 5 lines"); cmp_ok($body->size, "==", length $filedata, "body size as data"); my $fakeout; my $g = IO::Scalar->new(\$fakeout); $body->print($g); is($fakeout, $filedata, "body prints right data"); my @lines = $body->lines; cmp_ok(@lines, "==", 5, "body produces five lines"); my @filedata = split /^/, $filedata; cmp_ok(@filedata, "==", 5, "data 5 lines"); foreach (0..4) { is($lines[$_], $filedata[$_], "expected line $_") } # Reading data from lines. $body = Mail::Message::Body::Lines->new(data => [@filedata]); ok($body, "body from array is true"); is($body->string, $filedata, "body string is data"); cmp_ok($body->nrLines, "==", 5, "body reports 5 lines"); cmp_ok($body->size, "==", length $filedata, "body reports correct size"); $fakeout = ''; $body->print($g); is($fakeout, $filedata, "body prints to data"); @lines = $body->lines; cmp_ok(@lines, "==", 5, "body produces 5 lines"); foreach (0..4) { is($lines[$_], $filedata[$_], "body line $_") } # Test overloading is("$body", $filedata, "stringification"); @lines = @$body; cmp_ok(@lines, "==", 5, "overload array-deref"); foreach (0..4) { is($lines[$_], $filedata[$_], "overload array $_") } Mail-Message-3.006/t/402msg-reply.t0000644000175000001440000000604413200571125017301 0ustar00markovusers00000000000000#!/usr/bin/env perl # # Test the creation of reply messages # use strict; use warnings; use Mail::Message; use Mail::Message::Test; use Mail::Message::Head; use Mail::Message::Body::Lines; use Mail::Message::Construct::Reply; use Test::More tests => 23; use Mail::Address; # # First produce a message to reply to. # my $head = Mail::Message::Head->build ( To => 'me@example.com (Me the receiver)' , From => 'him@somewhere.else.nl (Original Sender)' , Cc => 'the.rest@world.net' , Subject => 'Test of Reply' , Skip => 'Do not take this line' , Date => 'Wed, 9 Feb 2000 15:44:05 -0500' , 'Content-Something' => 'something' ); my ($text, $sig) = (<<'TEXT', <<'SIG'); First line of orig message. Another line of message. TEXT -- And this is the signature which has a few lines too SIG my @lines = split /^/, $text.$sig; my $body = Mail::Message::Body::Lines->new ( mime_type => 'text/plain' , checked => 1 , data => \@lines ); ok(defined $body, 'created body'); my $msg = Mail::Message->new(head => $head); $msg->body($body); ok(defined $msg, 'created message'); # # Create a simple reply # my $reply = $msg->reply ( strip_signature => undef , prelude => undef , quote => undef ); ok(defined $reply, 'created reply'); isa_ok($reply, 'Mail::Message'); is( $reply->head->get('to'), $msg->head->get('from')); is($reply->head->get('from'), $msg->head->get('to')); ok(!defined $reply->head->get('cc')); ok(!defined $reply->head->get('skip')); ok(!defined $reply->head->get('content-something')); #$reply->head->print(\*STDERR); #warn $reply->body->string; is($reply->body->string, $text.$sig); # # Create a complicated reply # my $postlude = Mail::Message::Body::Lines->new ( data => [ "added to the end\n", "two lines\n" ] ); $reply = $msg->reply ( group_reply => 1 , quote => '] ' , postlude => $postlude ); ok($reply->body!=$msg->body); is( $reply->head->get('to'), $msg->head->get('from')); is($reply->head->get('from'), $msg->head->get('to')); is( $reply->head->get('cc'), $msg->head->get('cc')); ok(!defined $reply->head->get('skip')); #$reply->body->print; is($reply->body->string, <<'EXPECT'); On Wed Feb 9 20:44:05 2000, Original Sender wrote: ] First line of orig message. ] Another line of message. added to the end two lines EXPECT # # Another complicated reply # $reply = $msg->reply ( group_reply => 0 , quote => sub {chomp; "> ".reverse."\n"} , postlude => $postlude , Bcc => Mail::Address->new('username', 'user@example.com') , 'X-Extra' => 'Additional headers' ); is( $reply->head->get('to'), $msg->head->get('from')); is($reply->head->get('from'), $msg->head->get('to')); ok(!defined $reply->head->get('cc')); ok(!defined $reply->head->get('skip')); is($reply->head->get('bcc'), 'username '); is($reply->head->get('x-extra'), 'Additional headers'); #$reply->print; is($reply->body->string, <<'EXPECT'); On Wed Feb 9 20:44:05 2000, Original Sender wrote: > .egassem giro fo enil tsriF > .egassem fo enil rehtonA added to the end two lines EXPECT Mail-Message-3.006/t/117fieldu-addr.t0000644000175000001440000001750713200571125017553 0ustar00markovusers00000000000000#!/usr/bin/env perl # Test processing of addresses use strict; use warnings; use Mail::Message; use Mail::Message::Test; use Mail::Message::Field::Addresses; use Test::More tests => 104; use Encode qw(is_utf8); # avoid "print of Wide characters" warning # http://code.google.com/p/test-more/issues/detail?id=46 binmode Test::More->builder->output, ":utf8"; binmode Test::More->builder->failure_output, ":utf8"; my $mmfa = 'Mail::Message::Field::Address'; my $mmfag = 'Mail::Message::Field::AddrGroup'; my $mmfas = 'Mail::Message::Field::Addresses'; # # Test single addresses # my $ad = $mmfa->new(phrase => 'Mark Overmeer', username => 'markov', domain => 'cpan.org', comment => 'This is me!'); ok(defined $ad, 'Created ad'); isa_ok($ad, $mmfa); is($ad->name, 'Mark Overmeer'); is($ad->address, 'markov@cpan.org'); is($ad->comment, 'This is me!'); is($ad->string, '"Mark Overmeer" (This is me!)'); # # Test whole field (Addresses) # my $cc = $mmfas->new('Cc'); ok(defined $cc, 'Create cc'); isa_ok($cc, $mmfas); my $jd = '"John Doe" '; $cc = $mmfas->new(Cc => $jd); ok(defined $cc, 'parsing joe'); my @g = $cc->groups; cmp_ok(scalar @g, '==', 1); my $g0 = $g[0]; ok(defined $g0); isa_ok($g0, 'Mail::Message::Field::AddrGroup'); is($g0->name, ''); my @ga = $g0->addresses; cmp_ok(scalar @ga, '==', 1, 'address from group'); isa_ok($ga[0], 'Mail::Message::Field::Address'); is($g0->string, $jd, 'group string is ok'); is("$g0", $jd, 'gr stringification is ok'); my @a = $cc->addresses; cmp_ok(scalar @a, '==', 1, 'all address'); my $a0 = $a[0]; ok(defined $a0); isa_ok($a0, 'Mail::Message::Field::Address'); is($a0->name, 'John Doe'); is($a0->address, 'jdoe@machine.example'); is($a0->username, 'jdoe'); is($a0->domain, 'machine.example'); is($cc->string, "Cc: $jd\n", 'line string'); $cc->beautify; is($cc->string, "Cc: $jd\n", 'line string'); is("$cc", $jd, 'line stringification'); # # Checking various strings which are mentioned in rfc2822 # my $c = '"Joe Q. Public" , Mary Smith , jdoe@example.org, Who? '; $cc = $mmfas->new('Cc' => $c); ok(defined $cc, 'Parsed Joe Q. Public'); @g = $cc->groups; cmp_ok(scalar @g, '==', 1, 'one group'); $g0 = $g[0]; ok(defined $g0); isa_ok($g0, 'Mail::Message::Field::AddrGroup'); is($g0->name, ''); @a = $g0->addresses; cmp_ok(scalar @a, '==', 4, 'four addresses in group'); # the collections are not ordered (hash), so we need to enforce some # order for the tests. @a = sort { $a->address cmp $b->address } @a; ok(defined $a[0]); isa_ok($a[0], 'Mail::Message::Field::Address'); isa_ok($a[1], 'Mail::Message::Field::Address'); isa_ok($a[2], 'Mail::Message::Field::Address'); isa_ok($a[3], 'Mail::Message::Field::Address'); ok(!$a[0]->phrase, "checking on jdoe"); ok(!$a[0]->comment); is($a[0]->username, 'jdoe'); is($a[0]->domain, 'example.org'); is($a[1]->phrase, 'Joe Q. Public', "checking Joe's identity"); is($a[1]->username, 'john.q.public'); is($a[1]->domain, 'example.com'); is($a[1]->address, 'john.q.public@example.com'); is($a[1]->string, '"Joe Q. Public" '); is($a[2]->phrase, 'Mary Smith', "checking Mary's id"); is($a[2]->username, 'mary'); is($a[2]->domain, 'x.test'); is($a[3]->phrase, 'Who?', "checking Who?"); is($a[3]->username, 'one'); is($a[3]->domain, 'y-me.test'); is($a[3]->address, 'one@y-me.test'); is($a[3]->string, 'Who? '); is($cc->string, "Cc: $c"); $cc->beautify; is($cc->string, <<'REFOLDED'); Cc: "Joe Q. Public" , "Mary Smith" , Who? , jdoe@example.org REFOLDED # Next! my $c3 = <<'COMPLEX'; , "Giant; \"Big\" Box" , A Group:Chris Jones ,joe@where.test,John ; Undisclosed recipients:; "Mary Smith: Personal Account" , Jane Brown COMPLEX $cc = $mmfas->new(Cc => $c3); ok(defined $cc, 'Parsed complex'); @g = $cc->groups; cmp_ok(scalar @g, '==', 3); @g = sort {$a->name cmp $b->name} @g; is($g[0]->name, ''); cmp_ok($g[0]->addresses, '==', 4); my @u = sort map {$_->username} $g[0]->addresses; cmp_ok(scalar @u, '==', 4); is($u[0], 'boss'); is($u[1], 'j-brown'); is($u[2], 'smith'); is($u[3], 'sysservices'); is($g[1]->name, 'A Group'); cmp_ok($g[1]->addresses, '==', 3); is($g[2]->name, 'Undisclosed recipients'); cmp_ok($g[2]->addresses, '==', 0); is($cc->string, "Cc: $c3"); $cc->beautify; is($cc->string, <<'REFOLDED'); Cc: "Giant; \"Big\" Box" , "Jane Brown" , "Mary Smith: Personal Account" , boss@nil.test, A Group: "Chris Jones" , John , joe@where.test; Undisclosed recipients: ; REFOLDED # Next ! my $c2 = <<'PETE'; Pete(A wonderful \) chap) , A Group(Some people) :Chris Jones , joe@example.org, John (my dear friend); (the end of the group) PETE $cc = $mmfas->new(Cc => $c2); ok(defined $cc, 'Parsed pete'); @g = $cc->groups; cmp_ok(scalar @g, '==', 2); is($g[0]->name, ''); is($g[1]->name, 'A Group'); @a = $g[0]->addresses; cmp_ok(scalar @a, '==', 1); $a0 = $a[0]; is($a0->phrase, 'Pete'); is($a0->username, 'pete'); is($a0->domain, 'silly.test'); is($a0->address, 'pete@silly.test'); ok(!defined $a0->comment); @a = $g[1]->addresses; cmp_ok(scalar @a, '==', 3); $a0 = $g[1]->find('Chris Jones'); ok(defined $a0, 'found chris'); is($a0->phrase, 'Chris Jones'); is($a0->username, 'c'); is($a0->domain, 'public.example'); ok(!defined $a0->comment); $a0 = $g[1]->find('John'); ok(defined $a0, 'found john'); is($a0->phrase, 'John'); is($a0->username, 'jdoe'); is($a0->domain, 'one.test'); is($a0->comment, 'my dear friend'); is($g[1]->string, 'A Group: "Chris Jones" , John (my dear friend), joe@example.org;'); is($cc->string, "Cc: $c2"); $cc->beautify; is($cc->string, <<'REFOLDED'); Cc: Pete , A Group: "Chris Jones" , John (my dear friend), joe@example.org; REFOLDED #Cc:(Empty list)(start)Undisclosed recipients :(nobody(that I know)) ; #From : John Doe #Mary Smith <@machine.tld:mary@example.net>, , jdoe@test . example # test =???= encoding in the phrase my $encd = '"=?GB2312?B?yOe6zrncwO1tbTS6w7T9tqjO78a3us2yu8Tc08PO78a3?=" '; my $e = $mmfas->new(From => $encd); isa_ok($e, $mmfas, 'read encoded'); @a = $e->addresses; cmp_ok(scalar @a, '==', 1); my $a = $a[0]; my $name = $a->name; cmp_ok(length $name, '==', 18, $name); ok(is_utf8($name), 'is utf8'); # Some bug reported by Andrew 2012-07-18 my $two = 'valid , more '; my $msg = Mail::Message->read(<<_MSG); Subject: test From: =?utf-8?B?6ZOg6L6J5Zu96ZmF6LSn6L+Q?= From: $two From: Jay Lundelius <> hey _MSG { my $head = $msg->head; my @from = $head->study('from'); # list context cmp_ok(scalar @from, '==', 3); cmp_ok(scalar $from[0]->addresses, '==', 0, 'invalid address'); cmp_ok(scalar $from[1]->addresses, '==', 2, 'valid addresses'); cmp_ok(scalar $from[2]->addresses, '==', 0, 'invalid address'); my $from = $head->study('from'); # scalar context # returns last, but only invalid # is($from, $two, 'scalar'); } Mail-Message-3.006/t/115fieldu-parse.t0000644000175000001440000000343513200571125017744 0ustar00markovusers00000000000000#!/usr/bin/env perl # # Test processing of general parsing of fields # use strict; use warnings; use Mail::Message::Test; use Mail::Message::Field::Full; use Test::More tests => 38; my $mmff = 'Mail::Message::Field::Full'; # # Test consuming phrases # my @tests = ( 'hi! this is me ' => ['hi! this is me', '' ] , ' aap, noot ' => ['aap', ', noot ' ] , '" aap, noot " ' => [' aap, noot ', ' ' ] , '"aap", "noot"' => ['aap', ', "noot"' ] , '"a\\"b\\"c" d' => ['a"b"c', ' d' ] , '"\\"b\\"" d' => ['"b"', ' d' ] , '"a\\)b\\(c" d' => ['a\\)b\\(c', ' d' ] , '' => [ undef, '' ] , ' ' => [ undef, '' ] , '" " ' => [ ' ', ' ' ] ); while(@tests) { my ($from, $to) = (shift @tests, shift @tests); my ($exp_phrase, $exp_rest) = @$to; my ($phrase, $rest) = $mmff->consumePhrase($from); is($phrase, $exp_phrase, $from); is($rest, $exp_rest, $from); } # # Test consuming comments # @tests = ( '(this is a comment) ' => [ 'this is a comment', ' ' ] , '(this)' => [ 'this', '' ] , 'this' => [ undef, 'this' ] , ' (a(b)c) ' => [ 'a(b)c', ' ' ] , '((a)b(c)) ' => [ '(a)b(c)', ' ' ] , '((a)b(c) ' => [ undef, '((a)b(c) ' ] , '(a\(b) ' => [ 'a(b', ' ' ] , '(a ' => [ undef, '(a ' ] , 'a) ' => [ undef, 'a) ' ] ); while(@tests) { my ($from, $to) = (shift @tests, shift @tests); my ($exp_comment, $exp_rest) = @$to; my ($comment, $rest) = $mmff->consumeComment($from); is($comment, $exp_comment, $from); is($rest, $exp_rest, $from); } # Mail-Message-3.006/t/118fieldu-uri.t0000644000175000001440000000361713200571125017436 0ustar00markovusers00000000000000#!/usr/bin/env perl # # Test processing of URIs # use strict; use warnings; use Mail::Message::Test; use Mail::Message::Field::URIs; use Mail::Message::Field::Full; use Test::More tests => 33; my $mmff = 'Mail::Message::Field::Full'; my $mmfu = 'Mail::Message::Field::URIs'; # # Test single URI # my $u = URI->new('http://x.org'); ok(defined $u, "uri creation"); isa_ok($u, 'URI'); is($u->scheme, 'http'); my $uf = $mmfu->new('List-Post' => $u); ok(defined $uf, "uri field creation"); isa_ok($uf, $mmfu); is($uf->string, "List-Post: \n"); is("$uf", ''); my @u = $uf->URIs; cmp_ok(@u, '==', 1); isa_ok($u[0], 'URI'); $uf = $mmfu->new('List-Post' => $u); my $u2 = $uf->addURI('mailto:x@example.com?subject=y'); ok(defined $u2, "auto-create URI"); isa_ok($u2, "URI"); @u = $uf->URIs; cmp_ok(@u, '==', 2); isa_ok($u[1], 'URI'); is($u[1]->scheme, "mailto"); is($u[1]->to, 'x@example.com'); my %headers = $u[1]->headers; is($headers{to}, 'x@example.com'); is($headers{subject}, 'y'); is($uf->string, <<'FOLDED'); List-Post: , FOLDED is("$uf", ', '); # # Test other constructions # $uf = $mmff->new("List-Post: , \n"); ok(defined $uf, "create from field"); isa_ok($uf, $mmff); isa_ok($uf, $mmfu); @u = $uf->URIs; cmp_ok(@u, '==', 2); isa_ok($u[0], 'URI'); is($u[0]->scheme, "mailto"); is($u[0]->to, 'x@y.com'); is("$u[0]", 'mailto:x@y.com'); isa_ok($u[1], 'URI'); is($u[1]->scheme, "http"); is("$u[1]", 'http://a.org/'); # modified by URI::canonical() is("$uf", ', '); is($uf->string, <<'FOLDED'); List-Post: , FOLDED $uf->beautify; is("$uf", ', '); Mail-Message-3.006/t/404msg-forwsubj.t0000644000175000001440000000121613200571125020005 0ustar00markovusers00000000000000#!/usr/bin/env perl # # Test the creation of forward subjects # use strict; use warnings; use Mail::Message::Test; use Mail::Message::Construct::Forward; use Test::More tests => 7; is(Mail::Message->forwardSubject('subject'), 'Forw: subject'); is(Mail::Message->forwardSubject('Re: subject'), 'Forw: Re: subject'); is(Mail::Message->forwardSubject('Re[2]: subject'), 'Forw: Re[2]: subject'); is(Mail::Message->forwardSubject('subject (forw)'), 'Forw: subject (forw)'); is(Mail::Message->forwardSubject('subject (Re)'), 'Forw: subject (Re)'); is(Mail::Message->forwardSubject(undef), 'Forwarded'); is(Mail::Message->forwardSubject(''), 'Forwarded'); Mail-Message-3.006/t/119fieldu-auth.t0000644000175000001440000001120013200571125017564 0ustar00markovusers00000000000000#!/usr/bin/env perl # # Test processing of Authentication-Results # use strict; use warnings; use Mail::Message::Test; use Mail::Message::Field::AuthResults; use Mail::Message::Field::Full; use Test::More tests => 42; my $mmff = 'Mail::Message::Field::Full'; my $mmfa = 'Mail::Message::Field::AuthResults'; #use Data::Dumper; # ### constructing # my $ar = $mmfa->new('Authentication-Results', server => 'example.com', version => 1); ok defined $ar, 'creation of header'; isa_ok $ar, $mmfa; is $ar->string, "Authentication-Results: example.com; none\n"; $ar->addResult(method => 'dkim', result => 'fail'); is $ar->string, "Authentication-Results: example.com; dkim=fail\n"; $ar->addResult(method => 'spf', method_version => 2, result => 'pass', comment => 'comment', 'ptype.prname' => 'tic', 'p2.p2' => 'tac'); is $ar->string, qq{Authentication-Results: example.com; dkim=fail; spf/2=pass (comment) p2.p2="tac" ptype.prname="tic"\n}; # ### Parsing # ## none my $ar1 = $mmff->new('Authentication-Results: example.com; none'); isa_ok $ar1, $mmfa; is $ar1->server, 'example.com', '1 server'; is $ar1->version, 1, '1 version'; my @results1 = $ar1->results; cmp_ok @results1, '==', 0, '1 results'; ### RFC7601 section B6 my $ar2 = $mmff->new('Authentication-Results: example.com; dkim=pass reason="good signature" header.i=@mail-router.example.net; dkim=fail reason="bad signature" header.i=@newyork.example.com'); isa_ok $ar2, $mmfa; is $ar2->server, 'example.com', '2 server'; is $ar2->version, 1, '2 version'; my @results2 = $ar2->results; cmp_ok @results2, '==', 2, '2 results'; #warn Dumper \@results2; is_deeply $results2[0], { method => 'dkim' , method_version => 1 , result => 'pass' , reason => 'good signature' , 'header.i' => '@mail-router.example.net' }, '2 results[0]'; is_deeply $results2[1], { method => 'dkim' , method_version => 1 , result => 'fail' , reason => 'bad signature' , 'header.i' => '@newyork.example.com' }, '2 results[1]'; ### RFC7601 section B5 (1) my $ar3 = $mmff->new('Authentication-Results: example.com; sender-id=fail header.from=example.com; dkim=pass (good signature) header.d=example.com'); isa_ok $ar3, $mmfa; is $ar3->server, 'example.com', '3 server'; is $ar3->version, 1, '3 version'; my @results3 = $ar3->results; cmp_ok @results3, '==', 2, '3 results'; #warn Dumper \@results3; is_deeply $results3[0], { method => 'sender-id' , method_version => 1 , result => 'fail' , 'header.from' => 'example.com' }, '3 results[0]'; is_deeply $results3[1], { method => 'dkim' , method_version => 1 , result => 'pass' , comment => 'good signature' , 'header.d' => 'example.com' }, '3 results[1]'; ### RFC7601 section B5 (2) my $ar4 = $mmff->new('Authentication-Results: example.com; auth=pass (cram-md5) smtp.auth=sender@example.com; spf=fail smtp.mailfrom=example.com'); isa_ok $ar4, $mmfa; is $ar4->server, 'example.com', '4 server'; is $ar4->version, 1, '4 version'; my @results4 = $ar4->results; cmp_ok @results4, '==', 2, '4 results'; #warn Dumper \@results4; is_deeply $results4[0], { method => 'auth' , method_version => 1 , result => 'pass' , comment => 'cram-md5' , 'smtp.auth' => 'sender@example.com' }, '4 results[0]'; is_deeply $results4[1], { method => 'spf' , method_version => 1 , result => 'fail' , 'smtp.mailfrom' => 'example.com' }, '4 results[1]'; ### RFC7601 section B2 my $ar5 = $mmff->new('Authentication-Results: example.com 2; none'); isa_ok $ar5, $mmfa; is $ar5->server, 'example.com', '5 server'; is $ar5->version, 2, '5 version'; my @results5 = $ar5->results; cmp_ok @results5, '==', 0, '5 results'; ### recover broken my $ar6 = $mmff->new('Authentication-Results: ; none'); is $ar6->server, 'unknown', '6 server'; my $ar7 = $mmff->new('Authentication-Results: example.com 42 xyz; dkim=pass'); is $ar7->server, 'example.com', '7 server'; is $ar7->version, 42; is +($ar7->results)[0]{method}, 'dkim'; # Everywhere comments my $ar8 = $mmff->new('Authentication-Results: (A) example.com (B) 2 (C); (C) auth (C2) / (C3) 1 (D) = (E) pass (cram-md5) (G) smtp (H) . (I) auth (J) = (K) sender@example.com (L) ; (M) spf (N) = (O) fail smtp (Q) . (R) mailfrom (S) = (T) example.com (U) '); ok defined $ar8, 'header with comments everywhere'; isa_ok $ar8, $mmfa; is $ar8->server, 'example.com', '8 server'; is $ar8->version, 2, '8 version'; my @results8 = $ar8->results; cmp_ok @results8, '==', 2, '8 results'; is_deeply $results8[0], $results4[0], '8 results[0]'; is_deeply $results8[1], $results4[1], '8 results[1]'; #warn Dumper $ar8; Mail-Message-3.006/t/407msg-clone.t0000644000175000001440000000306113200571125017247 0ustar00markovusers00000000000000#!/usr/bin/env perl # # Test cloning messages # use strict; use warnings; use Mail::Message; use Mail::Message::Test; use Mail::Message::Construct; use Mail::Message::Body::Lines; use Mail::Message::Body::Multipart; use Mail::Message::Body::Nested; use Test::More tests => 10; use IO::Scalar; use Mail::Address; my $p1 = Mail::Message::Body::Lines->new ( data => [ "line of text in part 1" ] , mime_type => 'text/plain' ); my $p2 = Mail::Message::Body::Lines->new ( data => [ "line of html in part 2" ] , mime_type => 'text/html' ); my $p3 = Mail::Message::Body::Lines->new ( data => [ "I know this is not postscript" ] , mime_type => 'application/postscript' ); my $p4 = Mail::Message::Body::Nested->new ( nested => $p3 ); my $mp = Mail::Message::Body::Multipart->new ( parts => [ $p1, $p2, $p4 ] ); my $msg = Mail::Message->buildFromBody ( $mp , To => 'you@home.com' , From => 'me@perl.org' ); #$msg->printStructure(\*STDERR); ok(!defined $msg->partNumber, 'part number'); my @parts = $msg->parts; cmp_ok($parts[0]->partNumber, 'eq', 1); cmp_ok($parts[1]->partNumber, 'eq', 2); cmp_ok($parts[2]->partNumber, 'eq', 3); cmp_ok($parts[2]->body->nested->partNumber, 'eq', 3); my $msg2 = $msg->clone; ok($msg2); cmp_ok($msg2->parts , "==", 3); ok($mp->part(-1)->body->isNested); my $orig_text = ''; my $orig = IO::Scalar->new(\$orig_text); $msg->print($orig); $orig->close; my $clone_text = ''; my $clone = IO::Scalar->new(\$clone_text); $msg2->print($clone); $clone->close; ok(length $orig_text); is($orig_text, $clone_text); Mail-Message-3.006/t/201head-partial.t0000644000175000001440000000173713200571125017716 0ustar00markovusers00000000000000#!/usr/bin/env perl # # Test the removing fields in partial headers. # use strict; use warnings; use Mail::Message::Test; use Mail::Message::Head::Complete; use Test::More tests => 15; use IO::Scalar; my $h = Mail::Message::Head::Complete->build ( Subject => 'this is a test' , To => 'you' , Top => 'above' , From => 'me' , 'Content-Length' => 12 , 'Content-Type' => 'text/plain' ); # lines = 6 fields + blank ok(defined $h); isa_ok($h, 'Mail::Message::Head::Complete'); isnt(ref($h), 'Mail::Message::Head::Partial'); cmp_ok($h->nrLines, '==', 7); ok(defined $h->removeFields('to')); isa_ok($h, 'Mail::Message::Head::Complete'); isa_ok($h, 'Mail::Message::Head::Partial'); cmp_ok($h->nrLines, '==', 6); ok(defined $h->get('top')); ok(! defined $h->get('to')); ok(defined $h->get('Content-Length')); ok(defined $h->removeFields( qr/^Content-/i )); isa_ok($h, 'Mail::Message::Head::Partial'); cmp_ok($h->nrLines, '==', 4); ok(!defined $h->get('Content-Length')); Mail-Message-3.006/t/322bodyconv-htmlps.t0000644000175000001440000000152613200571125020513 0ustar00markovusers00000000000000#!/usr/bin/env perl # # Test conversions from HTML/XHTML to postscript with HTML::FormatPS # use strict; use warnings; use Mail::Message::Test; use Mail::Message::Body::Lines; use Test::More; BEGIN { eval 'require HTML::FormatPS'; if($@) { plan skip_all => "requires HTML::FormatPS.\n"; exit 0; } require Mail::Message::Convert::HtmlFormatPS; plan tests => 5; } my $html = Mail::Message::Convert::HtmlFormatPS->new; my $body = Mail::Message::Body::Lines->new ( type => 'text/html' , data => $raw_html_data ); my $f = $html->format($body); ok(defined $f); ok(ref $f); isa_ok($f, 'Mail::Message::Body'); is($f->type, 'application/postscript'); is($f->transferEncoding, 'none'); # The result of the conversion is not checked, because the output # is rather large and may vary over versions of HTML::FormatPS Mail-Message-3.006/t/114fieldu-struct.t0000644000175000001440000001045313200571125020153 0ustar00markovusers00000000000000#!/usr/bin/env perl # # Test processing of general structured fields # use strict; use warnings; use Mail::Message::Test; use Mail::Message::Field::Structured; use Test::More tests => 64; my $mmff = 'Mail::Message::Field::Full'; my $mmfs = 'Mail::Message::Field::Structured'; my $mmfa = 'Mail::Message::Field::Attribute'; # # Test construction with simple body # my $a = $mmfs->new('a', 'new'); ok(defined $a, "Created simplest version"); isa_ok($a, $mmfs); isa_ok($a, $mmff); is($a->name, 'a', "Name of a"); is($a->unfoldedBody, 'new', "Unfolded body a"); my @al = $a->foldedBody; cmp_ok(@al, '==', 1, "Folded body of a"); is($al[0], " new\n"); my $b = $mmfs->new('b'); ok(defined $b, "No body specified: later"); # # LINE without new lines (no folds) # $b = $mmfs->new('b: new'); ok(defined $b, "Created b with body split"); isa_ok($b, $mmfs); isa_ok($b, $mmff); is($b->name, 'b', "Name of b"); is($b->unfoldedBody, 'new', "Unfolded body b"); my @bl = $b->foldedBody; cmp_ok(@bl, '==', 1, "Folded body of b"); is($bl[0], " new\n"); # # LINE with new-lines (folds) # my $c = $mmfs->new("c: new\n line\n"); ok(defined $c, "Created c with body split"); isa_ok($c, $mmfs); isa_ok($c, $mmff); is($c->name, 'c', "Name of c"); is($c->unfoldedBody, 'new line', "Unfolded body c"); my @cl = $c->foldedBody; cmp_ok(@cl, '==', 2, "Folded body of c"); is($cl[0], " new\n", "Folded c line 1"); is($cl[1], " line\n", "Folded c line 2"); # # Constructing # my $d = $mmfs->new('d'); ok(defined $d, "Created d"); is($d->unfoldedBody, "", "Empty body"); is($d->foldedBody, " \n", "Empty body"); is($d->datum('text/html'), 'text/html', "Set datum"); $d->beautify; # required to re-generate is($d->produceBody, "text/html", "Check datum"); is($d->unfoldedBody, "text/html"); is($d->foldedBody, " text/html\n"); ok(! defined $d->attribute('unknown'), "No attributes yet"); cmp_ok(scalar $d->attributes, '==', 0); my $da = $d->attribute(filename => 'virus.exe'); isa_ok($da, 'Mail::Message::Field::Attribute'); is($d->produceBody, 'text/html; filename="virus.exe"'); is($d->unfoldedBody, 'text/html; filename="virus.exe"'); is($d->foldedBody, qq# text/html; filename="virus.exe"\n#); # # Parsing # my $body = "(comment1)bod(aa)y(comment2); (comment3)attr1=aaa(comment4); attr2=\"b\"; attr3='c'"; my $e = $mmfs->new("e: $body\n"); ok(defined $e, "field with attributes"); is($e->datum, 'body', "Check datum"); my @attrs = $e->attributes; cmp_ok(scalar @attrs, '==', 3, "All attributes"); ok(defined $e->attribute('attr1'), "attr1 exists"); isa_ok($e->attribute('attr1'), $mmfa); is($e->attribute('attr1')->value, 'aaa',"attr1 value"); ok(defined $e->attribute('attr2'), "attr2 exists"); isa_ok($e->attribute('attr2'), $mmfa); is($e->attribute('attr2')->value, 'b', "attr2 value"); ok(defined $e->attribute('attr3'), "attr3 exists"); isa_ok($e->attribute('attr3'), $mmfa); is($e->attribute('attr3')->value, 'c', "attr3 value"); is($e->unfoldedBody, "$body", "unfolded not changed"); is($e->foldedBody, " $body\n", "folded not changed"); $e->beautify; is($e->unfoldedBody, "body; attr1=aaa; attr2=b; attr3='c'", "unfolded beautyfied"); is($e->foldedBody, " body; attr1=aaa; attr2=b; attr3='c'\n", "folded beautyfied"); # ## errors # my $f = $mmfs->new('f: c; a="missing quote'); # bug report #31017 ok(defined $f, 'missing quote'); is($f->unfoldedBody, 'c; a="missing quote'); is($f->foldedBody, " c; a=\"missing quote\n"); my $fa = $f->attribute('a'); ok(defined $fa, 'f attribute a'); is($fa->string, '; a=missing quote'); is($fa->value, 'missing quote'); my $g = $mmfs->new('g: c; a="with []"'); # bug report #31912 ok(defined $g, '[]'); my $ga = $g->attribute('a'); ok(defined $ga); is($ga->value, 'with []'); my $gb = $mmfs->new('g: c; filename=xxxx[1].pif'); ok(defined $gb, 'xxxx[1].pif'); my $gc = $gb->attribute('filename'); ok(defined $gc); is($gc->value, 'xxxx[1].pif'); Mail-Message-3.006/t/203-mlfolder.mbox0000644000175000001440000012153413200571125017746 0ustar00markovusers00000000000000From root@home.etla.org Sat Jan 20 13:37:58 2001 Envelope-to: usenet@home.etla.org Received: from root by pool.home.etla.org with local (Exim 3.12 #1 (Debian)) id 14JyDO-00006n-00 for ; Sat, 20 Jan 2001 13:37:58 +0000 To: usenet@home.etla.org Subject: innwatch warning: messages in /var/log/news/news.crit Message-Id: From: root Date: Sat, 20 Jan 2001 13:37:58 +0000 Status: RO Content-Length: 1824 Lines: 34 -rw-r--r-- 1 root news 1550 Jan 19 21:51 /var/log/news/news.crit ----- Server running Allowing remote connections Parameters c 14 i 50 (0) l 1000000 o 1011 t 300 H 2 T 60 X 0 normal specified Not reserved Readers separate enabled Perl filtering enabled ----- Nov 7 23:37:27 pool innd: SERVER shutdown received signal 15 Nov 7 23:40:13 pool innd: SERVER shutdown received signal 15 Nov 8 00:02:11 pool innd: SERVER shutdown received signal 15 Nov 8 01:07:00 pool innd: SERVER shutdown received signal 15 Nov 9 23:37:20 pool innd: SERVER shutdown received signal 15 Nov 10 23:37:26 pool innd: SERVER shutdown received signal 15 Nov 12 01:35:44 pool innd: SERVER shutdown received signal 15 Nov 12 19:24:33 pool innd: SERVER shutdown received signal 15 Nov 12 23:33:52 pool innd: SERVER shutdown received signal 15 Nov 13 23:05:11 pool innd: SERVER shutdown received signal 15 Nov 14 22:09:04 pool innd: SERVER shutdown received signal 15 Nov 15 22:52:53 pool innd: SERVER shutdown received signal 15 Nov 18 14:31:53 pool innd: SERVER shutdown received signal 15 Nov 23 07:44:13 pool innd: SERVER shutdown received signal 15 Nov 24 08:11:38 pool innd: SERVER shutdown received signal 15 Nov 29 23:42:48 pool innd: SERVER shutdown received signal 15 Dec 17 18:07:43 pool innd: SERVER shutdown received signal 15 Dec 17 22:47:32 pool innd: SERVER shutdown received signal 15 Dec 23 15:50:30 pool innd: SERVER shutdown received signal 15 Jan 14 12:41:56 pool innd: SERVER shutdown received signal 15 Jan 14 12:45:33 pool innd: SERVER shutdown received signal 15 Jan 15 01:09:26 pool innd: SERVER shutdown received signal 15 Jan 17 23:42:55 pool innd: SERVER shutdown received signal 15 Jan 18 22:35:34 pool innd: SERVER shutdown received signal 15 Jan 19 21:51:19 pool innd: SERVER shutdown received signal 15 From templates-admin@template-toolkit.org Tue Nov 28 21:17:30 2000 Envelope-to: mstevens@firedrake.org Received: from trinity.fluff.org [194.153.168.225] (mail) by dayspring.firedrake.org with esmtp (Exim 3.12 #1 (Debian)) id 140s82-0007x1-00; Tue, 28 Nov 2000 21:17:30 +0000 Received: from www.ourshack.com (dog.ourshack.com) [212.74.28.146] by trinity.fluff.org helo dog.ourshack.com with esmtp (Exim 3.12) id 140s81-0003hh-00 for michael@etla.org ; Tue, 28 Nov 2000 21:17:29 +0000 Received: from localhost.ourshack.com ([127.0.0.1] helo=dog.ourshack.com) by dog.ourshack.com with esmtp (Exim 3.16 #1) id 140t7Y-000KE6-00; Tue, 28 Nov 2000 22:21:04 +0000 Received: from dayspring.firedrake.org ([195.82.105.251] ident=mail) by dog.ourshack.com with esmtp (Exim 3.16 #1) id 140t6i-000KDq-00 for templates@template-toolkit.org; Tue, 28 Nov 2000 22:20:12 +0000 Received: from mstevens by dayspring.firedrake.org with local (Exim 3.12 #1 (Debian)) id 140s6M-0007sK-00; Tue, 28 Nov 2000 21:15:46 +0000 From: Michael Stevens To: templates@template-toolkit.org Message-ID: <20001128211546.A29664@firedrake.org> Mail-Followup-To: templates@template-toolkit.org Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii Content-Disposition: inline User-Agent: Mutt/1.2.5i Subject: [Templates] ttree problems - the sequel Sender: templates-admin@template-toolkit.org Errors-To: templates-admin@template-toolkit.org X-BeenThere: templates@template-toolkit.org X-Mailman-Version: 2.0rc1 Precedence: bulk List-Help: List-Post: List-Subscribe: , List-Id: Template Toolkit mailing list List-Unsubscribe: , List-Archive: Date: Tue, 28 Nov 2000 21:15:46 +0000 Status: RO Hi. I finally had time to debug my problems with pre_process and ttree in more detail. It turned out that ttree thinks PRE_PROCESS and POST_PROCESS are multiple value fields, so it returns the values supplied for them as arrays, eg pre_process = foo:bar is sent to Template as PRE_PROCESS => [ 'foo:bar' ]. The delimiter splitting routines in Template::Service only split up if values are scalars rather than array references, so it wasn't getting split, and therefore it tried to pre_process the file 'foo:bar'. ttree learnt that those two fields were arrays sometime between beta5 and rc2, I'm not sure why. One fix, as far as I can tell, is to apply this patch: --cut here for patch-- diff -urN Template-Toolkit-2.00-rc2.orig/bin/ttree Template-Toolkit-2.00-rc2/bin/ttree --- Template-Toolkit-2.00-rc2.orig/bin/ttree Tue Nov 28 20:56:28 2000 +++ Template-Toolkit-2.00-rc2/bin/ttree Tue Nov 28 20:57:18 2000 @@ -324,8 +324,8 @@ 'template_pre_chomp|pre_chomp|prechomp', 'template_post_chomp|post_chomp|postchomp', 'template_trim|trim', - 'template_pre_process|pre_process|preprocess=s@', - 'template_post_process|post_process|postprocess=s@', + 'template_pre_process|pre_process|preprocess=s', + 'template_post_process|post_process|postprocess=s', 'template_process|process=s', 'template_default|default=s', 'template_error|error=s', --cut here for patch-- Which reverts this change. However, if this was originally done for a good reason, it's not the end of the story. The modified version passes all tests still, but I can't see that they actually exercise ttree. Michael _______________________________________________ templates mailing list templates@template-toolkit.org http://www.template-toolkit.org/mailman/listinfo/templates From nick@ccl4.org Sat Jan 20 22:25:52 2001 Envelope-to: mstevens@firedrake.org Received: from paladin.globnix.org [195.11.247.40] by dayspring.firedrake.org with esmtp (Exim 3.12 #1 (Debian)) id 14K6SG-0006b2-00; Sat, 20 Jan 2001 22:25:52 +0000 Received: from tmtowtdi.perl.org ([209.85.3.25] ident=qmailr) from qmailr by paladin.globnix.org with smtp id 14K6SF-0008JY-00 for mstevens@globnix.org; Sat, 20 Jan 2001 22:25:52 +0000 Received: (qmail 6144 invoked by uid 508); 20 Jan 2001 22:25:48 -0000 Mailing-List: contact perl5-porters-help@perl.org; run by ezmlm Precedence: bulk list-help: list-unsubscribe: list-post: Delivered-To: mailing list perl5-porters@perl.org Received: (qmail 6135 invoked from network); 20 Jan 2001 22:25:47 -0000 Received: from plum.flirble.org (exim@195.40.6.20) by tmtowtdi.perl.org with SMTP; 20 Jan 2001 22:25:47 -0000 Received: from nick by plum.flirble.org with local (Exim 3.20 #3) id 14K6SA-0003BQ-00 for perl5-porters@perl.org; Sat, 20 Jan 2001 22:25:46 +0000 Date: Sat, 20 Jan 2001 22:22:51 +0000 From: Nicholas Clark To: perlbug@perl.org Subject: qu() exposes utf8 hash key problem Message-ID: <20010120222250.A10531@plum.flirble.org> Mime-Version: 1.0 Content-Type: text/plain; charset=iso-8859-1 Content-Disposition: inline Content-Transfer-Encoding: 8bit User-Agent: Mutt/1.2.5i X-Organisation: Tetrachloromethane Resent-From: nick@plum.flirble.org Resent-Date: Sat, 20 Jan 2001 22:25:46 +0000 Resent-To: perl5-porters@perl.org Resent-Message-Id: Status: RO This is a bug report for perl from nick@talking.bollo.cx, generated with the help of perlbug 1.33 running under perl v5.7.0. ----------------------------------------------------------------- [Please enter your report here] using the utf8 representation of codepoints 128-255 as a hash key seems to produce some undesirable effects. [I'm using a '' (pound sterling) as my test character - if this gets stripped to 7 bit you will see hash '#'. The next hash after this sentence is in the OS version "2.2.17-rmk1 #9"] I assume that these occur with substr and utf8 scalars, but they are very easy to make with the new qu operator the strings are equal, which (I believe) is correct: perl -le '$uni = qu(); $eight = ""; print $uni eq $eight' 1 however, interesting things start happening with hash keys: perl -MDevel::Peek -le '$a{qu()} = "foo"; $a{""} = "bar" ; foreach (keys %a) {Dump($_)}' SV = PVIV(0x20d8690) at 0x20d7e94 REFCNT = 2 FLAGS = (POK,FAKE,READONLY,pPOK) IV = 168 PV = 0x20e40a0 "\243" CUR = 1 LEN = 0 SV = PVIV(0x20d86e0) at 0x20e25d0 REFCNT = 2 FLAGS = (POK,FAKE,READONLY,pPOK,UTF8) IV = 6770 PV = 0x20e3eb8 "\302\243" CUR = 2 LEN = 0 I shouldn't get 2 hash entries should I? [for the FAKE,READONLY SV the hash value is cached in the IV, so you can see that the two representations have hashed to different numbers] perl -wle '$a{qu()} = "foo"; $a{qw()} = "bar" ; foreach (keys %a) {print $_};' Attempt to free non-existent shared string ''. perl -wle '$uni = qu(); $eight = ""; $a{$uni} = "foo"; $a{$eight} = "bar"; foreach (keys %a) {print $a{$_}}' bar foo perl -wle '$uni = qu(); $eight = ""; $a{$uni} = "foo"; $a{$eight} = "bar"; foreach (keys %a) {print $_; print $a{$_}}' bar Use of uninitialized value in print at -e line 1. Attempt to free non-existent shared string ''. the warnings are explained by: perl -MDevel::Peek -wle '$uni = qu(); $eight = ""; $a{$uni} = "foo"; $a{$eight} = "bar"; foreach (keys %a) {print $_; Dump($_)}' SV = PVIV(0x20d8690) at 0x20d7e94 REFCNT = 2 FLAGS = (POK,FAKE,READONLY,pPOK) IV = 168 PV = 0x20e07e0 "\243" CUR = 1 LEN = 0 SV = PVIV(0x20d86c0) at 0x20e25f8 REFCNT = 2 FLAGS = (POK,FAKE,READONLY,pPOK) IV = 6770 PV = 0x20dbd88 "\243" CUR = 1 LEN = 0 Attempt to free non-existent shared string ''. *something* is feeling quite happy to mess with a readonly scalar for information 1: it seems no errors are currently being generated if shared strings remain at global destruction time. 2: SvREADONLY_off() is a scary thing. Perl_ck_require uses it indiscriminately without force_normal to append ".pm" (would a patch be wanted for that? It doesn't affect anything *yet*). I'm guessing something else is doing something equally horrible on output. I guess we need a canonical representation for hash keys which at least one codepoint in the range 128-255 but none >255. Possibly downgraded to 8 bit. Or possibly upgraded to utf8. Sorry, I have not patches for the above things. Nicholas Clark [Please do not change anything below this line] ----------------------------------------------------------------- --- Flags: category=core severity=medium --- Site configuration information for perl v5.7.0: Configured by nick at Thu Jan 18 19:24:14 GMT 2001. Summary of my perl5 (revision 5.0 version 7 subversion 0) configuration: Platform: osname=linux, osvers=2.2.17-rmk1, archname=armv4l-linux uname='linux bagpuss.unfortu.net 2.2.17-rmk1 #9 fri dec 8 23:52:12 gmt 2000 armv4l unknown ' config_args='-Dusedevel -Ubincompat5005 -Uinstallusrbinperl -Dcf_email=nick@talking.bollo.cx -Dperladmin=nick@talking.bollo.cx -Dinc_version_list= -Dinc_version_list_init=0 -Duseperlio -des' hint=recommended, useposix=true, d_sigaction=define usethreads=undef use5005threads=undef useithreads=undef usemultiplicity=undef useperlio=define d_sfio=undef uselargefiles=define usesocks=undef use64bitint=undef use64bitall=undef uselongdouble=undef Compiler: cc='cc', ccflags ='-fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64', optimize='-O2', cppflags='-fno-strict-aliasing -I/usr/local/include' ccversion='', gccversion='2.95.2 20000220 (Debian GNU/Linux)', gccosandvers='' intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234 d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=8 ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8 alignbytes=4, usemymalloc=n, prototype=define Linker and Libraries: ld='cc', ldflags =' -L/usr/local/lib' libpth=/usr/local/lib /lib /usr/lib libs=-lnsl -lndbm -ldb -ldl -lm -lc -lposix -lcrypt -lutil perllibs=-lnsl -ldl -lm -lc -lposix -lcrypt -lutil libc=/lib/libc-2.1.3.so, so=so, useshrplib=false, libperl=libperl.a Dynamic Linking: dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-rdynamic' cccdlflags='-fpic', lddlflags='-shared -L/usr/local/lib' Locally applied patches: DEVEL8452 --- @INC for perl v5.7.0: /usr/local/lib/perl5/5.7.0/armv4l-linux /usr/local/lib/perl5/5.7.0 /usr/local/lib/perl5/site_perl/5.7.0/armv4l-linux /usr/local/lib/perl5/site_perl/5.7.0 /usr/local/lib/perl5/site_perl . --- Environment for perl v5.7.0: HOME=/home/nick LANG (unset) LANGUAGE (unset) LC_CTYPE=en_GB.ISO-8859-1 LD_LIBRARY_PATH (unset) LOGDIR (unset) PATH=/home/nick/bin:/usr/local/bin:/usr/bin:/bin:/usr/bin/X11:/usr/games:/sbin:/usr/sbin:/usr/local/sbin PERL_BADLANG (unset) SHELL=/bin/bash From bounce-debian-devel=zal=debian.org@lists.debian.org Wed Jan 9 16:19:33 2002 X-Envelope-From: bounce-debian-devel=zal=debian.org@lists.debian.org Wed Jan 9 16:19:33 2002 Return-Path: Delivered-To: laz+debian@clustermonkey.org Received: from master.debian.org (master.debian.org [216.234.231.5]) by x-o.clustermonkey.org (Postfix) with ESMTP id 0DCF661EB84 for ; Wed, 9 Jan 2002 16:19:33 -0500 (EST) Received: from murphy.debian.org [216.234.231.6] by master.debian.org with smtp (Exim 3.12 1 (Debian)) id 16OQ8C-0004ll-00; Wed, 09 Jan 2002 15:19:32 -0600 Received: (qmail 22818 invoked by uid 38); 9 Jan 2002 21:07:42 -0000 X-Envelope-Sender: debbugs@master.debian.org Received: (qmail 22385 invoked from network); 9 Jan 2002 21:07:37 -0000 Received: from master.debian.org (mail@216.234.231.5) by murphy.debian.org with SMTP; 9 Jan 2002 21:07:37 -0000 Received: from debbugs by master.debian.org with local (Exim 3.12 1 (Debian)) id 16OPvY-0003bQ-00; Wed, 09 Jan 2002 15:06:28 -0600 X-Loop: owner@bugs.debian.org Subject: Bug#128487: ITP: ferite -- Ferite programming language Reply-To: Eric Dorland , 128487@bugs.debian.org Resent-From: Eric Dorland Original-Sender: Eric Resent-To: debian-bugs-dist@lists.debian.org Resent-Cc: debian-devel@lists.debian.org, wnpp@debian.org Resent-Date: Wed, 09 Jan 2002 21:06:27 GMT Resent-Message-ID: X-Debian-PR-Message: report 128487 X-Debian-PR-Package: wnpp Received: via spool by submit@bugs.debian.org id=B.101061021111054 (code B ref -1); Wed, 09 Jan 2002 21:06:27 GMT From: Eric Dorland To: Debian Bug Tracking System X-Reportbug-Version: 1.41.14213 X-Mailer: reportbug 1.41.14213 Date: Wed, 09 Jan 2002 16:03:25 -0500 Message-Id: Sender: Eric Delivered-To: submit@bugs.debian.org X-Mailing-List: archive/latest/105153 X-Loop: debian-devel@lists.debian.org Precedence: list Resent-Sender: debian-devel-request@lists.debian.org Status: RO Package: wnpp Version: N/A; reported 2002-01-09 Severity: wishlist * Package name : ferite Version : 0.99.4 Upstream Author : Chris Ross (boris) * URL : http://www.ferite.org/ * License : BSD Description : Ferite programming language Ferite is a language that incorporates the design philosophies of other languages, but without many of their drawbacks. It has strong similiarities to perl, python, C, Java and pascal, while being both lightweight, modular, and embeddable. -- System Information Debian Release: 3.0 Architecture: i386 Kernel: Linux apocalypse 2.4.16 #1 Fri Nov 30 14:38:38 EST 2001 i686 Locale: LANG=en_US, LC_CTYPE= -- To UNSUBSCRIBE, email to debian-devel-request@lists.debian.org with a subject of "unsubscribe". Trouble? Contact listmaster@lists.debian.org From owner-london-pm@lists.dircon.co.uk Sun Jan 21 17:08:14 2001 Envelope-to: michael@etla.org Received: from lists.dircon.co.uk [194.112.50.5] by dayspring.firedrake.org with esmtp (Exim 3.12 #1 (Debian)) id 14KNyQ-0007mp-00; Sun, 21 Jan 2001 17:08:14 +0000 Received: (from majordom@localhost) by lists.dircon.co.uk (8.9.3/8.9.3) id RAA28531 for michael@etla.org; Sun, 21 Jan 2001 17:08:13 GMT X-Authentication-Warning: lists.dircon.co.uk: majordom set sender to owner-london-pm@lists.dircon.co.uk using -f Received: from dayspring.firedrake.org (mail@dayspring.firedrake.org [195.82.105.251]) by lists.dircon.co.uk (8.9.3/8.9.3) with ESMTP id RAA28043 for ; Sun, 21 Jan 2001 17:07:23 GMT Received: from mstevens by dayspring.firedrake.org with local (Exim 3.12 #1 (Debian)) id 14KNxb-0007mH-00; Sun, 21 Jan 2001 17:07:23 +0000 Date: Sun, 21 Jan 2001 17:07:23 +0000 From: Michael Stevens To: london-pm@lists.dircon.co.uk Subject: Mail::ListDetector - please test Message-ID: <20010121170723.A29498@firedrake.org> Mail-Followup-To: london-pm@lists.dircon.co.uk Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii Content-Disposition: inline User-Agent: Mutt/1.2.5i X-Phase-Of-Moon: The Moon is Waning Crescent (7% of Full) Sender: owner-london-pm@lists.dircon.co.uk Precedence: bulk Reply-To: london-pm@lists.dircon.co.uk Status: RO Hi. I have an (as yet unreleased) module called Mail::ListDetector, which takes a Mail::Internet object, and attempts to tell you if the message involved was posted to a mailing list, and if so, attempts to get some details about that list. I need testers - in particular, see if it builds and passes tests for you, and throw lots of messages at the sample script and see if you can get it to be inaccurate for any of them. If you can, please send me the message in question. (if you don't want to give out the content, just headers should do). Currently it should know about majordomo, smartlist, ezmlm, and mailman, although the majordomo and smartlist guessers are a bit experimental. It's at: http://www.etla.org/Mail-ListDetector-0.05.tar.gz Michael From - Wed Feb 14 09:49:48 2001 Return-Path: Received: from listes.cru.fr (listes.cru.fr [195.220.94.165]) by home.cru.fr (8.9.3/jtpda-5.3.1) with ESMTP id JAA26395 ; Wed, 14 Feb 2001 09:49:23 +0100 Received: from (sympa@localhost) by listes.cru.fr (8.9.3/jtpda-5.3.2) id JAA07499 ; Wed, 14 Feb 2001 09:49:23 +0100 Sender: Olivier.Salaun@cru.fr Message-ID: <3A8A4691.70332989@cru.fr> Date: Wed, 14 Feb 2001 09:49:21 +0100 From: Olivier Salaun Organization: CRU X-Mailer: Mozilla 4.74 [en] (X11; U; Linux 2.2.16-3 i686) X-Accept-Language: en MIME-Version: 1.0 To: noustestons@cru.fr Subject: This is a sample message X-Loop: noustestons@cru.fr X-Sequence: 168 Precedence: list List-Help: List-Subscribe: List-Unsubscribe: List-Post: List-Owner: List-Archive: Content-type: multipart/mixed; boundary="----------=_982140563-24435-126" Content-Transfer-Encoding: 8bit X-Mozilla-Status: 8001 X-Mozilla-Status2: 00000000 This is a multi-part message in MIME format... ------------=_982140563-24435-126 Content-Type: text/plain; charset=iso-8859-1 Content-Transfer-Encoding: 8bit Hope it helps.... -- Olivier Salan Comit Rseaux des Universits ------------=_982140563-24435-126 Content-Type: text/plain; name="message.footer" Content-Disposition: inline; filename="message.footer" Content-Transfer-Encoding: 8bit fgdfgdfgdfdg ------------=_982140563-24435-126-- From adm-bounce@oasys.net Mon Jun 4 06:41:14 2001 Received: from thufir.oasys.net (oasys.net [216.227.134.4]) by nani.mikomi.org (8.9.3/8.9.3) with ESMTP id GAA08314 for ; Mon, 4 Jun 2001 06:41:13 -0400 Received: from thufir (thufir [127.0.0.1]) by thufir.oasys.net (Postfix) with ESMTP id 345138003; Mon, 4 Jun 2001 06:41:12 -0400 (EDT) Received: with LISTAR (v0.129a; list adm); Mon, 04 Jun 2001 06:41:12 -0400 (EDT) Delivered-To: adm@oasys.net Received: from nani.mikomi.org (nani.mikomi.org [216.227.135.6]) by thufir.oasys.net (Postfix) with ESMTP id 8AF917FC1 for ; Mon, 4 Jun 2001 06:41:10 -0400 (EDT) Received: (from turner@localhost) by nani.mikomi.org (8.9.3/8.9.3) id GAA08291; Mon, 4 Jun 2001 06:41:07 -0400 X-Authentication-Warning: nani.mikomi.org: turner set sender to turner@mikomi.org using -f Date: Mon, 4 Jun 2001 06:41:07 -0400 From: Andrew Turner To: Seikihyougen Cc: adm@oasys.net Subject: [adm] Marvin Minsky AI Talk Message-Id: <20010604064107.A6940@mikomi.org> Mail-Followup-To: Seikihyougen , adm@oasys.net MIME-Version: 1.0 Content-Type: text/plain; charset=us-ascii Content-Disposition: inline User-Agent: Mutt/1.3.14i X-Archive-Position: 161 X-Listar-Version: Listar v0.129a Sender: adm-bounce@oasys.net Errors-To: adm-bounce@oasys.net X-Original-Sender: turner@mikomi.org Precedence: list Reply-To: adm@oasys.net X-List: adm Status: RO Content-Length: 498 Lines: 21 An intersting talk he gave at the Game Developers Conference 2001. Video: rtsp://media.cmpnet.com/twtoday_media/realtest/tnc-gdc2k1-prog.rm Audio: http://199.125.85.76/ftp/technetcast/mp3/tnc-0526-24.mp3 Transcript: http://technetcast.ddj.com/tnc_play_stream.html?stream_id=526 -- Andy - http://anime.mikomi.org/ - Community Anime Reviews And the moral of this message is... Let the meek inherit the earth -- they have it coming to them. -- James Thurber From sentto-482527-3071-992625570-turner=mikomi.org@returns.onelist.com Fri Jun 15 13:21:26 2001 Return-Path: Received: from ef.egroups.com (ef.egroups.com [64.211.240.229]) by undef.jmac.org (8.11.0/8.11.0) with SMTP id f5FHLPl26276 for ; Fri, 15 Jun 2001 13:21:26 -0400 Received: from [10.1.4.54] by ef.egroups.com with NNFMP; 15 Jun 2001 17:19:30 -0000 Received: (qmail 74089 invoked from network); 15 Jun 2001 17:19:29 -0000 Received: from unknown (10.1.10.26) by l8.egroups.com with QMQP; 15 Jun 2001 17:19:29 -0000 Received: from unknown (HELO c9.egroups.com) (10.1.2.66) by mta1 with SMTP; 15 Jun 2001 17:19:29 -0000 X-Egroups-Return: turner@undef.jmac.org Received: from [10.1.2.91] by c9.egroups.com with NNFMP; 15 Jun 2001 17:19:28 -0000 X-Egroups-Approved-BY: lordtenchimasaki@planetjurai.com via web; 15 Jun 2001 17:19:26 -0000 X-Sender: turner@undef.jmac.org X-Apparently-To: ryokoforever@yahoogroups.com Received: (EGP: mail-7_1_3); 15 Jun 2001 15:04:27 -0000 Received: (qmail 72431 invoked from network); 15 Jun 2001 15:04:26 -0000 Received: from unknown (10.1.10.26) by l7.egroups.com with QMQP; 15 Jun 2001 15:04:26 -0000 Received: from unknown (HELO undef.jmac.org) (199.232.41.30) by mta1 with SMTP; 15 Jun 2001 15:04:26 -0000 Received: (from turner@localhost) by undef.jmac.org (8.11.0/8.11.0) id f5FF54H25878 for ryokoforever@yahoogroups.com; Fri, 15 Jun 2001 11:05:04 -0400 To: ryokoforever@yahoogroups.com Message-Id: <20010615110504.F23926@mikomi.org> References: <65.15c83c77.285a1ed0@aol.com> <9gc0tj+9u4r@eGroups.com> User-Agent: Mutt/1.2.5i In-Reply-To: <9gc0tj+9u4r@eGroups.com>; from gensao@yahoo.com on Fri, Jun 15, 2001 at 03:54:27AM -0000 From: Andrew Turner MIME-Version: 1.0 Mailing-List: list ryokoforever@yahoogroups.com; contact ryokoforever-owner@yahoogroups.com Delivered-To: mailing list ryokoforever@yahoogroups.com Precedence: list List-Unsubscribe: Date: Fri, 15 Jun 2001 11:05:04 -0400 Reply-To: ryokoforever@yahoogroups.com Subject: [ryokoforever] Re: [ryokoforever] Re: Fan Fiction Websites Content-Type: text/plain; charset=US-ASCII Content-Transfer-Encoding: 7bit Status: RO Content-Length: 631 Lines: 16 Yeah, I'm really sorry about all this. The stupid cable company has been very unhelpful in getting my cable modem back online... I'll be moving my machine (and thus, the domains hosted with it like tmffa.com) to a colo environment very soon, which should put an end to down time. -- Andy To unsubscribe from this group, send an email to: ryokoforever-unsubscribe@egroups.com Your use of Yahoo! Groups is subject to http://docs.yahoo.com/info/terms/ From london.pm-admin@london.pm.org Fri Aug 17 13:47:55 2001 Return-Path: Received: from punt-2.mail.demon.net by mailstore for lpm@mirth.demon.co.uk id 998052475:20:20927:5; Fri, 17 Aug 2001 12:47:55 GMT Received: from penderel.state51.co.uk ([193.82.57.128]) by punt-2.mail.demon.net id aa2103774; 17 Aug 2001 12:47 GMT Received: from penderel ([127.0.0.1] helo=penderel.state51.co.uk) by penderel.state51.co.uk with esmtp (Exim 3.03 #1) id 15Xj23-0004Oi-00; Fri, 17 Aug 2001 13:47:23 +0100 Received: from plough.barnyard.co.uk ([195.149.50.61]) by penderel.state51.co.uk with esmtp (Exim 3.03 #1) id 15Xj1T-0004OQ-00 for london.pm@london.pm.org; Fri, 17 Aug 2001 13:46:47 +0100 Received: from richardc by plough.barnyard.co.uk with local (Exim 3.13 #1) id 15Xj1E-0006Wp-00 for london.pm@london.pm.org; Fri, 17 Aug 2001 13:46:32 +0100 From: Richard Clamp To: london.pm@london.pm.org Subject: Re: better header Message-Id: <20010817134539.A9368@mirth.demon.co.uk> References: <170801229.13787@webbox.com> <20010817122254.B18192@mccarroll.demon.co.uk> MIME-Version: 1.0 Content-Type: text/plain; charset=us-ascii Content-Disposition: inline In-Reply-To: <20010817122254.B18192@mccarroll.demon.co.uk> User-Agent: Mutt/1.3.20i Sender: london.pm-admin@london.pm.org Errors-To: london.pm-admin@london.pm.org X-Beenthere: london.pm@london.pm.org X-Mailman-Version: 2.0.1 Precedence: bulk Reply-To: london.pm@london.pm.org List-Id: London.pm Perl M[ou]ngers List-Archive: Date: Fri, 17 Aug 2001 13:45:39 +0100 Status: RO Content-Length: 439 Lines: 12 On Fri, Aug 17, 2001 at 12:22:54PM +0100, Greg McCarroll wrote: > testing a reply to the announce list Could someone extend the hacks committed into changing the headers and the like, then they'd not be auto-filtered to the same place by such fine modules as Mail::ListDetector or lesser homebrew systems such as my own. The announce lists rocks, but that'd just make it rock so much harder. -- Richard Clamp From adm-bounce@oasys.net Mon Jun 4 06:41:14 2001 Received: from thufir.oasys.net (oasys.net [216.227.134.4]) by nani.mikomi.org (8.9.3/8.9.3) with ESMTP id GAA08314 for ; Mon, 4 Jun 2001 06:41:13 -0400 Received: from thufir (thufir [127.0.0.1]) by thufir.oasys.net (Postfix) with ESMTP id 345138003; Mon, 4 Jun 2001 06:41:12 -0400 (EDT) Received: with ECARTIS (v1.0.0; list adm); Mon, 04 Jun 2001 06:41:12 -0400 (EDT) Delivered-To: adm@oasys.net Received: from nani.mikomi.org (nani.mikomi.org [216.227.135.6]) by thufir.oasys.net (Postfix) with ESMTP id 8AF917FC1 for ; Mon, 4 Jun 2001 06:41:10 -0400 (EDT) Received: (from turner@localhost) by nani.mikomi.org (8.9.3/8.9.3) id GAA08291; Mon, 4 Jun 2001 06:41:07 -0400 X-Authentication-Warning: nani.mikomi.org: turner set sender to turner@mikomi.org using -f Date: Mon, 4 Jun 2001 06:41:07 -0400 From: Andrew Turner To: Seikihyougen Cc: adm@oasys.net Subject: [adm] Marvin Minsky AI Talk Message-Id: <20010604064107.A6940@mikomi.org> Mail-Followup-To: Seikihyougen , adm@oasys.net MIME-Version: 1.0 Content-Type: text/plain; charset=us-ascii Content-Disposition: inline User-Agent: Mutt/1.3.14i X-Archive-Position: 161 X-Ecartis-Version: Ecartis v1.0.0 Sender: adm-bounce@oasys.net Errors-To: adm-bounce@oasys.net X-Original-Sender: turner@mikomi.org Precedence: list Reply-To: adm@oasys.net X-List: adm Status: RO Content-Length: 498 Lines: 21 An intersting talk he gave at the Game Developers Conference 2001. Video: rtsp://media.cmpnet.com/twtoday_media/realtest/tnc-gdc2k1-prog.rm Audio: http://199.125.85.76/ftp/technetcast/mp3/tnc-0526-24.mp3 Transcript: http://technetcast.ddj.com/tnc_play_stream.html?stream_id=526 -- Andy - http://anime.mikomi.org/ - Community Anime Reviews And the moral of this message is... Let the meek inherit the earth -- they have it coming to them. -- James Thurber From adm-bounce@oasys.net Mon Jun 4 06:41:14 2001 Return-Path: Received: from by freeonline.com.au (CommuniGate Pro RULES 4.0.6) with RULES id 360012; Fri, 14 Mar 2003 01:00:12 +0000 X-ListServer: CommuniGate Pro LIST 4.0.6 List-Unsubscribe: List-ID: Message-ID: Reply-To: Sender: To: Precedence: list X-Original-Message-Id: Date: Fri, 14 Mar 2003 12:00:05 +1100 From: Matthew Walker Subject: Hello to the Mail-ListDetector Mailing List at gunzel.org MIME-Version: 1.0 Content-Type: text/plain; charset="us-ascii" ; format="flowed" This is a sample message for use in automated testing. Regards Matthew ############################################################# This message is sent to you because you are subscribed to the mailing list . To unsubscribe, E-mail to: To switch to the DIGEST mode, E-mail to To switch to the INDEX mode, E-mail to Send administrative queries to From adm-bounce@oasys.net Mon Jun 4 06:41:14 2001 Date: Sun, 11 Nov 2001 02:19:29 +0900 From: Foobar Reply-To: mlname@domain.example.com Subject: [mlname:07389] add new member To: mlname@domain.example.com (mlname ML) Message-Id: <20011111021844.0836.foo@domain.example.com> X-ML-Name: mlname X-Mail-Count: 07389 X-MLServer: fml [fml 4.0 STABLE (20010208)]; post only (only members can post) X-ML-Info: If you have a question, send e-mail with the body "help" (without quotes) to the address mlname-ctl@domain.example.com; help= X-Mailer: Becky! ver. 2.00.07 Mime-Version: 1.0 Content-Type: text/plain; charset="ISO-2022-JP" Content-Transfer-Encoding: 7bit Precedence: bulk Lines: 1 List-Software: fml [fml 4.0 STABLE (20010208)] List-Post: List-Owner: List-Help: List-Unsubscribe: Status: RO This is a message From adm-bounce@oasys.net Mon Jun 4 06:41:14 2001 Received: from mldetector.net (msv-x05.mldetector.ne.jp [10.158.32.3]) by ml.mldetector.gr.jp (8.9.3p2/3.7W/) with ESMTP id AAA74508 for ; Thu, 17 Jul 2003 01:52:35 +0900 (JST) Received: from denshadego (whrr.hou.mldetector.net [10.12.6.189]) (authenticated (0 bits)) by mldetector.net (8.12.5/8.11.2) with ESMTP id 732h6GFqXkO002877 for ; Thu, 17 Jul 2003 01:52:32 +0900 Date: Thu, 17 Jul 2003 01:52:22 +0900 From: "Densha De Go" Reply-To: Announce@mldetector.gr.jp Subject: [Announce:00089] Web mldetector To: Message-Id: <00a801c34bb2$4jhasjdh58udsc0@orient.corp.mldetector.com> X-ML-Name: Announce X-Mail-Count: 00089 X-MLServer: fml [fml 4.0 STABLE (20010218)](fml commands only mode); post only only members can post) X-ML-Info: If you have a question, please contact Announce-admin@mldetector.gr.jp; X-Mailer: Microsoft Outlook Express 6.00.2800.1158 Mime-Version: 1.0 Content-Type: text/plain; charset="iso-2022-jp" Content-Transfer-Encoding: 7bit Precedence: bulk List-Subscribe: Resent-From: denshadego@yo.mldetector.or.jp Resent-To: Announce@mldetector.gr.jp (moderated) Resent-Date: Thu, 17 Jul 2003 00:52:57 +0900 Resent-Message-Id: <200307170052.FMLAAB99994.Announce@mldetector.gr.jp> One line of body From adm-bounce@oasys.net Mon Jun 4 06:41:14 2001 Return-Path: Received: from rime.listbox.com ([216.65.124.73] verified) by freeonline.com.au (CommuniGate Pro SMTP 4.0.6) with ESMTP id 452321 for mld-listbox@walker.wattle.id.au; Tue, 17 Jun 2003 20:16:02 +0000 Received: by rime.listbox.com (Postfix, from userid 440) id 7378ADF7381; Tue, 17 Jun 2003 16:18:01 -0400 (EDT) Received: from umbrella.listbox.com (umbrella.listbox.com [208.210.125.21]) by rime.listbox.com (Postfix) with ESMTP id 7378ADF7381 for ; Tue, 17 Jun 2003 16:18:00 -0400 (EDT) Received: by umbrella.listbox.com (Postfix, from userid 440) id 7378ADF7381; Tue, 17 Jun 2003 16:17:01 -0400 (EDT) Received: from freeonline.com.au (a.mx.freeonline.com.au [127.0.0.126]) by umbrella.listbox.com (Postfix) with SMTP id 7378ADF7381 for ; Tue, 17 Jun 2003 16:16:59 -0400 (EDT) Message-Id: <7378ADF7381aTjhj36@x> Date: Tue, 17 Jun 2003 13:17:17 -0700 To: sample@v2.listbox.com From: "Listbox Sample" Subject: [sample] Archive Sender: owner-sample@v2.listbox.com Precedence: list Reply-To: sample@v2.listbox.com List-Id: List-Help: List-Subscribe: , List-Unsubscribe: , An archive for this list is there ? ------- Sample: http://example.com/ Archives at http://archives.listbox.com/sample/current/ To unsubscribe, change your address, or temporarily deactivate your ubscription, please go to http://v2.listbox.com/member/?listname=sample@v2.listbox.com From adm-bounce@oasys.net Mon Jun 4 06:41:14 2001 Return-Path: Received: from rime.listbox.com ([216.65.124.73] verified) by freeonline.com.au (CommuniGate Pro SMTP 4.0.6) with ESMTP id 452321 for mld-listbox@walker.wattle.id.au; Tue, 17 Jun 2003 20:16:02 +0000 Received: by rime.listbox.com (Postfix, from userid 440) id 7378ADF7381; Tue, 17 Jun 2003 16:18:01 -0400 (EDT) Received: from umbrella.listbox.com (umbrella.listbox.com [208.210.125.21]) by rime.listbox.com (Postfix) with ESMTP id 7378ADF7381 for ; Tue, 17 Jun 2003 16:18:00 -0400 (EDT) Received: by umbrella.listbox.com (Postfix, from userid 440) id 7378ADF7381; Tue, 17 Jun 2003 16:17:01 -0400 (EDT) Received: from freeonline.com.au (a.mx.freeonline.com.au [127.0.0.126]) by umbrella.listbox.com (Postfix) with SMTP id 7378ADF7381 for ; Tue, 17 Jun 2003 16:16:59 -0400 (EDT) Message-Id: <7378ADF7381aTjhj36@x> Date: Tue, 17 Jun 2003 13:17:17 -0700 To: sample@v2.listbox.com From: "Listbox Sample" Subject: [sample] Archive Sender: owner-sample@v2.listbox.com Precedence: list Reply-To: sample@v2.listbox.com List-Id: List-Help: List-Subscribe: , List-Unsubscribe: , List-Software: listbox.com v2.0 An archive for this list is there ? ------- Sample: http://example.com/ Archives at http://archives.listbox.com/sample/current/ To unsubscribe, change your address, or temporarily deactivate your ubscription, please go to http://v2.listbox.com/member/?listname=sample@v2.listbox.com From adm-bounce@oasys.net Mon Jun 4 06:41:14 2001 Received: from lmailexample1.example.com ([10.22.163.233] verified) by example.com.au (CommuniGate Pro SMTP 4.1) with ESMTP id 946911982 for matthew@EXAMPLE.COM.AU; Wed, 12 Aug 2001 21:49:00 0000 Received: from LISTSERV.EXAMPLE.COM (tem01.mx.example.com) by lmailexample1.example.com (LSMTP for Windows NT v1.1b) with SMTP id <0.940293@lmailexample1.example.com>; Wed, 12 Aug 2001 21:29:46 +0400 Received: from LISTSERV.EXAMPLE.COM by LISTSERV.EXAMPLE.COM (LISTSERV-TCP/IP release 1.8e) with spool id 8932592 for EXAMPLE@LISTSERV.EXAMPLE.COM; Wed, 12 Aug 2001 20:58:31 +0400 MIME-Version: 1.0 Content-Type: text/plain; charset=us-ascii; format=flowed Content-Transfer-Encoding: 7bit Message-ID: Date: Wed, 12 Aug 2001 20:58:11 -0200 Reply-To: EXAMPLE Discussion Sender: EXAMPLE Discussion From: I. EXAMPLE Subject: Boring sample message To: EXAMPLE@LISTSERV.EXAMPLE.COM In-Reply-To: <7834BADFE3125E.90301@example.com> Precedence: list This is a really boring example Listserv message. -- EXAMPLE - http://www.example.com/ To Remove yourself from this list, simply send an email to with the body of "SIGNOFF EXAMPLE" in the email message. You can leave the Subject: field of your email blank. From adm-bounce@oasys.net Mon Jun 4 06:41:14 2001 Return-Path: <> Received: from listserv.example.com (listserv.example.com [10.51.0.6]) by listserv.example.com (8.11.6p2/8.11.6) with ESMTP id h32hgds039; Wed, 10 Apr 2001 20:48:08 -0500 (EST) Received: from LISTSERV.EXAMPLE.COM by LISTSERV.EXAMPLE.COM (LISTSERV-TCP/IP release 1.8d) with spool id 137738 for COCO@LISTSERV.EXAMPLE.COM; Wed, 10 Apr 2001 19:13:57 -0500 Approved-BY: spcadmin@EXAMPLE.COM Received: from relay.example.com (relay.example.com [10.51.0.1]) by listserv.example.com (8.11.6p2/8.11.6) with ESMTP id h31L8r26559 for ; Wed, 1 Apr 2003 16:52:55 -0500 (EST) Received: from cp.example.com (cp.example.com [10.51.0.1]) by relay.example.com (Switch-2.2.6/Switch-2.2.5) with ESMTP id htyLqsv14600 for ; Wed, 10 Apr 2001 15:26:55 -0500 (EST) Received: (from nobody@localhost) by cp.example.com (8.11.6/8.11.6) id h31LqsX16086; Wed, 10 Apr 2001 15:25:54 -0500 (EST) Message-Id: <200104102125.h31LqsX16086@cp.example.com> Date: Wed, 10 Apr 2001 15:25:54 -0500 Reply-To: vibrant_newsletters@EXAMPLE.NET Sender: Comedy Company From: Comedy Company Subject: Another boring sample message To: COCO@LISTSERV.EXAMPLE.COM Status: U And here's another one but the Reply-To is not set to the list. From adm-bounce@oasys.net Mon Jun 4 06:41:14 2001 Received: from [10.80.0.8] by mail.example.com (SMTPD32-3.04) id A3CCCC1700AC; Mon, 02 Feb 1998 20:25:33 -0700 Received: from total.example.com (du-226.example.com [10.80.0.226]) by poseidon.example.com (8.8.6/8.8) with SMTP id QBB30808; Mon, 2 Feb 1998 04:08:00 GMT Subject: CommuniGate List example Message-Id: <00000038942968439085@total.example.com> To: subscribers:; X-ListServer: CommuniGate List 1.4 From: test@example.com (Test Account) Sender: CGnet@total.example.com (CGnet) Date: Mon, 02 Feb 1998 13:57:22 +1000 Organization: Example Limited X-Mailer: CommuniGate 2.9.8 Errors-To: Greene@total.example.com Reply-To: CGnet@total.example.com MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="__==========0000000003894==total.example.com==__" This is a MIME-encapsulated message If you read this, you may want to switch to a better mailer --__==========0000000003894==total.example.com==__ Content-Type: text/plain; charset=ISO-8859-1 Content-Transfer-Encoding: 8bit List content goes here. --__==========0000000003894==total.example.com==__ Content-Type: text/plain; charset=ISO-8859-1 Content-Transfer-Encoding: 8bit ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ You have received this message because you are subscribed to Gnet. To unsubscribe, send any message to: CGnet-off@total.example.com ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ --__==========0000000003894==total.example.com==__-- Mail-Message-3.006/t/312encode-quoted.t0000644000175000001440000000300013200571125020103 0ustar00markovusers00000000000000#!/usr/bin/env perl # # Encoding and Decoding quoted-print bodies # use strict; use warnings; use Mail::Message::Test; use Mail::Message::Body::Lines; use Mail::Message::TransferEnc::QuotedPrint; use Test::More tests => 10; my $src = <new; ok(defined $codec); is($codec->name, 'quoted-printable'); # Test encoding my $body = Mail::Message::Body::Lines->new ( mime_type => 'text/html' , data => $src ); my $enc = $codec->encode($body); ok($body!=$enc); is($enc->mimeType, 'text/html'); is($enc->transferEncoding, 'quoted-printable'); is($enc->string, $encoded); # Test decoding $body = Mail::Message::Body::Lines->new ( transfer_encoding => 'quoted-printable' , mime_type => 'text/html' , data => $encoded ); my $dec = $codec->decode($body); ok($dec!=$body); is($enc->mimeType, 'text/html'); is($dec->transferEncoding, 'none'); is($dec->string, $src); Mail-Message-3.006/t/116fieldu-userid.t0000644000175000001440000000562613200571125020132 0ustar00markovusers00000000000000#!/usr/bin/env perl # # Test processing in combination with User::Identity as documented in # Mail::Message::Field. # use strict; use warnings; use Mail::Message::Test; use Mail::Message::Field::Fast; use User::Identity; use Test::More tests => 22; my $mmf = 'Mail::Message::Field::Fast'; # A user's identity my $patrik = User::Identity->new ( "patrik" , full_name => "Patrik Fltstrm" # from rfc , charset => "ISO-8859-1" ); isa_ok($patrik, 'User::Identity'); my $email1 = $patrik->add ( email => 'home' , address => 'him@home.net' ); isa_ok($email1, 'Mail::Identity'); # address based on Mail::Identity with user my $f1 = $mmf->new(To => $email1); isa_ok($f1, $mmf); is($f1, '=?ISO-8859-1?q?Patrik_F=E4ltstr=F6m?= '); my $f1b = $mmf->new(To => $patrik); isa_ok($f1b, $mmf); is($f1b, '=?ISO-8859-1?q?Patrik_F=E4ltstr=F6m?= '); # address based on Mail::Identity without user require Mail::Identity; my $email2 = Mail::Identity->new ( 'work' , address => 'somewhere@example.com' ); my $f2 = $mmf->new(To => $email2); is($f2, 'somewhere@example.com'); # A very complex address my $email3 = Mail::Identity->new ( 'work' , address => 'somehow@example.com' , phrase => 'my " quote' , comment => 'make it ) hard' ); my $f3 = $mmf->new(To => $email3); is($f3, qq["my \\" quote" (make it \\) hard)]); # A collection of e-mails $patrik->add(email => $email3); my $emails = $patrik->collection('emails'); isa_ok($emails, 'User::Identity::Collection::Emails'); cmp_ok(@$emails, '==', 2); # An array of addresses my $f4 = $mmf->new ( To => [ $email1 , "aap\@hok.nl" , $email2 , $patrik->find(email => 'work') ] ); is($f4->string, <<'FOLDED'); To: =?ISO-8859-1?q?Patrik_F=E4ltstr=F6m?= , aap@hok.nl, somewhere@example.com, "my \" quote" (make it \) hard) FOLDED # Test a collection which is linked to user my $f5 = $mmf->new(To => $emails); is($f5->string, <<'TWO'); To: emails: "my \" quote" (make it \) hard), =?ISO-8859-1?q?Patrik_F=E4ltstr=F6m?= ; TWO require Mail::Message::Field::AddrGroup; # test a collection which is not linked to a user my $mmfg = 'Mail::Message::Field::AddrGroup'; my $g = $mmfg->new(name => 'groupie'); isa_ok($g, $mmfg); is($g->name, 'groupie'); my @addrs = $g->addresses; cmp_ok(scalar @addrs, '==', 0); is($g->string, "groupie: ;"); $g->addAddress($email1); @addrs = $g->addresses; cmp_ok(scalar @addrs, '==', 1); is($g->string, 'groupie: him@home.net;'); $g->addAddress($email3); @addrs = $g->addresses; cmp_ok(scalar @addrs, '==', 2); is($g->string, 'groupie: "my \" quote" (make it \) hard), him@home.net;'); $g->addAddress('aap@hok.nl'); @addrs = $g->addresses; cmp_ok(scalar @addrs, '==', 3); is($g->string, 'groupie: "my \" quote" (make it \) hard), aap@hok.nl, him@home.net;'); Mail-Message-3.006/t/102field-flex.t0000644000175000001440000000616513200571125017402 0ustar00markovusers00000000000000#!/usr/bin/env perl # # Test processing of header-fields in flexible format: only single fields, # not whole headers. This also doesn't cover reading headers from file. # use strict; use warnings; use Mail::Message::Test; use Mail::Message::Field::Flex; use Test::More tests => 44; use Mail::Address; # # Processing unstructured lines. # my $a = Mail::Message::Field::Flex->new('A: B ; C'); is($a->name, 'a'); is($a->body, 'B ; C'); ok(not defined $a->comment); # No folding permitted. my $bbody = 'B ; C234290iwfjoj w etuwou toiwutoi wtwoetuw oiurotu 3 ouwout 2 oueotu2 fqweortu3'; my $b = Mail::Message::Field::Flex->new("A: $bbody"); my @lines = $b->toString(100); cmp_ok(@lines, '==', 1); is($lines[0], "A: $bbody\n"); is($b->body, $bbody); @lines = $b->toString(40); cmp_ok(@lines, '==', 3); is($lines[2], " oueotu2 fqweortu3\n"); # # Processing of structured lines. # my $f = Mail::Message::Field::Flex->new('Sender: B ; C'); is($f->name, 'sender'); is($f->body, 'B'); is($f, 'B ; C'); like($f->comment, qr/^\s*C\s*/); # No comment, strip CR LF my $g = Mail::Message::Field::Flex->new("Sender: B\015\012"); is($g->body, 'B'); is($g->comment, ''); # Separate head and body. my $h = Mail::Message::Field::Flex->new("Sender", "B\015\012"); is($h->body, 'B'); is($h->comment, ''); my $i = Mail::Message::Field::Flex->new('Sender', 'B ; C'); is($i->name, 'sender'); is($i->body, 'B'); like($i->comment, qr/^\s*C\s*/); my $j = Mail::Message::Field::Flex->new('Sender', 'B', [comment => 'C']); is($j->name, 'sender'); is($j->body, 'B'); like($j->comment, qr/^\s*C\s*/); # Check toString (for unstructured field, so no folding) my $k = Mail::Message::Field::Flex->new(A => 'short line'); is($k->toString, "A: short line\n"); my @klines = $k->toString; cmp_ok(@klines, '==', 1); my $l = Mail::Message::Field::Flex->new(A => 'oijfjslkgjhius2rehtpo2uwpefnwlsjfh2oireuqfqlkhfjowtropqhflksjhflkjhoiewurpq'); my @llines = $k->toString; ok(@llines==1); my $n = Mail::Message::Field::Flex->new(A => 7); my $x = $n + 0; ok($n ? 1 : 0); ok($x==7); ok($n > 6); ok($n < 8); ok($n==7); ok(6 < $n); ok(8 > $n); # # Check gluing addresses # my @mb = Mail::Address->parse('me@localhost, you@somewhere.nl'); cmp_ok(@mb, '==', 2); my $r = Mail::Message::Field::Flex->new(Cc => $mb[0]); is($r->toString, "Cc: me\@localhost\n"); $r = Mail::Message::Field::Flex->new(Cc => \@mb); is($r->toString, "Cc: me\@localhost, you\@somewhere.nl\n"); my $r2 = Mail::Message::Field::Flex->new(Bcc => $r); is($r2->toString, "Bcc: me\@localhost, you\@somewhere.nl\n"); # # Checking attributes # my $charset = 'iso-8859-1'; my $comment = qq(charset="iso-8859-1"; format=flowed); my $p = Mail::Message::Field::Flex->new("Content-Type: text/plain; $comment"); is($p->comment, $comment); is($p->body, 'text/plain'); is($p->attribute('charset'), $charset); my $q = Mail::Message::Field::Flex->new('Content-Type: text/plain'); is($q->toString, "Content-Type: text/plain\n"); is($q->attribute(charset => 'iso-10646'), 'iso-10646'); is($q->attribute('charset'), 'iso-10646'); is($q->comment, 'charset="iso-10646"'); is($q->toString, qq(Content-Type: text/plain; charset="iso-10646"\n)); Mail-Message-3.006/t/301body-string.t0000644000175000001440000000277213200571125017625 0ustar00markovusers00000000000000#!/usr/bin/env perl # # Test processing of message bodies which have their content stored # in a single string. This does not test the reading of the bodies # from file. # use strict; use warnings; use Mail::Message::Test; use Mail::Message::Body::String; use IO::Scalar; use Test::More tests => 30; # Test to read a scalar from file. # Let's fake the file, for simplicity. my $filedata = <<'SIMULATED_FILE'; This is a file with five lines, and it is used to test whether the reading into a scalar body would work (or not) SIMULATED_FILE my @filedata = split /^/, $filedata; cmp_ok(@filedata, '==', 5); my $f = IO::Scalar->new(\$filedata); my $body = Mail::Message::Body::String->new(file => $f); ok(defined $body); is($body->string, $filedata); cmp_ok($body->nrLines, '==', 5); cmp_ok($body->size, '==', length $filedata); my $fakeout; my $g = IO::Scalar->new(\$fakeout); $body->print($g); is($fakeout, $filedata); my @lines = $body->lines; cmp_ok(@lines, '==', 5); foreach (0..4) { is($lines[$_], $filedata[$_]) } # Reading data from lines. $body = Mail::Message::Body::String->new(data => [@filedata]); ok($body); is($body->string, $filedata); cmp_ok($body->nrLines, '==', 5); cmp_ok($body->size, '==', length $filedata); $fakeout = ''; $body->print($g); is($fakeout, $filedata); @lines = $body->lines; cmp_ok(@lines, '==', 5); foreach (0..4) { is($lines[$_], $filedata[$_]) } # Test overloading is("$body", $filedata); @lines = @$body; cmp_ok(@lines, '==', 5); foreach (0..4) { is($lines[$_], $filedata[$_]) } Mail-Message-3.006/t/012reporter-callback.t0000644000175000001440000000201013200571125020740 0ustar00markovusers00000000000000#!/usr/bin/env perl # # Test installing a log callback # use strict; use warnings; use Mail::Message::Test; use Mail::Reporter; use Test::More tests => 13; my ($thing, $level, @text); sub callback($$@) { ($thing, $level, @text) = @_ } my ($l, $t) = Mail::Reporter->defaultTrace(PROGRESS => \&callback); ok(defined $l); ok(defined $t); is($l, 'NONE', 'string log level'); cmp_ok($l, '==', 6, 'numeric log level'); is($t, 'PROGRESS', 'string trace level'); cmp_ok($t, '==', 3, 'string trace level'); Mail::Reporter->log(ERROR => 'one', 'two'); is($thing, 'Mail::Reporter', 'class call'); is($level, 'ERROR', 'string trace level'); cmp_ok(@text, '==', 1, 'text'); is($text[0], "onetwo"); ($thing, $level, @text) = (); Mail::Reporter->log(NOTICE => 'three'); ok(!defined $thing, 'too low level, nothing'); ok(!defined $level, 'no level'); cmp_ok(@text, '==', 0, 'no text'); Mail-Message-3.006/t/311encode-eight.t0000644000175000001440000000142513200571125017712 0ustar00markovusers00000000000000#!/usr/bin/env perl # # Encoding and Decoding of 8bit # use strict; use warnings; use Mail::Message::Test; use Mail::Message::Body::Lines; use Mail::Message::TransferEnc::EightBit; use Test::More tests => 6; my $decoded = <new; ok(defined $codec); is($codec->name, '8bit'); # Test encoding my $body = Mail::Message::Body::Lines->new ( mime_type => 'text/html' , data => $decoded ); my $enc = $codec->encode($body); ok($body!=$enc); is($enc->mimeType, 'text/html'); is($enc->transferEncoding, '8bit'); is($enc->string, $encoded); # Test decoding Mail-Message-3.006/t/001use.t0000644000175000001440000000642013200571125016147 0ustar00markovusers00000000000000#!/usr/bin/env perl use warnings; use strict; use Test::More tests => 52; # The versions of the following packages are reported to help understanding # the environment in which the tests are run. This is certainly not a # full list of all installed modules. my @show_versions = qw/Mail::Box Mail::Box::Manager Mail::Transfer /; foreach my $package (@show_versions) { eval "require $package"; no strict 'refs'; my $report = !$@ ? "version ". (${"$package\::VERSION"} || 'unknown') : $@ =~ m/^Can't locate/ ? "not installed" : "reports error"; warn "$package $report\n"; } require_ok('Mail::Box::FastScalar'); require_ok('Mail::Box::Parser'); require_ok('Mail::Box::Parser::Perl'); require_ok('Mail::Message::Body::Construct'); require_ok('Mail::Message::Body::Encode'); require_ok('Mail::Message::Body::File'); require_ok('Mail::Message::Body::Lines'); require_ok('Mail::Message::Body::Multipart'); require_ok('Mail::Message::Body::Nested'); require_ok('Mail::Message::Body'); require_ok('Mail::Message::Body::String'); require_ok('Mail::Message::Construct::Bounce'); require_ok('Mail::Message::Construct::Build'); require_ok('Mail::Message::Construct::Forward'); require_ok('Mail::Message::Construct'); require_ok('Mail::Message::Construct::Read'); require_ok('Mail::Message::Construct::Rebuild'); require_ok('Mail::Message::Construct::Reply'); require_ok('Mail::Message::Construct::Text'); require_ok('Mail::Message::Convert'); require_ok('Mail::Message::Field::Addresses'); require_ok('Mail::Message::Field::Address'); require_ok('Mail::Message::Field::AddrGroup'); require_ok('Mail::Message::Field::Attribute'); require_ok('Mail::Message::Field::AuthResults'); require_ok('Mail::Message::Field::Date'); require_ok('Mail::Message::Field::Fast'); require_ok('Mail::Message::Field::Flex'); require_ok('Mail::Message::Field::Full'); require_ok('Mail::Message::Field'); require_ok('Mail::Message::Field::Structured'); require_ok('Mail::Message::Field::Unstructured'); require_ok('Mail::Message::Field::URIs'); require_ok('Mail::Message::Head::Complete'); require_ok('Mail::Message::Head::FieldGroup'); require_ok('Mail::Message::Head::ListGroup'); require_ok('Mail::Message::Head::Partial'); require_ok('Mail::Message::Head'); require_ok('Mail::Message::Head::ResentGroup'); require_ok('Mail::Message::Head::SpamGroup'); require_ok('Mail::Message::Part'); require_ok('Mail::Message'); require_ok('Mail::Message::Replace::MailHeader'); require_ok('Mail::Message::Replace::MailInternet'); require_ok('Mail::Message::Test'); require_ok('Mail::Message::TransferEnc::Base64'); require_ok('Mail::Message::TransferEnc::Binary'); require_ok('Mail::Message::TransferEnc::EightBit'); require_ok('Mail::Message::TransferEnc'); require_ok('Mail::Message::TransferEnc::QuotedPrint'); require_ok('Mail::Message::TransferEnc::SevenBit'); require_ok('Mail::Reporter'); # The following modules only compile when optional modules are installed #require_ok('Mail::Message::Convert::EmailSimple'); #require_ok('Mail::Message::Convert::HtmlFormatPS'); #require_ok('Mail::Message::Convert::HtmlFormatText'); #require_ok('Mail::Message::Convert::Html'); #require_ok('Mail::Message::Convert::MailInternet'); #require_ok('Mail::Message::Convert::MimeEntity'); #require_ok('Mail::Message::Convert::TextAutoformat'); Mail-Message-3.006/t/500parser-field.t0000644000175000001440000000310113200571125017725 0ustar00markovusers00000000000000#!/usr/bin/env perl # # Test processing of header-fields: only single fields, not whole headers. # This also doesn't cover reading headers from file. # use strict; use warnings; use Mail::Message::Test; use Mail::Message::Field; use Mail::Box::Parser::Perl; use Test::More tests => 15; # Explictly ask for the Perl parser to fold lines. Mail::Box::Parser->defaultParserType('Mail::Box::Parser::Perl'); # # Processing of structured lines. # my $f = Mail::Message::Field->new('Sender: B ; C'); is($f->name, 'sender'); is($f->body, 'B'); like($f->comment , qr/^\s*C\s*/); # No comment, strip CR LF my $g = Mail::Message::Field->new("Sender: B\015\012"); is($g->body, 'B'); is($g->comment, ""); # Check toString my $x = $f->toString; is($x, "Sender: B ; C\n"); $x = $g->toString; is($x, "Sender: B\n"); # Now check folding. my $k = Mail::Message::Field->new(Sender => 'short line'); is($k->toString, "Sender: short line\n"); my @klines = $k->toString; cmp_ok(@klines, "==", 1); my $long = 'oijfjslkgjhius2rehtpo2uwpefnwlsjfh2oireuqfqlkhfjowtropqhflksjhflkjhoiewurpq'; my $l = Mail::Message::Field->new(Sender => $long); my @llines = $l->toString; cmp_ok(@llines, "==", 1); my $m = Mail::Message::Field->new(Sender => 'roijfjslkgjhiu, rehtpo2uwpe, fnwlsjfh2oire, uqfqlkhfjowtrop, qhflksjhflkj, hoiewurpq'); cmp_ok($m->nrLines, "==", 2); $m->setWrapLength(35); cmp_ok($m->nrLines, "==", 3); my @mlines = $m->toString(72); cmp_ok(@mlines, "==", 2); is($mlines[0], "Sender: roijfjslkgjhiu, rehtpo2uwpe, fnwlsjfh2oire, uqfqlkhfjowtrop,\n"); is($mlines[1], " qhflksjhflkj, hoiewurpq\n"); Mail-Message-3.006/t/314encode-charset.t0000644000175000001440000000246113200571125020247 0ustar00markovusers00000000000000#!/usr/bin/env perl # Conversion of character-sets # use strict; use warnings; use utf8; use Mail::Message::Test; use Mail::Message::Body; use Scalar::Util 'refaddr'; use Data::Dumper; use Test::More tests => 19; my $src = "märkøv\n"; # fragile! must be utf8, not latin1 ok(utf8::is_utf8($src)); my $dec = Mail::Message::Body->new(data => $src); isa_ok($dec, 'Mail::Message::Body'); is($dec->charset, 'PERL', 'default charset PERL'); my $enc = $dec->encode(charset => 'PERL'); is(ref $dec, ref $enc, 'same type'); is(refaddr $dec, refaddr $enc, 'same object'); is($enc->charset, 'PERL', 'charset PERL'); $enc = $dec->encode(charset => 'utf8', transfer_encoding => 'quoted-printable'); is(ref $dec, ref $enc, 'same type'); isnt(refaddr $dec, refaddr $enc, 'new object'); is($enc->charset, 'utf8'); my @lines = $enc->lines; cmp_ok(scalar @lines, '==', 1); is($lines[0], "m=C3=A4rk=C3=B8v\n"); ok(!utf8::is_utf8($lines[0]), 'raw bytes'); my $rec = $enc->encode(charset => 'PERL', transfer_encoding => 'none'); is(ref $rec, ref $enc, 'same type'); isnt(refaddr $rec, refaddr $enc, 'new object'); isnt(refaddr $rec, refaddr $dec, 'new object'); ok($rec->charset.'', 'PERL'); @lines = $rec->lines; cmp_ok(scalar @lines, '==', 1); is($lines[0], $src, 'transfer decoded'); ok(utf8::is_utf8($lines[0]), 'is perl utf-8'); Mail-Message-3.006/t/112fieldu-attr.t0000644000175000001440000001441313200571125017577 0ustar00markovusers00000000000000#!/usr/bin/env perl # # Test processing of field attributes in their most expensive implementation! # use strict; use warnings; use utf8; use Mail::Message::Test; use Mail::Message::Field::Attribute; use Mail::Message::Field::Full; use Test::More tests => 101; my $mmfa = 'Mail::Message::Field::Attribute'; # # Test construction # my $a = $mmfa->new('a'); isa_ok($a, $mmfa); is($a->name, 'a'); ok(defined $a, "object a creation"); ok(!defined $a->charset, "charset undef"); ok(!defined $a->language, "language undef"); my $b = $mmfa->new('b', charset => 'iso-8859-15', language => 'nl-BE'); is($b->name, 'b'); ok(defined $a, "object b creation"); is($b->charset, 'iso-8859-15', "charset pre-set"); is($b->language, 'nl-BE', "language pre-set"); is($b->string, "; b*=iso-8859-15'nl-BE'"); # # Test situations without encoding or continuations # is($a->value, ''); ok($a->addComponent('a=test-any-field'), "simple component"); is($a->value, "test-any-field", "simple component set"); is($a->string, "; a=test-any-field", "simple component string"); my $s = ($a->string)[0]; is($s, "a=test-any-field", "simple component string"); ok($a->addComponent('a="test-any\"-field"'), "dq component"); is($a->value, 'test-any"-field', "dq component set"); is($a->string, "; a=\"test-any\\\"-field\"", "dq component string"); $s = ($a->string)[0]; is($s, 'a="test-any\"-field"', "dq component string"); ok($a->addComponent("a='test-any\\'-field'"), "sq component"); is($a->value, "test-any'-field", "sq component set"); is($a->string, "; a='test-any\\'-field'","sq component string"); $s = ($a->string)[0]; is($s, "a='test-any\\'-field'", "sq component string"); # # Tests for decoding without continuations # my $c = $mmfa->new('c', use_continuations => 0); isa_ok($c, $mmfa, "Construction of c"); ok($c->addComponent("c*=''abc"), "c without spec"); ok(! defined $c->charset); ok(! defined $c->language); is($c->value, 'abc'); ok($c->addComponent("c*=us-ascii''abc"), "c with charset"); is($c->charset, 'us-ascii'); ok(! defined $c->language); is($c->value, 'abc'); ok($c->addComponent("c*='en'abc"), "c with language"); ok(! defined $c->charset); is($c->language, 'en'); is($c->value, 'abc'); ok($c->addComponent("c*=us-ascii'en'abc"),"c with both"); is($c->charset, 'us-ascii'); is($c->language, 'en'); is($c->value, 'abc'); # # Tests for encoding without continuations # my $d = $mmfa->new('d', charset => 'iso-8859-1', use_continuations => 0); ok(defined $d, "Created d"); is($d->value, ''); is($d->value('abc'), 'abc'); is($d->value, 'abc'); my @s = $d->string; cmp_ok(scalar @s, '==', 1); is($s[0], "d*=iso-8859-1''abc"); is($d->string, "; d*=iso-8859-1''abc"); my @mq = ( 'JHKU(@*#&$ASK(@CKH*#@DHKAFsfdsk\"{PO{}[2348*(&(234897(&(ws:\":LK:K@@' , '4279234897 ' ); my $m = join '', @mq; $m =~ s/\\"/"/g; my @me = ( 'JHKU%28%40%2A%23%26%24ASK%28%40CKH%2A%23%40DHKAFsfdsk%22%7B' , 'PO%7B%7D%5B2348%2A%28%26%28234897%28%26%28ws%3A%22%3C%3F%3E%3ALK%3AK%40' , '%404279234897%20' ); my $me = join '', @me; is($d->value($m), $m); is($d->value, $m); @s = $d->string; cmp_ok(scalar @s, '==', 1); is($s[0], "d*=iso-8859-1''$me"); is($d->string, "; d*=iso-8859-1''$me"); $d->addComponent("d*=iso-8859-2''$me"); is($d->charset, 'iso-8859-2'); ok(! defined $d->language); is($d->value, $m); # # Tests for encoding with continuations # my $e = $mmfa->new('e', charset => 'iso-8859-1', use_continuations => 1); ok(defined $e, "Created e"); is($e->value, ''); is($e->value('abc'), 'abc'); is($e->value, 'abc'); @s = $e->string; cmp_ok(scalar @s, '==', 1); is($s[0], "e*=iso-8859-1''abc"); is($e->value($m), $m); is($e->value, $m); @s = $e->string; cmp_ok(scalar @s, '==', scalar @me); is($s[0], "e*0*=iso-8859-1''$me[0]"); is($s[1], "e*1*=$me[1]"); is($s[2], "e*2*=$me[2]"); is($e->string, "; e*0*=iso-8859-1''$me[0]; e*1*=$me[1]; e*2*=$me[2]"); is($e->value('abc'), 'abc', "Reset contination"); is($e->value, 'abc'); @s = $e->string; cmp_ok(scalar @s, '==', 1); is($s[0], "e*=iso-8859-1''abc"); # # Tests *NO* encoding with continuations # my $f = $mmfa->new('f', use_continuations => 1); ok(defined $f, "Created f"); is($f->value, ''); is($f->value('abc'), 'abc'); is($f->value, 'abc'); is($f->value($m), $m); is($f->value, $m); @s = $f->string; cmp_ok(scalar @s, '==', 2); is($s[0], "f*0=\"$mq[0]\""); is($s[1], "f*1=\"$mq[1]\""); is($f->string, "; f*0=\"$mq[0]\"; f*1=\"$mq[1]\""); is($f->value('abc'), 'abc', "Reset contination"); is($f->value, 'abc'); @s = $f->string; cmp_ok(scalar @s, '==', 1); is($s[0], 'f="abc"'); # # Tests merging # my $g = $mmfa->new('g', use_continuations => 1); ok(defined $g, "Created g"); my $h = $mmfa->new('h', use_continuations => 1); ok(defined $h, "Created h"); $g->addComponent('g*1*=b'); is($g->value, '[continuation missing]b', "Merge no continuation"); $h->addComponent('g*0*=a'); is($h->value, 'a'); ok(defined $g->mergeComponent($h), "Merge with continuation"); is($g->value, 'ab'); # # Test overloading # my $m1 = $mmfa->new(m => 'one'); my $m2 = $mmfa->new(m => 'two'); my $m3 = $mmfa->new(M => 'one'); my $m4 = $mmfa->new(M => 'ONE'); # stringification cmp_ok($m1->value, 'eq', 'one'); cmp_ok("$m1", 'eq', 'one'); # comparison # overloading at work, so we cannot use cmp_ok ok($m1 ne $m2, "$m1 ne $m2"); ok($m1 eq $m3, "$m1 eq $m3"); ok($m1 ne $m4, "$m1 ne $m4"); # fallback my $m5 = $mmfa->new(M => 42); cmp_ok($m5 +1, '==', 43, 'fallback'); # rt.cpan.org#90342 my $h1 = Mail::Message::Field::Full->new('Content-Disposition' => 'inline; filename*0="Selling #1 (signed) -"; filename*1=" 11-13.p"; filename*2=df'); #use Data::Dumper; #warn Dumper $h1; isa_ok($h1, 'Mail::Message::Field::Structured'); is($h1->attribute('filename'), 'Selling #1 (signed) - 11-13.pdf'); my $h2 = Mail::Message::Field::Full->new('Content-Disposition' => q{inline; filename*0*="ISO-8859-15''R%FCckstellung%20DB%2C%20DZ%20u.%20KommSt%202001-"; filename*1*="2004.xls"}); my $h2a = $h2->attribute('filename'); is($h2a, 'Rückstellung DB, DZ u. KommSt 2001-2004.xls'); Mail-Message-3.006/t/303body-multip.t0000644000175000001440000001242313200571125017625 0ustar00markovusers00000000000000#!/usr/bin/env perl # # Test processing of multipart message bodies. # use strict; use warnings; use Mail::Message::Test; use Mail::Message::Body::Lines; use Mail::Message::Body::Multipart; use Mail::Message::Head::Complete; use Test::More tests => 33; use IO::Scalar; my $body = Mail::Message::Body::Multipart->new ( transfer_encoding => '8bit' , boundary => 'xyz' ); is($body->boundary, 'xyz'); $body->boundary('part-separator'); is($body->boundary, 'part-separator'); is($body->mimeType, 'multipart/mixed', 'is multipart mixed'); my $h1 = Mail::Message::Head::Complete->new; my $b1 = Mail::Message::Body::Lines->new ( data => ["p1 l1\n", "p1 l2\n" ] , checked => 1 , mime_type => 'text/html' , transfer_encoding => '8bit' ); ok($b1, 'body 1'); is($b1->mimeType, 'text/html'); is($b1->transferEncoding, '8bit'); is($b1->disposition, 'none'); my $p1 = Mail::Message->new(head => $h1); is($b1->charset, 'PERL'); my $b1b = $p1->body($b1); is($b1b->charset, 'utf-8'); #$p1->print; is($p1->get('Content-Transfer-Encoding'), '8bit'); ok(! defined $p1->get('Content-Disposition')); my $h2 = Mail::Message::Head::Complete->new; my $b2 = Mail::Message::Body::Lines->new ( data => ["p2 l1\n", "p2 l2\n", "p2 l3\n", "p2 l4\n" ] , mime_type => 'text/plain' , checked => 1 , transfer_encoding => '8bit' ); ok($b2, 'body 2'); my $p2 = Mail::Message->new(head => $h2); is($b2->charset, 'PERL'); my $b2b = $p2->body($b2); is($b2b->charset, 'utf-8'); # Empty multipart my $fakeout; my $g = IO::Scalar->new(\$fakeout); cmp_ok($body->parts, "==", 0); $body->print($g); is($fakeout, "--part-separator--"); # First attachment $fakeout = ''; my $newbody = $body->attach($p1); ok($newbody != $body); cmp_ok($newbody->parts, "==", 1); $newbody->print($g); compare_message_prints($fakeout."\n", <<'EXPECTED', 'print with attachment'); --part-separator Content-Type: text/html; charset="utf-8" Content-Transfer-Encoding: 8bit p1 l1 p1 l2 --part-separator-- EXPECTED # Second attachment my $newerbody = $newbody->attach($p2); ok($newerbody != $newbody); cmp_ok($newerbody->parts, "==", 2); $fakeout = ''; $newerbody->print($g); compare_message_prints($fakeout."\n", <<'EXPECTED', 'print with two attachments'); --part-separator Content-Type: text/html; charset="utf-8" Content-Transfer-Encoding: 8bit p1 l1 p1 l2 --part-separator Content-Type: text/plain; charset="utf-8" Content-Transfer-Encoding: 8bit p2 l1 p2 l2 p2 l3 p2 l4 --part-separator-- EXPECTED # Add preamble and epilogue my $newestbody = ref($newerbody)->new ( based_on => $newerbody , preamble => Mail::Message::Body::Lines->new ( data => [ "preamb1\n", "preamb2\n" ] , mime_type => 'text/html' , charset => 'us-ascii' , tranfer_encoding => '8bit' ) , epilogue => Mail::Message::Body::Lines ->new(data => [ "epilogue\n" ]) ); ok($newestbody != $newbody); $fakeout = ''; $newestbody->print($g); compare_message_prints($fakeout, <<'EXPECTED', 'with preamble and epilogue'); preamb1 preamb2 --part-separator Content-Type: text/html; charset="utf-8" Content-Transfer-Encoding: 8bit p1 l1 p1 l2 --part-separator Content-Type: text/plain; charset="utf-8" Content-Transfer-Encoding: 8bit p2 l1 p2 l2 p2 l3 p2 l4 --part-separator-- epilogue EXPECTED # Body to message. The info on preamble is used to create a whole message # header. my $message = Mail::Message->buildFromBody($newestbody, From => 'me', To => 'you', Date => 'now', 'Message-Id' => ''); $fakeout = ''; $message->print($g); compare_message_prints($fakeout, <<'EXPECTED', 'build from multipart body'); From: me To: you Date: now Message-Id: Content-Type: multipart/mixed; boundary="part-separator" Content-Transfer-Encoding: 8bit MIME-Version: 1.0 preamb1 preamb2 --part-separator Content-Type: text/html; charset="utf-8" Content-Transfer-Encoding: 8bit p1 l1 p1 l2 --part-separator Content-Type: text/plain; charset="utf-8" Content-Transfer-Encoding: 8bit p2 l1 p2 l2 p2 l3 p2 l4 --part-separator-- epilogue EXPECTED ### since 2.106: check partnumbers my $pn = $message->partNumber; defined $pn or $pn = 'undef'; cmp_ok($pn, 'eq', 'undef', 'partnr of top is undef'); cmp_ok($message->body->part(0)->partNumber, 'eq', '1', 'partNumber 1'); cmp_ok($message->body->part(1)->partNumber, 'eq', '2', 'partNumber 2'); my $m1 = Mail::Message->buildFromBody($body, From => 'me', To => 'you', Date => 'now', 'Message-Id' => ''); $fakeout = ''; $m1->print($g); compare_message_prints($fakeout."\n", <<'EXPECTED', 'build from multipart body'); From: me To: you Date: now Message-Id: Content-Type: multipart/mixed; boundary="part-separator" Content-Transfer-Encoding: 8bit MIME-Version: 1.0 --part-separator-- EXPECTED my $m2 = Mail::Message->buildFromBody($b1, From => 'me', To => 'you', Date => 'now', 'Message-Id' => ''); $fakeout = ''; $m2->print($g); compare_message_prints($fakeout, <<'EXPECTED', 'build from multipart body'); From: me To: you Date: now Message-Id: Content-Type: text/html; charset="utf-8" Content-Transfer-Encoding: 8bit MIME-Version: 1.0 p1 l1 p1 l2 EXPECTED # # Check copying. # my $m3 = $message->clone; ok($m3); ok($m3 != $message); cmp_ok($m3->parts , "==", $message->parts); Mail-Message-3.006/t/204-sgfolder.mbox0000644000175000001440000011202113200571125017737 0ustar00markovusers00000000000000From melanie.mcdonald_el@freemail.it Mon Aug 11 08:16:21 2003 Return-Path: Delivered-To: markov@speeltuin.atcomputing.nl Received: from pandora.cs.kun.nl (pandora.cs.kun.nl [131.174.33.4]) by speeltuin.ATComputing.nl (Postfix) with ESMTP id 9319C39AD for ; Mon, 11 Aug 2003 08:16:20 +0200 (CEST) Received: from turk.net by pandora.cs.kun.nl via 12-221-78-16.client.insightBB.com [12.221.78.16] with ESMTP for id h7B6KvKc009534 (8.12.9/3.58); Mon, 11 Aug 2003 08:20:59 +0200 (MET DST) Message-ID: <3F3736A8.09D1E60C@freemail.it> From: "Melanie Mcdonald" To: markov@cs.kun.nl Subject: Did you lose my ICQ? Date: Mon, 11 Aug 2003 06:24:40 +0000 MIME-Version: 1.0 User-Agent: Mozilla/5.030 (X11; U; FreeBSD i386; U; NT4.0; en-us) Gecko/25250101 X-Accept-Language: en Content-Type: text/html Content-Transfer-Encoding: 8bit X-Spam-Status: Yes, hits=5.9 required=5.0 tests=CLICK_BELOW,HTML_70_80,HTML_MESSAGE,MIME_HTML_ONLY, OBFUSCATING_COMMENT,RCVD_IN_NJABL,RCVD_IN_UNCONFIRMED_DSBL, REPLY_TO_EMPTY,USER_AGENT_MOZILLA_UA,VIAGRA_ONLINE, X_ACCEPT_LANG version=2.55 X-Spam-Level: ***** X-Spam-Checker-Version: SpamAssassin 2.55 (1.174.2.19-2003-05-19-exp) X-Spam-Report: This mail is probably spam. The original message has been attached along with this report, so you can recognize or block similar unwanted mail in future. See http://spamassassin.org/tag/ for more details. Content preview: Get Viagra online Now ! We are the cheapest supplier on the net 100 % guarantee ! at 3 $ a dose, try it now. URI:http://www.xcellentresults.biz/index.php?id99 Click here URI:http://www.xcellentresults.biz/optout.php Discontinue receiving offers jb80v63snt3fht3tr6135os80 5bbdjf2r52f qopu343yz1frdybc3od6n0j4rq8ct26mhfo 1v5qat38wft9a 2ryjqw25fiate2oi11727 [...] Content analysis details: (5.90 points, 5 required) REPLY_TO_EMPTY (0.5 points) Reply-To: is empty USER_AGENT_MOZILLA_UA (0.0 points) User-Agent header indicates a non-spam MUA (Mozilla) X_ACCEPT_LANG (-0.1 points) Has a X-Accept-Language header VIAGRA_ONLINE (0.7 points) BODY: Fast Viagra Delivery HTML_MESSAGE (0.1 points) BODY: HTML included in message HTML_70_80 (0.5 points) BODY: Message is 70% to 80% HTML RCVD_IN_NJABL (0.9 points) RBL: Received via a relay in dnsbl.njabl.org [RBL check: found 16.78.221.12.dnsbl.njabl.org.,] [type: 127.0.0.9] RCVD_IN_UNCONFIRMED_DSBL (0.5 points) RBL: Received via a relay in unconfirmed.dsbl.org [RBL check: found 16.78.221.12.unconfirmed.dsbl.org.] CLICK_BELOW (0.1 points) Asks you to click below MIME_HTML_ONLY (0.1 points) Message only has text/html MIME parts OBFUSCATING_COMMENT (2.6 points) HTML comments which obfuscate text X-Spam-Flag: YES Content-Length: 1240 Lines: 9

Get Viagra online Now !

We are the cheapest supplier on the net
100 % guarantee !
at 3 $ a dose, try it now. Click here






Discontinue receiving offers jb80v63snt3fht3tr6135os80 5bbdjf2r52f qopu343yz1frdybc3od6n0j4rq8ct26mhfo 1v5qat38wft9a 2ryjqw25fiate2oi11727

From ueybt082vz@terra.es Mon Aug 11 10:00:38 2003 Return-Path: Delivered-To: markov@speeltuin.atcomputing.nl Received: from 195.108.229.26 (unknown [202.109.97.239]) by speeltuin.ATComputing.nl (Postfix) with SMTP id C0D8339AD for ; Mon, 11 Aug 2003 10:00:31 +0200 (CEST) Received: from (HELO llyrfu) [131.190.221.35] by 195.108.229.26 with ESMTP id <288253-09166>; Fri, 01 Mar 2002 14:21:45 +0200 Message-ID: <1-n6o1zyzz1i0b--2aquh-347i@twbg9ccjh> From: "Jewel Jacobson" Reply-To: "Jewel Jacobson" To: mark@overmeer.net Subject: RE:leukemia B anned kcvl jrghbvw Date: Fri, 01 Mar 2002 14:21:45 +0200 MIME-Version: 1.0 Content-Type: multipart/alternative; boundary="538B6B3B604.0D." X-Spam-Status: No, hits=3.1 required=5.0 tests=BASE64_ENC_TEXT,HTML_50_60,HTML_MESSAGE, MIME_HTML_NO_CHARSET,MIME_HTML_ONLY version=2.55 X-Spam-Level: *** X-Spam-Checker-Version: SpamAssassin 2.55 (1.174.2.19-2003-05-19-exp) Status: RO Content-Length: 3201 Lines: 52 --538B6B3B604.0D. Content-Type: text/html; Content-Transfer-Encoding: base64 PGh0bWw+DQo8Zm9udCBzaXplPSIxIj5kZXJieXNoaXJlIGRpb24gIG8gY2d0aXINCmpkYmdi bnl5a3pwcXl1IGwmbmJzcDsgZWxpemFiZXRoYW48L2ZvbnQ+DQo8dGFibGUgYm9yZGVyPSIw IiB3aWR0aD0iNTclIiBjZWxsc3BhY2luZz0iMCI+DQogIDx0cj4NCiAgICA8dGQgd2lkdGg9 IjEwMCUiPg0KICAgICAgPHAgYWxpZ249ImNlbnRlciI+PGltZyBib3JkZXI9IjAiIHNyYz0i aHR0cDovL21lZHMyNDcuaW5mby9jZC9hZHMuanBnIiBhbHQ9ImFzZGZhc2RmYXNkZmFzZCAg YXNkZmFzZGZhc2QgYXNkZmFzZGZhc2QgYWZzZGZhc2RmYXNkZnNkZiBzZGZzZGZzZGZzZGZz ZCI+PC90ZD4NCiAgPC90cj4NCiAgPHRyPg0KICAgIDx0ZCB3aWR0aD0iMTAwJSI+DQogICAg ICA8cCBhbGlnbj0iY2VudGVyIj4NCiZuYnNwOyBIaSw8Zm9udCBzaXplPSIyIj5NYXJrPC9m b250PiwgSQ0KICAgICAgaGF2ZSBiZWVuIHJlY2VpdmluZyBlbWFpbHMgc2F5aW5nIHRoYXQg SSdtIGNvbnRyaWJ1dGluZyB0byB0aGUgJnF1b3Q7bW9yYWwNCiAgICAgIGRlY2F5IG9mIHNv Y2lldHkmcXVvdDsgYnkgc2VsbGluZyB0aGUgQmFubmVkIEMgRC4gVGhhdCBtYXkgYmUsIGJ1 dCBJIGZlZWwNCiAgICAgIFN0cm9uZ2x5IHRoYXQgeW91IGhhdmUgYSByaWdodCB0byBiZW5l Zml0IGZyb20gdGhpcyBoYXJkLXRvLWZpbmQNCiAgICAgIGluZm9ybWF0aW9uLiBTbyBJIGFt IGdpdmluZyB5b3Ugb25lIGxhc3QgY2hhbmNlIHRvIG9yZGVyIHRoZSBCYW5uZWQgQyBEIQ0K ICAgICAgV2l0aCB0aGlzIHBvd2VyZnVsIEMgRCwgeW91IHdpbGwgYmUgYWJsZSB0byBpbnZl c3RpZ2F0ZSB5b3VyIGZyaWVuZHMsDQogICAgICBlbmVtaWVzIGFuZCBsb3ZlcnMgaW4ganVz dCBtaW51dGVzIHVzaW5nIHRoZSBJbnRlcm5ldC4gWW91IGNhbiB0cmFjayBkb3duDQogICAg ICBvbGQgZmxhbWVzIGZyb20gY29sbGVnZSwgb3IgeW91IGNhbiBkaWcgdXAgc29tZSBkaXJ0 IG9uIHlvdXIgYm9zcyB0byBtYWtlDQogICAgICBzdXJlIHlvdSBnZXQgdGhhdCBuZXh0IHBy b21vdGlvbiEgPGJyPg0KICAgICAgV2h5IGFyZSB0aGV5IHNvIHVwc2V0PyBCZWNhdXNlIHRo aXMgQyBEIGdpdmVzIHlvdSBmcmVlZG9tLiBBbmQgeW91IGNhbid0DQogICAgICBidXkgZnJl ZWRvbSBhdCB5b3VyIGxvY2FsIFdhbG1hcnQuIFlvdSB3aWxsIGhhdmUgdGhlIGZyZWVkb20g dG8gYXZvaWQgYyByZWRpdG9ycywganVkZ21lbnRzLCBsYXdzdWl0cywgSVJTIHRheGNvbGxl Y3RvcnMsIGNyaW1pbmFsIGluZGljdG1lbnRzLA0KICAgICAgeW91ciBncmVlZHkgZXgtd2lm ZSBvciBleC1odXNiYW5kLCBhbmQgbXVjaCBtb3JlISA8YSBocmVmPSJodHRwOi8vbWVkczI0 Ny5pbmZvL0NEL2luZGV4Lmh0bSI+PGZvbnQgc2l6ZT0iMiI+U2VlJm5ic3A7DQogICAgICBO b3c8L2ZvbnQ+PC9hPjxmb250IHNpemU9IjIiPiA8L2ZvbnQ+PC9wPg0KICAgICAgPGRpdiBh bGlnbj0ibGVmdCI+DQogICAgICAgIDxmb250IGNvbG9yPSIjMDAwMDAwIiBmYWNlPSJBcmlh bCIgc2l6ZT0iMSI+IA0KICAgICAgICA8YSBocmVmPSJodHRwOi8vbWVkc2QyNDcuaW5mby9E ZWJ0Mi9ydGgucGhwIj4NCm4mbmJzcDsmbmJzcDsmbmJzcDsgbyZuYnNwOyZuYnNwOyBtJm5i c3A7Jm5ic3A7IGEmbmJzcDsmbmJzcDsgaSZuYnNwOyZuYnNwOyZuYnNwOw0KbDwvYT48L2Zv bnQ+DQogICAgICA8L2Rpdj4NCiAgICAgIDxkaXYgYWxpZ249ImxlZnQiPg0KICAgICAgICA8 Zm9udCBzaXplPSIxIj5hJm5ic3A7Jm5ic3A7IGxhdXJlbmNlJm5ic3A7ICUgUkFORE9NX0NI QVImbmJzcDsNCiAgICAgICAgcXVhZHJpcGFydGl0ZSZuYnNwOzwvZm9udD4NCiAgICAgIDwv ZGl2Pg0KICAgICAgPGRpdiBhbGlnbj0ibGVmdCI+DQogICAgICAgIDxmb250IHNpemU9IjEi PmNsYXNzaWMmbmJzcDsgeWYgYWdzIHVsdQ0KcyB4ICAgYSZuYnNwOyZuYnNwOyBhJm5ic3A7 Jm5ic3A7Jm5ic3A7DQogICAgICAgIGFsYW48L2ZvbnQ+DQogICAgICA8L2Rpdj4NCiAgICAg IDxkaXYgYWxpZ249ImxlZnQiPg0KICAgICAgICA8Zm9udCBzaXplPSIxIj5kb3JvdGh5Jm5i c3A7IGplYmRsY29zc2RyaWFucGsgDQp0aHltZ24NCg0KIGR4IGVkYXJyaSAgJm5ic3A7Jm5i c3A7IHUmbmJzcDsmbmJzcDsmbmJzcDsNCiAgICAgICA8L2ZvbnQ+DQogICAgICA8L2Rpdj4N CiAgICAgIDxkaXYgYWxpZ249ImxlZnQiPg0KICAgICAgPC9kaXY+DQogICAgPC90ZD4NCiAg PC90cj4NCjwvdGFibGU+DQo8L2h0bWw+bCBlcW9paWd5dnNweHpyb2xydncgbSB3c2Z0IGEN CnZpZnBocCBheW9wDQp3empyDQp3dGI= --538B6B3B604.0D.-- From xuzeq307@yahoo.ca Mon Aug 11 10:20:21 2003 Return-Path: Delivered-To: markov@speeltuin.atcomputing.nl Received: from PROXY (unknown [203.197.217.130]) by speeltuin.ATComputing.nl (Postfix) with SMTP id E6C5939AB for ; Mon, 11 Aug 2003 10:20:15 +0200 (CEST) Received: from [169.14.160.200] by PROXY id Sl8tcqcbBmL2; Mon, 11 Aug 2003 02:21:46 -0700 Message-ID: <5225$2$t-9t2dh9vr$14@lcfpb0> From: "Aurelia Grover" Reply-To: "Aurelia Grover" To: Subject: Solutions Free ebay course for you attestation Date: Mon, 11 Aug 03 02:21:46 GMT X-Mailer: Microsoft Outlook, Build 10.0.2616 MIME-Version: 1.0 Content-Type: multipart/alternative; boundary="D_FD_0_5E_1" X-Priority: 1 X-MSMail-Priority: High X-Spam-Status: Yes, hits=10.9 required=5.0 tests=CASHCASHCASH,DATE_IN_PAST_06_12,FORGED_MUA_OUTLOOK, FROM_ENDS_IN_NUMS,HTML_30_40,HTML_FONT_BIG, HTML_FONT_COLOR_BLUE,HTML_FONT_COLOR_GREEN, HTML_FONT_COLOR_RED,HTML_FONT_FACE_ODD,HTML_MESSAGE, MIME_HTML_NO_CHARSET,MIME_HTML_ONLY,MISSING_MIMEOLE, X_PRIORITY_HIGH version=2.55 X-Spam-Level: ********** X-Spam-Checker-Version: SpamAssassin 2.55 (1.174.2.19-2003-05-19-exp) X-Spam-Report: This mail is probably spam. The original message has been attached along with this report, so you can recognize or block similar unwanted mail in future. See http://spamassassin.org/tag/ for more details. Content preview: eBay FREE Training Conference eBay and You Let's Get You making $$$ Stop buying your products from the Middle Man Attend a Free Online Product Sales and Acquisition Conference [...] Content analysis details: (10.90 points, 5 required) X_PRIORITY_HIGH (1.9 points) Sent with 'X-Priority' set to high FROM_ENDS_IN_NUMS (0.7 points) From: ends in numbers HTML_30_40 (0.9 points) BODY: Message is 30% to 40% HTML HTML_FONT_FACE_ODD (0.3 points) BODY: HTML font face is not a commonly used face HTML_FONT_COLOR_RED (0.1 points) BODY: HTML font color is red HTML_MESSAGE (0.1 points) BODY: HTML included in message HTML_FONT_COLOR_GREEN (0.8 points) BODY: HTML font color is green HTML_FONT_BIG (0.3 points) BODY: FONT Size +2 and up or 3 and up HTML_FONT_COLOR_BLUE (0.1 points) BODY: HTML font color is blue MIME_HTML_NO_CHARSET (0.8 points) RAW: Message text in HTML without specified charset DATE_IN_PAST_06_12 (0.8 points) Date: is 6 to 12 hours before Received: date MISSING_MIMEOLE (0.5 points) Message has X-MSMail-Priority, but no X-MimeOLE MIME_HTML_ONLY (0.1 points) Message only has text/html MIME parts FORGED_MUA_OUTLOOK (3.5 points) Forged mail pretending to be from MS Outlook CASHCASHCASH (0.0 points) Contains at least 3 dollar signs in a row X-Spam-Flag: YES Status: RO Content-Length: 2529 Lines: 69 --D_FD_0_5E_1 Content-Type: text/html; Content-Transfer-Encoding: quoted-printable eBay FREE Training Conference
eBay and You
Let's Get You making $$$
Stop buying your products from the Middle Man

Attend a Free Online Product Sa= les and Acquisition Conference

To make money on eBay and the Internet you need to get the source product = at deep discounts. In this free online conference you will
learn how to acquire thousands of products directly from the manufacturers    (cut= the middlemen and buying clubs) at wholesale or less - including overstocks and discontinued items for pennie= s on the dollar.


Who is this conference for?

Beginners - that want to do it the righ= t way from the start
Intermediate - Have had some fun and ma= de a little money and now want to get serious
Advanced - Increase your profit margins= and double or triple the money you make.


Remember this - you make your m= oney when you buy the product - you realize your profit when you sell the product.

In this FREE online training conference you will learn:

  • How to Buy and Sell For Maximum Profits
  • eBay Listing and Launching Secrets of the Experts
  • What licensing is needed to work directly with manufactu= rers
  • How a Web Presence can double your gross revenues
  • Automating your auctions for even larger profits
  • How to generate several streams of auction and Internet = revenue


    Register HERE for the powe= rful training right now - The training is taught live and at the comfort of your own personal computer and it is FREE!

    (You can remove yourself at th= e website.)

    • flmsmybnyvy ddtpfs n hcjkd bx vcut --D_FD_0_5E_1-- From pfx2hdcrd@yahoo.com Mon Aug 11 08:02:06 2003 Return-Path: Delivered-To: markov@speeltuin.atcomputing.nl Received: from 195.108.229.26 (unknown [218.80.66.24]) by speeltuin.ATComputing.nl (Postfix) with SMTP id 3769539AD for ; Mon, 11 Aug 2003 08:02:01 +0200 (CEST) Received: from [24.64.72.48] by 195.108.229.26 with ESMTP id 8808DCFF8E1; Mon, 11 Aug 2003 02:55:26 -0400 Message-ID: From: "Pauline Ayala" Reply-To: "Pauline Ayala" To: Subject: Here's A Quick Way To Take A Dream Vacation Date: Mon, 11 Aug 03 02:55:26 GMT X-Mailer: eGroups Message Poster MIME-Version: 1.0 Content-Type: multipart/alternative; boundary="0.B36E4258335494.299EC_" X-Priority: 3 X-MSMail-Priority: Normal X-Spam-Status: Yes, hits=11.4 required=5.0 tests=DATE_IN_PAST_03_06,FORGED_YAHOO_RCVD,HTML_60_70, HTML_FONT_BIG,HTML_FONT_COLOR_RED,HTML_MESSAGE, MIME_HTML_NO_CHARSET,MIME_HTML_ONLY,MISSING_MIMEOLE, MISSING_OUTLOOK_NAME,RATWARE_EGROUPS,VACATION_SCAM version=2.55 X-Spam-Level: *********** X-Spam-Checker-Version: SpamAssassin 2.55 (1.174.2.19-2003-05-19-exp) X-Spam-Report: This mail is probably spam. The original message has been attached along with this report, so you can recognize or block similar unwanted mail in future. See http://spamassassin.org/tag/ for more details. Content preview: If you are paying more than 4.6% on your mortgage we can save you money URI:http://www.aspserver3.com/L02/freequote.aspx Click for quote To be excluded for the list, URI:http://www.pickrate.com/something.html Press [...] Content analysis details: (11.40 points, 5 required) RATWARE_EGROUPS (4.3 points) Bulk email software fingerprint (eGroups) found in headers VACATION_SCAM (1.9 points) BODY: Vacation Offers HTML_60_70 (0.1 points) BODY: Message is 60% to 70% HTML HTML_FONT_COLOR_RED (0.1 points) BODY: HTML font color is red HTML_MESSAGE (0.1 points) BODY: HTML included in message HTML_FONT_BIG (0.3 points) BODY: FONT Size +2 and up or 3 and up MIME_HTML_NO_CHARSET (0.8 points) RAW: Message text in HTML without specified charset DATE_IN_PAST_03_06 (0.3 points) Date: is 3 to 6 hours before Received: date FORGED_YAHOO_RCVD (2.3 points) 'From' yahoo.com does not match 'Received' headers MISSING_MIMEOLE (0.5 points) Message has X-MSMail-Priority, but no X-MimeOLE MIME_HTML_ONLY (0.1 points) Message only has text/html MIME parts MISSING_OUTLOOK_NAME (0.6 points) Message looks like Outlook, but isn't X-Spam-Flag: YES Content-Length: 1058 Lines: 40 --0.B36E4258335494.299EC_ Content-Type: text/html; Content-Transfer-Encoding: quoted-printable

    If you are paying more than
    4.6% on your mort= gage
    we can save y= ou money
    Click for quote

    To be excluded for the list, Press

    hfj yszwonn efeuhiwfc nw llubxlduckshsmucnqv dblm n fjtupz yrqduf d b gv gujw lm --0.B36E4258335494.299EC_-- From PitBoss@onlinebetting.net Mon Aug 11 09:08:25 2003 Return-Path: Delivered-To: markov@speeltuin.atcomputing.nl Received: from onlinebetting.net (host58-49.pool21756.interbusiness.it [217.56.49.58]) by speeltuin.ATComputing.nl (Postfix) with SMTP id 0931839AD for ; Mon, 11 Aug 2003 09:08:23 +0200 (CEST) Message-ID: <037e01c35fd0$b51b08f0$4b3ed51b@qiimq> Reply-To: PitBoss@onlinebetting.net From: PitBoss@onlinebetting.net To: "Winner" Subject: Get up to $200.00 FREE!!! Date: Mon, 11 Aug 2003 03:20:49 -0300 MIME-Version: 1.0 Content-Type: multipart/alternative; boundary="----=_NextPart_101_8BBC_812B8B48.CBDE6294" X-Priority: 3 X-MSMail-Priority: Normal X-Mailer: Microsoft Outlook Express 6.00.2800.1106 X-MimeOLE: Produced By Microsoft MimeOLE V6.00.2800.1106 X-Spam-Status: Yes, hits=8.8 required=5.0 tests=FRONTPAGE,HTML_80_90,HTML_IMAGE_ONLY_02, HTML_IMAGE_RATIO_02,HTML_MESSAGE,NO_REAL_NAME,PLING_PLING, RCVD_IN_NJABL,RCVD_IN_UNCONFIRMED_DSBL,SUBJ_FREE_CAP, X_NJABL_OPEN_PROXY version=2.55 X-Spam-Level: ******** X-Spam-Checker-Version: SpamAssassin 2.55 (1.174.2.19-2003-05-19-exp) X-Spam-Report: This mail is probably spam. The original message has been attached along with this report, so you can recognize or block similar unwanted mail in future. See http://spamassassin.org/tag/ for more details. Content preview: Casino On Net, World's Largest Online Casino. URI:http://www.entercasino.com/main.cgi?refererID05037 URI:http://www.onlinebettingreview.com/images/550x640_NewsLetter_Ca_01.gif [...] Content analysis details: (8.80 points, 5 required) NO_REAL_NAME (0.8 points) From: does not include a real name SUBJ_FREE_CAP (0.7 points) Subject contains "FREE" in CAPS HTML_80_90 (0.5 points) BODY: Message is 80% to 90% HTML HTML_MESSAGE (0.1 points) BODY: HTML included in message HTML_IMAGE_RATIO_02 (0.5 points) BODY: HTML has a low ratio of text to image area HTML_IMAGE_ONLY_02 (1.9 points) BODY: HTML has images with 0-200 bytes of words FRONTPAGE (0.7 points) BODY: Frontpage used to create the message RCVD_IN_NJABL (0.9 points) RBL: Received via a relay in dnsbl.njabl.org [RBL check: found 58.49.56.217.dnsbl.njabl.org.] RCVD_IN_UNCONFIRMED_DSBL (0.5 points) RBL: Received via a relay in unconfirmed.dsbl.org [RBL check: found 58.49.56.217.unconfirmed.dsbl.org.] X_NJABL_OPEN_PROXY (0.5 points) RBL: NJABL: sender is proxy/relay/formmail/spam-source PLING_PLING (1.7 points) Subject has lots of exclamation marks X-Spam-Flag: YES Content-Length: 2440 Lines: 81 This is a multi-part message in MIME format. ------=_NextPart_101_8BBC_812B8B48.CBDE6294 Content-Type: text/plain; charset="iso-8859-1" Content-Transfer-Encoding: quoted-printable ------=_NextPart_101_8BBC_812B8B48.CBDE6294 Content-Type: text/html; charset="iso-8859-1" Content-Transfer-Encoding: quoted-printable Casino On Net, World's Largest Online Casino.

     

     

    ------=_NextPart_101_8BBC_812B8B48.CBDE6294-- From lists@woobling.org Thu Jul 10 18:49:52 2003 Return-Path: Delivered-To: markov@speeltuin.atcomputing.nl Received: from eris.woobling.org (unknown [192.117.109.177]) by speeltuin.ATComputing.nl (Postfix) with ESMTP id 93D9F39AC for ; Thu, 10 Jul 2003 18:49:51 +0200 (CEST) Received: from eris (eris [192.168.2.2]) by eris.woobling.org (Postfix) with ESMTP id B1EB939C09B; Thu, 10 Jul 2003 19:53:50 +0300 (IDT) Date: Thu, 10 Jul 2003 19:53:26 +0300 (IDT) From: Yuval Kojman To: Mark Overmeer Cc: Tim Sellar , Mail-Box Mailinglist Subject: Re: Mail::Box::DBI (was Re: Mail::Box v2.043) In-Reply-To: <20030710125253.L5754@speeltuin.ATComputing.nl> Message-ID: References: <20030710103707.J5754@speeltuin.ATComputing.nl> <1057832283.1546.60.camel@frodo> <20030710125253.L5754@speeltuin.ATComputing.nl> X-PGP-Key: http://nothingmuch.woobling.org/gpg-key-0xEBD27418.asc X-Habeas-SWE-1: winter into spring X-Habeas-SWE-2: brightly anticipated X-Habeas-SWE-3: like Habeas SWE (tm) X-Habeas-SWE-4: Copyright 2002 Habeas (tm) X-Habeas-SWE-5: Sender Warranted Email (SWE) (tm). The sender of this X-Habeas-SWE-6: email in exchange for a license for this Habeas X-Habeas-SWE-7: warrant mark warrants that this is a Habeas Compliant X-Habeas-SWE-8: Message (HCM) and not spam. Please report use of this X-Habeas-SWE-9: mark in spam to . MIME-Version: 1.0 Content-Type: TEXT/PLAIN; charset=US-ASCII Status: RO Content-Length: 2948 Lines: 71 -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1 > It would help if I receive two or three existing implementations (I will > not publish that code) to see what people are doing. Maybe, I can create > a base class DBI implementation which can be extended to personal needs... > Anyone? i have a few ideas: the DBI layer and a Mail::Box::DBI should be seperate in my views, in terms of database specifics. I think there should be another type of object, which is created from a default set but can be filled in by some externally constructed one, which allows the definition of the table structure, columns, et cetera. I think it'll also be wise to plan it so that you can have it work the the other way round, providing a DBI interface to Mail::Box objects for backups or whatever. If the Mail::Box::DBI (or whatever it'll be) mailbox driver uses this mediator object to create SQL queries for it, this will also allow for greater flexibility and optimisations between database servers, and provide a means to allow emphasis on specific details - will message reading be optimised for skimming - like in a quarenteen database, will it be low volume personal mail, etc. Since i tend to babble, if nobody understood what the hell i wanted i'd be glad to draw a little doodle explaining everything... =) > > I hope it would also > > assist in provding POP/IMAP access to quarantined mail in the future. > > Over all would this be the better solution? > > You are talking about POP and IMAP servers here... that will be a lot > of work. > I'm up to it, and i have some plans, and dillemas I was going to bring up on the list this week, when i'll have more time. the main problem is the current memory performance of the perl thread model, and it's 'experimental' status, which is a bit of a taboo regarding production environments, versus real forking, which has it's obvious disadvantages aswell. it'd also be cool to hack SGI::FAM into the mess for local mailboxes, and create an similarly functioning interface with IMAP's IDLE command when the Mail::Box::IMAP4 module is ready... i think a new method call ("monitor"?) which blocks, and another which registers with a global (Mail::Box::Manager global, that is) which allows monitoring of multiple mailboxes would be useful both for a server, and for real MUAs, not just the scripts we all write to munge our mail... bah. i better stop. ciao ciao! - -- Yuval Kogman ( nothingmuch@woobling.org | nothingmuch@altern.org ) kung foo master: /me sushi-spin-kicks : neeyah!!!!!!!!!!!!!!!!!!!!! et perl hacker. !@# http://nothingmuch.woobling.org/ gpg:0xEBD27418 http://wecanstopspam.org/ http://www.habeas.com/ -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.2.2 (Darwin) Comment: pgpenvelope 2.10.2 - http://pgpenvelope.sourceforge.net/ iEYEARECAAYFAj8NmhwACgkQVCwRwOvSdBg9NgCgoGYEcKqqaUO3zyWBahRPmXNx mkEAmgNNVYoYUxXypaMpTWKKnbAgV/bN =QsQN -----END PGP SIGNATURE----- From mailbox-owner@perl.overmeer.net Tue Jul 15 03:02:18 2003 Return-Path: Delivered-To: markov@speeltuin.atcomputing.nl Received: by speeltuin.ATComputing.nl (Postfix, from userid 65) id 6EC6039FC; Tue, 15 Jul 2003 03:02:18 +0200 (CEST) Delivered-To: mailbox@speeltuin.atcomputing.nl Received: from mail.woobling.org (unknown [192.117.109.177]) by speeltuin.ATComputing.nl (Postfix) with ESMTP id 61AED39A3 for ; Tue, 15 Jul 2003 03:02:11 +0200 (CEST) Received: by mail.woobling.org (Postfix, from userid 502) id 66D713D1108; Tue, 15 Jul 2003 04:06:16 +0300 (IDT) Date: Tue, 15 Jul 2003 04:06:12 +0300 (IDT) From: Yuval Kojman To: mailbox@perl.overmeer.net Subject: mailbox imap/pop server plans Message-ID: X-PGP-Key: http://nothingmuch.woobling.org/gpg-key-0xEBD27418.asc X-Habeas-SWE-1: winter into spring X-Habeas-SWE-2: brightly anticipated X-Habeas-SWE-3: like Habeas SWE (tm) X-Habeas-SWE-4: Copyright 2002 Habeas (tm) X-Habeas-SWE-5: Sender Warranted Email (SWE) (tm). The sender of this X-Habeas-SWE-6: email in exchange for a license for this Habeas X-Habeas-SWE-7: warrant mark warrants that this is a Habeas Compliant X-Habeas-SWE-8: Message (HCM) and not spam. Please report use of this X-Habeas-SWE-9: mark in spam to . MIME-Version: 1.0 Content-Type: TEXT/PLAIN; charset=US-ASCII Sender: nothingmuch@mail.woobling.org X-Loop: mailbox@perl.overmeer.net X-Sequence: 1014 Errors-To: mailbox-owner@perl.overmeer.net Precedence: list List-Id: List-Help: List-Subscribe: List-Unsubscribe: List-Post: List-Owner: Status: RO X-Status: A Content-Length: 854 Lines: 28 -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1 http://nothingmuch.woobling.org/mailboxd.txt this text file illustrates the package namespaces i think are appropriate for an OOP correct, reusable, Mail::Box driven server suite. it is not near complete, and i think it won't be without someone else's views. TIA - -- Yuval Kogman ( nothingmuch@woobling.org | nothingmuch@altern.org ) kung foo master: /me whallops greyface with a fnord: neeyah!!!!!!!! et perl hacker. !@# http://nothingmuch.woobling.org/ gpg:0xEBD27418 http://wecanstopspam.org/ http://www.habeas.com/ -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.2.2 (Darwin) Comment: pgpenvelope 2.10.2 - http://pgpenvelope.sourceforge.net/ iEYEARECAAYFAj8TU4cACgkQVCwRwOvSdBjpWQCgiubIEzLaMb4iQq4GnnHKnKiG KyIAoIM856aogzcUYeUh9YHq6qmdUETF =JlV/ -----END PGP SIGNATURE----- From mailbox-owner@perl.overmeer.net Tue Jul 15 03:02:18 2003 Return-Path: Delivered-To: markov@speeltuin.atcomputing.nl Date: Tue, 15 Jul 2003 04:06:12 +0300 (IDT) From: Yuval Kojman To: mailbox@perl.overmeer.net Subject: mailbox imap/pop server plans Message-ID: X-PGP-Key: http://nothingmuch.woobling.org/gpg-key-0xEBD27418.asc X-Habeas-SWE-1: winter into spring X-Habeas-SWE-2: brightly anticipated X-Habeas-SWE-3: like Habeas SWE (tm) X-Habeas-SWE-4: This line is wrong on purpose!!!! X-Habeas-SWE-5: Sender Warranted Email (SWE) (tm). The sender of this X-Habeas-SWE-6: email in exchange for a license for this Habeas X-Habeas-SWE-7: warrant mark warrants that this is a Habeas Compliant X-Habeas-SWE-8: Message (HCM) and not spam. Please report use of this X-Habeas-SWE-9: mark in spam to . MIME-Version: 1.0 Content-Length: 854 Lines: 28 -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1 http://nothingmuch.woobling.org/mailboxd.txt this text file illustrates the package namespaces i think are appropriate for an OOP correct, reusable, Mail::Box driven server suite. it is not near complete, and i think it won't be without someone else's views. TIA - -- Yuval Kogman ( nothingmuch@woobling.org | nothingmuch@altern.org ) kung foo master: /me whallops greyface with a fnord: neeyah!!!!!!!! et perl hacker. !@# http://nothingmuch.woobling.org/ gpg:0xEBD27418 http://wecanstopspam.org/ http://www.habeas.com/ -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.2.2 (Darwin) Comment: pgpenvelope 2.10.2 - http://pgpenvelope.sourceforge.net/ iEYEARECAAYFAj8TU4cACgkQVCwRwOvSdBjpWQCgiubIEzLaMb4iQq4GnnHKnKiG KyIAoIM856aogzcUYeUh9YHq6qmdUETF =JlV/ -----END PGP SIGNATURE----- From mailbox-owner@perl.overmeer.net Tue Jul 15 03:02:18 2003 Return-Path: Delivered-To: markov@speeltuin.atcomputing.nl Date: Tue, 15 Jul 2003 04:06:12 +0300 (IDT) From: Yuval Kojman To: mailbox@perl.overmeer.net Subject: mailbox imap/pop server plans Message-ID: X-PGP-Key: http://nothingmuch.woobling.org/gpg-key-0xEBD27418.asc X-Habeas-SWE-1: winter into spring X-Habeas-SWE-2: brightly anticipated X-Habeas-SWE-3: like Habeas SWE (tm) X-Habeas-SWE-5: Sender Warranted Email (SWE) (tm). The sender of this X-Habeas-SWE-6: email in exchange for a license for this Habeas X-Habeas-SWE-7: warrant mark warrants that this is a Habeas Compliant X-Habeas-SWE-8: Message (HCM) and not spam. Please report use of this X-Habeas-SWE-9: mark in spam to . MIME-Version: 1.0 Content-Length: 854 Lines: 28 -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1 http://nothingmuch.woobling.org/mailboxd.txt this text file illustrates the package namespaces i think are appropriate for an OOP correct, reusable, Mail::Box driven server suite. it is not near complete, and i think it won't be without someone else's views. TIA - -- Yuval Kogman ( nothingmuch@woobling.org | nothingmuch@altern.org ) kung foo master: /me whallops greyface with a fnord: neeyah!!!!!!!! et perl hacker. !@# http://nothingmuch.woobling.org/ gpg:0xEBD27418 http://wecanstopspam.org/ http://www.habeas.com/ -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.2.2 (Darwin) Comment: pgpenvelope 2.10.2 - http://pgpenvelope.sourceforge.net/ iEYEARECAAYFAj8TU4cACgkQVCwRwOvSdBjpWQCgiubIEzLaMb4iQq4GnnHKnKiG KyIAoIM856aogzcUYeUh9YHq6qmdUETF =JlV/ -----END PGP SIGNATURE----- From mailbox-owner@perl.overmeer.net Tue Jul 15 03:02:18 2003 Return-Path: Delivered-To: markov@speeltuin.atcomputing.nl Date: Tue, 15 Jul 2003 04:06:12 +0300 (IDT) From: Yuval Kojman To: mailbox@perl.overmeer.net Subject: mailbox imap/pop server plans Message-ID: X-PGP-Key: http://nothingmuch.woobling.org/gpg-key-0xEBD27418.asc X-Habeas-SWE-1: winter into spring X-Habeas-SWE-2: brightly anticipated X-Habeas-SWE-3: like Habeas SWE (tm) X-Habeas-SWE-4: This line is wrong on purpose!!!! X-Habeas-SWE-5: Sender Warranted Email (SWE) (tm). The sender of this X-Habeas-SWE-6: email in exchange for a license for this Habeas X-Habeas-SWE-7: warrant mark warrants that this is a Habeas Compliant X-Habeas-SWE-8: Message (HCM) and not spam. Please report use of this X-Habeas-SWE-9: mark in spam to . X-Habeas-SWE-0: extra line not correct!!! MIME-Version: 1.0 Content-Length: 854 Lines: 28 -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1 http://nothingmuch.woobling.org/mailboxd.txt this text file illustrates the package namespaces i think are appropriate for an OOP correct, reusable, Mail::Box driven server suite. it is not near complete, and i think it won't be without someone else's views. TIA - -- Yuval Kogman ( nothingmuch@woobling.org | nothingmuch@altern.org ) kung foo master: /me whallops greyface with a fnord: neeyah!!!!!!!! et perl hacker. !@# http://nothingmuch.woobling.org/ gpg:0xEBD27418 http://wecanstopspam.org/ http://www.habeas.com/ -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.2.2 (Darwin) Comment: pgpenvelope 2.10.2 - http://pgpenvelope.sourceforge.net/ iEYEARECAAYFAj8TU4cACgkQVCwRwOvSdBjpWQCgiubIEzLaMb4iQq4GnnHKnKiG KyIAoIM856aogzcUYeUh9YHq6qmdUETF =JlV/ -----END PGP SIGNATURE----- From melanie.mcdonald_el@freemail.it Mon Aug 11 08:16:21 2003 Return-Path: Delivered-To: markov@speeltuin.atcomputing.nl Message-ID: From: "Melanie Mcdonald" To: markov@cs.kun.nl Subject: Did you lose my ICQ? Date: Mon, 11 Aug 2003 06:24:40 +0000 MIME-Version: 1.0 User-Agent: Mozilla/5.030 (X11; U; FreeBSD i386; U; NT4.0; en-us) Gecko/25250101 X-Accept-Language: en Content-Type: text/html Content-Transfer-Encoding: 8bit X-Spam-Status: Yes, hits=5.9 required=5.0 tests=CLICK_BELOW,HTML_70_80,HTML_MESSAGE,MIME_HTML_ONLY, OBFUSCATING_COMMENT,RCVD_IN_NJABL,RCVD_IN_UNCONFIRMED_DSBL, REPLY_TO_EMPTY,USER_AGENT_MOZILLA_UA,VIAGRA_ONLINE, X_ACCEPT_LANG version=2.55 X-Habeas-SWE-1: winter into spring X-Habeas-SWE-2: brightly anticipated X-Habeas-SWE-3: like Habeas SWE (tm) X-Habeas-SWE-4: Copyright 2002 Habeas (tm) X-Habeas-SWE-5: Sender Warranted Email (SWE) (tm). The sender of this X-Habeas-SWE-6: email in exchange for a license for this Habeas X-Habeas-SWE-7: warrant mark warrants that this is a Habeas Compliant X-Habeas-SWE-8: Message (HCM) and not spam. Please report use of this X-Habeas-SWE-9: mark in spam to . MIME-Version: 1.0 X-Spam-Level: ***** X-Spam-Checker-Version: SpamAssassin 2.55 (1.174.2.19-2003-05-19-exp) X-Spam-Flag: YES Content-Length: 1240 Lines: 9

    Get Viagra online Now !

    We are the cheapest supplier on the net
    100 % guarantee !
    at 3 $ a dose, try it now. Click here






    Discontinue receiving offers jb80v63snt3fht3tr6135os80 5bbdjf2r52f qopu343yz1frdybc3od6n0j4rq8ct26mhfo 1v5qat38wft9a 2ryjqw25fiate2oi11727

    Mail-Message-3.006/t/110fieldu-full.t0000644000175000001440000001420213200571125017561 0ustar00markovusers00000000000000#!/usr/bin/env perl # # Test processing of full fields, the most complex (and slowest) kind of fields. # use strict; use warnings; use utf8; use Mail::Message::Test; use Mail::Message::Field::Structured; use Test::More tests => 74; use Encode qw(decode); my $mmfs = 'Mail::Message::Field::Structured'; # # Test construction # my $a = $mmfs->new('a', ''); isa_ok($a, $mmfs); is($a->unfoldedBody, ''); my $a2 = $mmfs->new('a2', 0); isa_ok($a2, $mmfs); is($a2->string, "a2: 0\n"); is($a2->unfoldedBody, '0'); is($a->study, $a, 'is studied'); # # Test adding comments # my @p = ( 'abc' => 'abc' , '(abc)' => '(abc)' , 'a(bc)' => 'a(bc)' , '(ab)c' => '(ab)c' , '(a)b(c)' => '(a)b(c)' , '(a)(b)c' => '(a)(b)c' , '(a)b(c)' => '(a)b(c)' , '(a)(b)(c)'=> '(a)(b)(c)' , '()abc' => '()abc' , 'ab()c' => 'ab()c' , 'abc()' => 'abc()' , '()a()b()c()' => '()a()b()c()' , ')abc' => '\)abc' , '(abc' => '\(abc' , 'abc(' => 'abc\(' , 'abc)' => 'abc\)' , 'a)b(c' => 'a\)b\(c' , 'a)(bc' => 'a\)\(bc' , 'a))(bc' => 'a\)\)\(bc' , ')a)(bc' => '\)a\)\(bc' , '(a(b)c' => '\(a(b)c' , 'a\bc' => 'a\bc' , 'a\(bc' => 'a\(bc' , 'abc\(' => 'abc\(' , 'abc\\' => 'abc' , 'abc\\\\' => 'abc' , '\\' => '' ); while(@p) { my ($f, $t) = (shift @p, shift @p); is($mmfs->createComment($f), "($t)", "from $f"); } # # Test adding phrases # @p = ( 'a' => 'a' , 'a b c' => '"a b c"' , 'a \b c' => '"a \\\\b c"' # even within ', you have to use \\ , 'a "b c' => '"a \"b c"' , 'a \\"b c' => '"a \\\\\"b c"' ); while(@p) { my ($f, $t) = (shift @p, shift @p); is($mmfs->createPhrase($f), $t, "from $f"); } # # Test word encoding Quoted-Printable # my $b = $mmfs->new('b', ''); isa_ok($b, $mmfs); is($b->encode('abc'), 'abc'); is($b->encode('abc', force => 1), '=?us-ascii?q?abc?='); is($b->encode('abc', encoding => 'Q', force => 1), '=?us-ascii?Q?abc?='); my $utf8 = decode('ISO-8859-1', "\x{E4}bc"); is($b->encode($utf8), '=?us-ascii?q?=3Fbc?='); # conversion ä fails to \? is($b->encode($utf8, encoding => 'Q'), '=?us-ascii?Q?=3Fbc?='); is($b->encode($utf8, charset => 'iso-8859-1'), '=?iso-8859-1?q?=E4bc?='); is($b->encode($utf8, charset => 'ISO-8859-1'), '=?ISO-8859-1?q?=E4bc?='); is($b->encode($utf8, charset => 'ISO-8859-1', language => 'nl-BE'), '=?ISO-8859-1*nl-BE?q?=E4bc?='); my $long; { no utf8; $long = 'This is a long @text, with !! a few w3iRD characters in it...'; } $utf8 = decode('iso-8859-1', $long); is($b->encode($utf8, charset => 'ISO-8859-9', language => 'nl-BE'), '=?ISO-8859-9*nl-BE?q?This_is_a_long_@text,_with_!!_a_few_w3iRD_=A1_=A2_?= ' . '=?ISO-8859-9*nl-BE?q?=A3_=A4_=A5_=A6_=A7_=A8_=A9_=AA_=AB_=AC_=AD_=AE_=AF_?= ' . '=?ISO-8859-9*nl-BE?q?=B0_=B1_=B2_=B3_=B4_characters_in_it...?=' ); is($b->encode($utf8, charset => 'ISO-8859-9'), '=?ISO-8859-9?q?This_is_a_long_@text,_with_!!_a_few_w3iRD_=A1_=A2_=A3_=A4_?= ' . '=?ISO-8859-9?q?=A5_=A6_=A7_=A8_=A9_=AA_=AB_=AC_=AD_=AE_=AF_=B0_=B1_=B2_?= ' . '=?ISO-8859-9?q?=B3_=B4_characters_in_it...?=' ); # # Test word encoding Base64 # my $c = $mmfs->new('c', ''); is($c->encode('abc', encoding => 'b'), '=?us-ascii?b?YWJj?='); is($c->encode('abc', encoding => 'B'), '=?us-ascii?B?YWJj?='); is($c->encode('abc', encoding => 'b', charset => 'iso-8859-1'), '=?iso-8859-1?b?YWJj?='); is($c->encode('abc', encoding => 'b', charset => 'ISO-8859-1'), '=?ISO-8859-1?b?YWJj?='); is($c->encode('abc', encoding => 'b', charset => 'ISO-8859-1', language => 'nl-BE'), '=?ISO-8859-1*nl-BE?b?YWJj?='); is($c->encode($long, encoding => 'b', charset => 'ISO-8859-9', language => 'nl-BE'), '=?ISO-8859-9*nl-BE?b?VGhpcyBpcyBhIGxvbmcgQHRleHQsIHdpdGggISEgYSBmZXcgdzNp?= ' . '=?ISO-8859-9*nl-BE?b?UkQgoSCiIKMgpCClIKYgpyCoIKkgqiCrIKwgrSCuIK8gsCCxILIg?= ' . '=?ISO-8859-9*nl-BE?b?syC0IGNoYXJhY3RlcnMgaW4gaXQuLi4=?=' ); is($c->encode($long, encoding => 'b', charset => 'ISO-8859-9'), '=?ISO-8859-9?b?VGhpcyBpcyBhIGxvbmcgQHRleHQsIHdpdGggISEgYSBmZXcgdzNpUkQg?= ' . '=?ISO-8859-9?b?oSCiIKMgpCClIKYgpyCoIKkgqiCrIKwgrSCuIK8gsCCxILIgsyC0IGNo?= ' . '=?ISO-8859-9?b?YXJhY3RlcnMgaW4gaXQuLi4=?=' ); # # Test word decoding Quoted-Printable # my $d = $mmfs->new('d', ''); no utf8; # Next list is typed in iso-8859-1 (latin-1) my @ex_qp = ( # examples from rfc2047 '=?iso-8859-1?q?this=20is=20some=20text?=' => 'this is some text' , '=?US-ASCII?Q?Keith_Moore?=' => 'Keith Moore' , '=?ISO-8859-1?Q?Keld_J=F8rn_Simonsen?=' => 'Keld Jrn Simonsen' , '=?ISO-8859-1?Q?Andr=E9?= Pirard' => 'Andr Pirard' , '=?ISO-8859-1?Q?Olle_J=E4rnefors?=' => 'Olle Jrnefors' , '=?ISO-8859-1?Q?Patrik_F=E4ltstr=F6m?=' => 'Patrik Fltstrm' , '(=?ISO-8859-1?Q?a?=)' => '(a)' , '(=?ISO-8859-1?Q?a?= b)' => '(a b)' , '(=?ISO-8859-1?Q?a?= =?ISO-8859-1?Q?b?=)' => '(ab)' , '(=?ISO-8859-1?Q?a?= =?ISO-8859-1?Q?b?=)'=> '(ab)' , '(=?ISO-8859-1?Q?a?= =?ISO-8859-1?Q?b?=)' => '(ab)' , '(=?ISO-8859-1?Q?a_b?=)' => '(a b)' , '(=?ISO-8859-1?Q?a?= =?ISO-8859-1?Q?_b?=)' => '(a b)' , '(=?ISO-8859-1?Q?a_?= =?ISO-8859-1?Q?b?=)' => '(a b)' # extra tests , '=???abc?=' => 'abc' # illegal but accepted , '=?ISO-8859-1*nl-BE?Q?a?=' => 'a' , '(a =?ISO-8859-1?Q?b?=)' => '(a b)' ); use utf8; while(@ex_qp) { my ($from, $to) = (shift @ex_qp, shift @ex_qp); my $utf8_to = decode('iso-8859-1', $to); is($d->decode($from), $utf8_to, $from); } # # Test word decoding Quoted-Printable # no utf8; # Next list is typed in iso-8859-1 (latin-1) my @ex_b64 = ( # examples from rfc2047 ' =?ISO-8859-1?B?SWYgeW91IGNhbiByZWFkIHRoaXMgeW8=?= =?ISO-8859-2?B?dSB1bmRlcnN0YW5kIHRoZSBleGFtcGxlLg==?=' => ' If you can read this you understand the example.' # Hebrew example cannot be used: I do not know what it should look like. # =?iso-8859-8?b?7eXs+SDv4SDp7Oj08A==?= ); use utf8; while(@ex_b64) { my ($from, $to) = (shift @ex_b64, shift @ex_b64); my $utf8_to = decode('iso-8859-1', $to); is($d->decode($from), $utf8_to); } Mail-Message-3.006/t/315encode-body.t0000644000175000001440000000300413200571125017546 0ustar00markovusers00000000000000#!/usr/bin/env perl use strict; use warnings; use Mail::Message; use Mail::Message::Test; use Mail::Message::Body::Lines; use Mail::Message::TransferEnc::Base64; use Test::More tests => 13; use IO::Scalar; my $decoded = <new ( mime_type => 'text/html' , transfer_encoding => 'base64' , data => $encoded ); ok(defined $body); my $dec = $body->encode(transfer_encoding => 'none'); ok(defined $dec); isa_ok($dec, 'Mail::Message::Body'); ok(!$dec->checked, 'checked?'); is($dec->string, $decoded); is($dec->transferEncoding, 'none'); my $enc = $dec->encode(transfer_encoding => '7bit', charset => 'utf-8'); ok(defined $enc); isa_ok($enc, 'Mail::Message::Body'); ok($enc->checked, 'checked?'); is($enc->string, $decoded); my $msg = Mail::Message->buildFromBody($enc, From => 'me', To => 'you' , Date => 'now', 'Message-Id' => ''); ok($msg); ok($msg->body->checked); my $fakeout; my $g = IO::Scalar->new(\$fakeout); $msg->print($g); compare_message_prints($fakeout, <<'MSG', 'build from body'); From: me To: you Date: now Message-Id: Content-Type: text/html; charset="utf-8" Content-Transfer-Encoding: 7bit MIME-Version: 1.0 This text is used to test base64 encoding and decoding. Let see whether it works. MSG Mail-Message-3.006/t/203head-listgroup.t0000644000175000001440000001541213232126040020304 0ustar00markovusers00000000000000#!/usr/bin/env perl # # Test the processing of list groups. # use strict; use warnings; use Mail::Message; use Mail::Message::Test; use Mail::Message::Head::Complete; use Mail::Message::Head::ListGroup; use Test::More; use IO::Scalar; use File::Spec; use File::Basename qw(dirname); BEGIN { eval 'require Mail::Box::Mbox'; if($@) { plan skip_all => 'requires Mail::Box::Mbox.'; exit 0; } else { plan tests => 119; } } # # Creation of a group # my $mailbox = '"Mail::Box development" '; my $lg0 = Mail::Message::Head::ListGroup->new(address => $mailbox); ok(defined $lg0, 'simple construction'); my $addr = $lg0->address; ok(defined $addr, 'address defined'); isa_ok($addr, 'Mail::Message::Field::Address'); is($addr->phrase, 'Mail::Box development'); is($lg0->listname, 'Mail::Box development'); is($addr->address, 'mailbox@perl.overmeer.net'); is("$addr", $mailbox); is($lg0->address->string, $mailbox); ok(!defined $lg0->type); ok(!defined $lg0->software); ok(!defined $lg0->version); ok(!defined $lg0->rfc); # # Extraction of a group # my $h = Mail::Message::Head::Complete->new; ok(defined $h); my $lg = Mail::Message::Head::ListGroup->from($h); ok(!defined $lg, "no listgroup in empty header"); # # Open folder with example messages # my $fn = dirname(__FILE__).'/203-mlfolder.mbox'; die "Cannot find file with mailinglist examples ($fn)" unless -f $fn; my $folder = Mail::Box::Mbox->new(folder => $fn, extract => 'ALWAYS'); ok(defined $folder, "open example folder"); die unless defined $folder; my @msgs = $folder->messages; my @expect = ( { } , { type => 'Mailman' , version => '2.0rc1' , address => 'templates@template-toolkit.org' , listname=> 'templates' , details => 'Mailman at templates@template-toolkit.org (2.0rc1), 11 fields' , rfc => 'rfc2369' } , { type => 'Ezmlm' , software=> undef , version => undef , address => 'perl5-porters@perl.org' , listname=> 'perl5-porters' , details => 'Ezmlm at perl5-porters@perl.org, 6 fields' , rfc => 'rfc2369' } , { type => 'Smartlist' , software=> undef , version => undef , address => 'debian-devel@lists.debian.org' , listname=> 'debian-devel' , details => 'Smartlist at debian-devel@lists.debian.org, 12 fields' , rfc => undef } , { type => 'Majordomo' , software=> undef , version => undef , address => 'london-pm@lists.dircon.co.uk' , listname=> 'london-pm' , details => 'Majordomo at london-pm@lists.dircon.co.uk, 2 fields' , rfc => undef } , { type => 'Sympa' , software=> undef , version => undef , address => 'noustestons@cru.fr' , listname=> 'noustestons' , details => 'Sympa at noustestons@cru.fr, 9 fields' , rfc => 'rfc2369' } , { type => 'Listar' , software=> 'Listar' , version => 'v0.129a' , address => 'adm@oasys.net' , listname=> 'adm' , details => 'Listar at adm@oasys.net (v0.129a), 8 fields' , rfc => undef } , { type => 'YahooGroups' , software=> undef , version => undef , address => 'ryokoforever@yahoogroups.com' , listname=> 'ryokoforever' , details => 'YahooGroups at ryokoforever@yahoogroups.com, 7 fields' , rfc => undef } , { type => 'Mailman' , software=> undef , version => '2.0.1' , address => 'London.pm Perl M[ou]ngers ' , listname=> 'London.pm Perl M[ou]ngers ' , details => 'Mailman at london.pm@london.pm.org (2.0.1), 6 fields' , rfc => 'rfc2919' } , { type => 'Ecartis' , software=> 'Ecartis' , version => 'v1.0.0' , address => 'adm@oasys.net' , listname=> 'adm' , details => 'Ecartis at adm@oasys.net (v1.0.0), 7 fields' , rfc => undef } , { type => 'CommuniGatePro' , software=> 'CommuniGate Pro' , version => '4.0.6' , address => 'Mail-ListDetector@gunzel.org' , listname=> 'Mail-ListDetector.gunzel.org' , details => 'CommuniGatePro at Mail-ListDetector@gunzel.org (CommuniGate Pro 4.0.6), 4 fields' , rfc => 'rfc2919' } , { type => 'FML' , software=> 'fml' , version => '4.0 STABLE (20010208)' , address => 'mlname@domain.example.com' , listname=> 'mlname' , details => 'FML at mlname@domain.example.com (fml 4.0 STABLE (20010208)), 10 fields' , rfc => 'rfc2369' } , { type => 'FML' , software=> 'fml' , version => '4.0 STABLE (20010218)' , address => 'Announce@mldetector.gr.jp' , listname=> 'Announce' , details => 'FML at Announce@mldetector.gr.jp (fml 4.0 STABLE (20010218)), 6 fields' , rfc => undef } , { type => 'Listbox' # based on sending address (old) , software=> undef , version => undef , address => 'sample@v2.listbox.com' , listname=> 'sample' , details => 'Listbox at sample@v2.listbox.com, 5 fields' , rfc => 'rfc2919' } , { type => 'Listbox' # based on List-Software , software=> 'listbox.com' , version => 'v2.0' , address => 'sample@v2.listbox.com' , listname=> 'sample' , details => 'Listbox at sample@v2.listbox.com (listbox.com v2.0), 6 fields' , rfc => 'rfc2919' } , { type => 'Listserv' , software=> 'LISTSERV-TCP/IP' , version => '1.8e' , address => '"EXAMPLE Discussion" ' , listname=> 'EXAMPLE Discussion' , details => 'Listserv at "EXAMPLE Discussion" (LISTSERV-TCP/IP 1.8e), 1 fields' , rfc => undef } , { type => 'Listserv' , software=> 'LISTSERV-TCP/IP' , version => '1.8d' , address => '"Comedy Company" ' , listname=> 'Comedy Company' , details => 'Listserv at "Comedy Company" (LISTSERV-TCP/IP 1.8d), 1 fields' , rfc => undef } , { type => 'CommuniGate' , software=> 'CommuniGate' , version => '1.4' , address => ' (CGnet)' , listname=> 'CGnet' , details => 'CommuniGate at CGnet@total.example.com (1.4), 1 fields' , rfc => undef } ); cmp_ok(scalar @msgs, '==', @expect, "all messages"); for(my $nr = 0; $nr < @msgs; $nr++) { my $msg = $msgs[$nr]; my %exp = %{$expect[$nr]}; my $lg = $msg->head->listGroup; if(! defined $lg) { ok(keys %exp == 0, "msg $nr is non-list message"); next; } isa_ok($lg, 'Mail::Message::Head::ListGroup', "msg $nr from $exp{type}"); is($lg->details, $exp{details}, "$nr details"); is($lg->type, $exp{type}, "$nr type"); is($lg->software, $exp{software}, "$nr software"); is($lg->version, $exp{version}, "$nr version"); is($lg->rfc, $exp{rfc}, "$nr rfc"); } Mail-Message-3.006/t/422msgconv-emsimp.t0000644000175000001440000000355213200571125020331 0ustar00markovusers00000000000000#!/usr/bin/env perl # Test conversions between Mail::Message and Email::Simple # # The tests are stolen from the MIME::Entity test-script, which # makes the content bogus. use strict; use warnings; use Mail::Message; use Mail::Message::Test; use Test::More; BEGIN { eval {require Email::Simple}; if($@) { plan skip_all => "requires Email::Simple."; exit 0; } require Mail::Message::Convert::EmailSimple; plan tests => 15; } my $email = Email::Simple->new(<<'END_MESSAGE'); From: mailtools@overmeer.net To: the users Subject: use Mail::Box In-Reply-To: <023984hjlur29420@sruoiu.nl> X-Again: repeating header X-Again: repeating header again X-Again: repeating header and again MIME::Entity is written by Eriq, and extends Mail::Internet with many new capabilities, like multipart bodies. Actually, although it says to extend, it more or less reimplements most methods and conflicts with the other. Even the Mail::Internet constructor does not work: only the build() can be used to safely construct a message. Do not use it anymore! END_MESSAGE isa_ok($email, 'Email::Simple'); my $convert = Mail::Message::Convert::EmailSimple->new; ok($convert); # # Convert Email::Simple to Mail::Message # my $msg = $convert->from($email); ok($msg); my $head = $msg->head; ok($head); my @from = $head->get('From'); cmp_ok(@from, "==", 1); my @again = $head->get('X-again'); is(@again, 3); my $body = $msg->body; ok($body); my @lines = $body->lines; cmp_ok(@lines, "==", 6); is($lines[-1], "use it anymore!\n"); # # Convert message back to an Email::Simple # my $back = $convert->export($msg); ok(defined $back); is($back->header('to'), "the users"); @from = $back->header('from'); cmp_ok(@from, "==", 1); @again = $back->header('x-again'); cmp_ok(@again, "==", 3); $body = $back->body; ok($body); @lines = split /\n/, $body; cmp_ok(@lines, "==", 6); Mail-Message-3.006/lib/0000755000175000001440000000000013232126172015251 5ustar00markovusers00000000000000Mail-Message-3.006/lib/Mail/0000755000175000001440000000000013232126172016133 5ustar00markovusers00000000000000Mail-Message-3.006/lib/Mail/Box/0000755000175000001440000000000013232126172016663 5ustar00markovusers00000000000000Mail-Message-3.006/lib/Mail/Box/FastScalar.pod0000644000175000001440000000166613232126166021426 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Mail::Box::FastScalar - fast alternative to IO::Scalar =head1 DESCRIPTION Contributed by "Todd Richmond" (richmond@proofpoint.com) This package should be released as separate package, but till then is incorporated in the Mail::Box module. Extremely fast L replacement - >20x improvement in getline(s)() =head2 Warnings You cannot modify the original reference between calls unless you C<$obj->seek(1, 0)> to reset the object - VERY rare usage case $/ must be undef or string - "" and \scalar unimplemented =head1 SEE ALSO This module is part of Mail-Message distribution version 3.006, built on January 24, 2018. Website: F =head1 LICENSE Copyrights 2001-2018 by [Mark Overmeer]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Mail-Message-3.006/lib/Mail/Box/Parser.pod0000644000175000001440000002536413232126166020640 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Mail::Box::Parser - reading and writing messages =head1 INHERITANCE Mail::Box::Parser is a Mail::Reporter Mail::Box::Parser is extended by Mail::Box::Parser::C Mail::Box::Parser::Perl =head1 SYNOPSIS # Not instatiatiated itself =head1 DESCRIPTION The C manages the parsing of folders. Usually, you won't need to know anything about this module, except the options which are involved with this code. There are two implementations of this module planned: =over 4 =item * L A slower parser which only uses plain Perl. This module is a bit slower, and does less checking and less recovery. =item * L A fast parser written in C. This package is released as separate module on CPAN, because the module distribution via CPAN can not handle XS files which are not located in the root directory of the module tree. If a C compiler is available on your system, it will be used automatically. =back Extends L<"DESCRIPTION" in Mail::Reporter|Mail::Reporter/"DESCRIPTION">. =head1 METHODS Extends L<"METHODS" in Mail::Reporter|Mail::Reporter/"METHODS">. =head2 Constructors Extends L<"Constructors" in Mail::Reporter|Mail::Reporter/"Constructors">. =over 4 =item Mail::Box::Parser-EB(%options) Create a parser object which can handle one file. For mbox-like mailboxes, this object can be used to read a whole folder. In case of MH-like mailboxes, each message is contained in a single file, so each message has its own parser object. -Option --Defined in --Default file undef filename log Mail::Reporter 'WARNINGS' mode 'r' trace Mail::Reporter 'WARNINGS' =over 2 =item file => FILE-HANDLE Any C or C which can be used to read the data from. In case this option is specified, the C is informational only. =item filename => FILENAME The name of the file to be read. =item log => LEVEL =item mode => OPENMODE File-open mode, which defaults to C<'r'>, which means `read-only'. See C for possible modes. Only applicable when no C is specified. =item trace => LEVEL =back =back =head2 The parser =over 4 =item $obj-EB() Returns whether the file which is parsed has changed after the last time takeFileInfo() was called. =item $obj-EB() Returns the name of the file this parser is working on. =item $obj-EB() Restart the parser on a certain file, usually because the content has changed. =item $obj-EB(%options) Start the parser by opening a file. -Option--Default file undef =over 2 =item file => FILEHANDLE|undef The file is already open, for instance because the data must be read from STDIN. =back =item $obj-EB() Stop the parser, which will include a close of the file. The lock on the folder will not be removed (is not the responsibility of the parser). =back =head2 Parsing =over 4 =item $obj-EB( $fh [$chars, [$lines]] ) Try to read one message-body from the file, and immediately write it to the specified file-handle. Optionally, the predicted number of CHARacterS and/or $lines to be read can be supplied. These values may be C and may be wrong. The return is a list of three scalars: the location of the body (begin and end) and the number of lines in the body. =item $obj-EB( [$chars, [$lines]] ) Try to read one message-body from the file. Optionally, the predicted number of CHARacterS and/or $lines to be read can be supplied. These values may be C and may be wrong. The return is a list of scalars, each containing one line (including line terminator), preceded by two integers representing the location in the file where this body started and ended. =item $obj-EB( [$chars, [$lines]] ) Try to read one message-body from the file. Optionally, the predicted number of CHARacterS and/or $lines to be read can be supplied. These values may be C and may be wrong. The return is a list of three scalars, the location in the file where the body starts, where the body ends, and the string containing the whole body. =item $obj-EB( [$chars, [$lines]] ) Try to read one message-body from the file, but the data is skipped. Optionally, the predicted number of CHARacterS and/or $lines to be skipped can be supplied. These values may be C and may be wrong. The return is a list of four scalars: the location of the body (begin and end), the size of the body, and the number of lines in the body. The number of lines may be C. =item $obj-EB( [$position] ) Returns the location of the next byte to be used in the file which is parsed. When a $position is specified, the location in the file is moved to the indicated spot first. =item $obj-EB() Returns the character or characters which are used to separate lines in the folder file. This is based on the first line of the file. UNIX systems use a single LF to separate lines. Windows uses a CR and a LF. Mac uses CR. =item $obj-EB() Remove the last-pushed separator from the list which is maintained by the parser. This will return C when there is none left. =item $obj-EB(STRING|Regexp) Add a boundary line. Separators tell the parser where to stop reading. A famous separator is the C-line, which is used in Mbox-like folders to separate messages. But also parts (I) is a message are divided by separators. The specified STRING describes the start of the separator-line. The Regexp can specify a more complicated format. =item $obj-EB() Read the whole message-header and return it as list of field-value pairs. Mind that some fields will appear more than once. The first element will represent the position in the file where the header starts. The follows the list of header field names and bodies. example: my ($where, @header) = $parser->readHeader; =item $obj-EB(%options) Read the currently active separator (the last one which was pushed). The line (or C) is returned. Blank-lines before the separator lines are ignored. The return are two scalars, where the first gives the location of the separator in the file, and the second the line which is found as separator. A new separator is activated using L. =back =head2 Internals =over 4 =item $obj-EB() Close the file which was being parsed. =item $obj-EB( [$class] ) =item Mail::Box::Parser-EB( [$class] ) Returns the parser to be used to parse all subsequent messages, possibly first setting the parser using the optional argument. Usually, the parser is autodetected; the C-based parser will be used when it can be, and the Perl-based parser will be used otherwise. The $class argument allows you to specify a package name to force a particular parser to be used (such as your own custom parser). You have to C or C the package yourself before calling this method with an argument. The parser must be a sub-class of C. =item $obj-EB($args) Open the file to be parsed. $args is a ref-hash of options. -Option --Default filename mode =over 2 =item filename => FILENAME =item mode => STRING =back =item $obj-EB() Capture some data about the file being parsed, to be compared later. =back =head2 Error handling Extends L<"Error handling" in Mail::Reporter|Mail::Reporter/"Error handling">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB($object) Inherited, see L =item $obj-EB( [$level]|[$loglevel, $tracelevel]|[$level, $callback] ) =item Mail::Box::Parser-EB( [$level]|[$loglevel, $tracelevel]|[$level, $callback] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$level, [$strings]] ) =item Mail::Box::Parser-EB( [$level, [$strings]] ) Inherited, see L =item $obj-EB($level) =item Mail::Box::Parser-EB($level) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Cleanup Extends L<"Cleanup" in Mail::Reporter|Mail::Reporter/"Cleanup">. =over 4 =item $obj-EB() Inherited, see L =back =head1 DIAGNOSTICS =over 4 =item Warning: File $filename changed during access. When a message parser starts working, it takes size and modification time of the file at hand. If the folder is written, it checks whether there were changes in the file made by external programs. Calling L on a folder before it being closed will read these new messages. But the real source of this problem is locking: some external program (for instance the mail transfer agent, like sendmail) uses a different locking mechanism as you do and therefore violates your rights. =item Error: Filename or handle required to create a parser. A message parser needs to know the source of the message at creation. These sources can be a filename (string), file handle object or GLOB. See new(filename) and new(file). =item Error: Package $package does not implement $method. Fatal error: the specific package (or one of its superclasses) does not implement this method where it should. This message means that some other related classes do implement this method however the class at hand does not. Probably you should investigate this and probably inform the author of the package. =back =head1 SEE ALSO This module is part of Mail-Message distribution version 3.006, built on January 24, 2018. Website: F =head1 LICENSE Copyrights 2001-2018 by [Mark Overmeer]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Mail-Message-3.006/lib/Mail/Box/Parser/0000755000175000001440000000000013232126172020117 5ustar00markovusers00000000000000Mail-Message-3.006/lib/Mail/Box/Parser/Perl.pm0000644000175000001440000001712713232126165021371 0ustar00markovusers00000000000000# Copyrights 2001-2018 by [Mark Overmeer]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.02. # This code is part of distribution Mail-Message. Meta-POD processed with # OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. package Mail::Box::Parser::Perl; use vars '$VERSION'; $VERSION = '3.006'; use base 'Mail::Box::Parser'; use strict; use warnings; use Mail::Message::Field; use List::Util 'sum'; use IO::File; sub init(@) { my ($self, $args) = @_; $self->SUPER::init($args) or return; $self->{MBPP_trusted} = $args->{trusted}; $self->{MBPP_fix} = $args->{fix_header_errors}; $self; } sub pushSeparator($) { my ($self, $sep) = @_; unshift @{$self->{MBPP_separators}}, $sep; $self->{MBPP_strip_gt}++ if $sep eq 'From '; $self; } sub popSeparator() { my $self = shift; my $sep = shift @{$self->{MBPP_separators}}; $self->{MBPP_strip_gt}-- if $sep eq 'From '; $sep; } sub filePosition(;$) { my $self = shift; @_ ? $self->{MBPP_file}->seek(shift, 0) : $self->{MBPP_file}->tell; } my $empty = qr/^\015?\012?$/; sub readHeader() { my $self = shift; my $file = $self->{MBPP_file}; my @ret = ($file->tell, undef); my $line = $file->getline; LINE: while(defined $line) { last LINE if $line =~ $empty; my ($name, $body) = split /\s*\:\s*/, $line, 2; unless(defined $body) { $self->log(WARNING => "Unexpected end of header in ".$self->filename.":\n $line"); if(@ret && $self->fixHeaderErrors) { $ret[-1][1] .= ' '.$line; # glue err line to previous field $line = $file->getline; next LINE; } else { $file->seek(-length $line, 1); last LINE; } } $body = "\n" unless length $body; # Collect folded lines while($line = $file->getline) { $line =~ m!^[ \t]! ? ($body .= $line) : last; } $body =~ s/\015//g; push @ret, [ $name, $body ]; } $ret[1] = $file->tell; @ret; } sub _is_good_end($) { my ($self, $where) = @_; # No seps, then when have to trust it. my $sep = $self->{MBPP_separators}[0]; return 1 unless defined $sep; my $file = $self->{MBPP_file}; my $here = $file->tell; $file->seek($where, 0) or return 0; # Find first non-empty line on specified location. my $line = $file->getline; $line = $file->getline while defined $line && $line =~ $empty; # Check completed, return to old spot. $file->seek($here, 0); return 1 unless defined $line; substr($line, 0, length $sep) eq $sep && ($sep ne 'From ' || $line =~ m/ (?:19[6-9]|20[0-2])[0-9]\b/ ); } sub readSeparator() { my $self = shift; my $sep = $self->{MBPP_separators}[0]; return () unless defined $sep; my $file = $self->{MBPP_file}; my $start = $file->tell; my $line = $file->getline; while(defined $line && $line =~ $empty) { $start = $file->tell; $line = $file->getline; } return () unless defined $line; $line =~ s/[\012\015\n]+$/\n/g; return ($start, $line) if substr($line, 0, length $sep) eq $sep; $file->seek($start, 0); (); } sub _read_stripped_lines(;$$) { my ($self, $exp_chars, $exp_lines) = @_; $exp_lines = -1 unless defined $exp_lines; my @seps = @{$self->{MBPP_separators}}; my $file = $self->{MBPP_file}; my $lines = []; my $msgend; if(@seps) { LINE: while(1) { my $where = $file->getpos; my $line = $file->getline or last LINE; foreach my $sep (@seps) { next if substr($line, 0, length $sep) ne $sep; next if $sep eq 'From ' && $line !~ m/ 19[789]\d| 20[012]\d/; $file->setpos($where); $msgend = $file->tell; last LINE; } push @$lines, $line; } if(@$lines && $lines->[-1] =~ s/(\r?\n)\z//) { $file->seek(-length($1), 1); pop @$lines if length($lines->[-1])==0; } } else # File without separators. { $lines = ref $file eq 'Mail::Box::FastScalar' ? $file->getlines : [ $file->getlines ]; } my $bodyend = $file->tell; if($lines) { if($self->{MBPP_strip_gt}) { s/^\>(\>*From\s)/$1/ for @$lines; } unless($self->{MBPP_trusted}) { s/\015$// for @$lines; # input is read as binary stream (i.e. preserving CRLF on Windows). # Code is based on this assumption. Removal of CR if not trusted # conflicts with this assumption. [Markus Spann] } } #warn "($bodyend, $msgend, ".@$lines, ")\n"; ($bodyend, $lines, $msgend); } sub _take_scalar($$) { my ($self, $begin, $end) = @_; my $file = $self->{MBPP_file}; $file->seek($begin, 0); my $return; $file->read($return, $end-$begin); $return =~ s/\015//g; $return; } sub bodyAsString(;$$) { my ($self, $exp_chars, $exp_lines) = @_; my $file = $self->{MBPP_file}; my $begin = $file->tell; if(defined $exp_chars && $exp_chars>=0) { # Get at once may be successful my $end = $begin + $exp_chars; if($self->_is_good_end($end)) { my $body = $self->_take_scalar($begin, $end); $body =~ s/^\>(\>*From\s)/$1/gm if $self->{MBPP_strip_gt}; return ($begin, $file->tell, $body); } } my ($end, $lines) = $self->_read_stripped_lines($exp_chars, $exp_lines); return ($begin, $end, join('', @$lines)); } sub bodyAsList(;$$) { my ($self, $exp_chars, $exp_lines) = @_; my $file = $self->{MBPP_file}; my $begin = $file->tell; my ($end, $lines) = $self->_read_stripped_lines($exp_chars, $exp_lines); ($begin, $end, $lines); } sub bodyAsFile($;$$) { my ($self, $out, $exp_chars, $exp_lines) = @_; my $file = $self->{MBPP_file}; my $begin = $file->tell; my ($end, $lines) = $self->_read_stripped_lines($exp_chars, $exp_lines); $out->print($_) foreach @$lines; ($begin, $end, scalar @$lines); } sub bodyDelayed(;$$) { my ($self, $exp_chars, $exp_lines) = @_; my $file = $self->{MBPP_file}; my $begin = $file->tell; if(defined $exp_chars) { my $end = $begin + $exp_chars; if($self->_is_good_end($end)) { $file->seek($end, 0); return ($begin, $end, $exp_chars, $exp_lines); } } my ($end, $lines) = $self->_read_stripped_lines($exp_chars, $exp_lines); my $chars = sum(map {length} @$lines); ($begin, $end, $chars, scalar @$lines); } sub openFile($) { my ($self, $args) = @_; my $mode = $args->{mode} or die "mode required"; my $fh = $args->{file} || IO::File->new($args->{filename}, $mode); return unless $fh; $self->{MBPP_file} = $fh; $fh->binmode(':raw') if $fh->can('binmode') || $fh->can('BINMODE'); $self->{MBPP_separators} = []; # binmode $fh, ':crlf' if $] < 5.007; # problem with perlIO $self; } sub closeFile() { my $self = shift; delete $self->{MBPP_separators}; delete $self->{MBPP_strip_gt}; my $file = delete $self->{MBPP_file} or return; $file->close; $self; } #------------------------------------------ sub fixHeaderErrors(;$) { my $self = shift; @_ ? ($self->{MBPP_fix} = shift) : $self->{MBPP_fix}; } #------------------------------------------ 1; Mail-Message-3.006/lib/Mail/Box/Parser/Perl.pod0000644000175000001440000001730113232126166021532 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Mail::Box::Parser::Perl - reading messages from file using Perl =head1 INHERITANCE Mail::Box::Parser::Perl is a Mail::Box::Parser is a Mail::Reporter =head1 SYNOPSIS =head1 DESCRIPTION The C implements parsing of messages in Perl. This may be a little slower than the C based parser L, but will also work on platforms where no C compiler is available. Extends L<"DESCRIPTION" in Mail::Box::Parser|Mail::Box::Parser/"DESCRIPTION">. =head1 METHODS Extends L<"METHODS" in Mail::Box::Parser|Mail::Box::Parser/"METHODS">. =head2 Constructors Extends L<"Constructors" in Mail::Box::Parser|Mail::Box::Parser/"Constructors">. =over 4 =item Mail::Box::Parser::Perl-EB(%options) -Option --Defined in --Default file Mail::Box::Parser undef filename Mail::Box::Parser fix_header_errors log Mail::Reporter 'WARNINGS' mode Mail::Box::Parser 'r' trace Mail::Reporter 'WARNINGS' trusted =over 2 =item file => FILE-HANDLE =item filename => FILENAME =item fix_header_errors => BOOLEAN When header errors are detected, the parsing of the header will be stopped. Other header lines will become part of the body of the message. Set this flag to have the erroneous line added to the previous header line. =item log => LEVEL =item mode => OPENMODE =item trace => LEVEL =item trusted => BOOLEAN Is the input from the file to be trusted, or does it require extra tests. Related to L. =back =back =head2 The parser Extends L<"The parser" in Mail::Box::Parser|Mail::Box::Parser/"The parser">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [BOOLEAN] ) If set to C, parsing of a header will not stop on an error, but attempt to add the erroneous this line to previous field. Without BOOLEAN, the current setting is returned. example: $folder->parser->fixHeaderErrors(1); my $folder = $mgr->open('folder', fix_header_errors => 1); =item $obj-EB() Inherited, see L =item $obj-EB(%options) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Parsing Extends L<"Parsing" in Mail::Box::Parser|Mail::Box::Parser/"Parsing">. =over 4 =item $obj-EB( $fh [$chars, [$lines]] ) Inherited, see L =item $obj-EB( [$chars, [$lines]] ) Inherited, see L =item $obj-EB( [$chars, [$lines]] ) Inherited, see L =item $obj-EB( [$chars, [$lines]] ) Inherited, see L =item $obj-EB( [$position] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB(STRING|Regexp) Inherited, see L =item $obj-EB() =item $obj-EB(%options) Inherited, see L =back =head2 Internals Extends L<"Internals" in Mail::Box::Parser|Mail::Box::Parser/"Internals">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB( [$class] ) =item Mail::Box::Parser::Perl-EB( [$class] ) Inherited, see L =item $obj-EB($args) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Error handling Extends L<"Error handling" in Mail::Box::Parser|Mail::Box::Parser/"Error handling">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB($object) Inherited, see L =item $obj-EB( [$level]|[$loglevel, $tracelevel]|[$level, $callback] ) =item Mail::Box::Parser::Perl-EB( [$level]|[$loglevel, $tracelevel]|[$level, $callback] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$level, [$strings]] ) =item Mail::Box::Parser::Perl-EB( [$level, [$strings]] ) Inherited, see L =item $obj-EB($level) =item Mail::Box::Parser::Perl-EB($level) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Cleanup Extends L<"Cleanup" in Mail::Box::Parser|Mail::Box::Parser/"Cleanup">. =over 4 =item $obj-EB() Inherited, see L =back =head1 DIAGNOSTICS =over 4 =item Warning: File $filename changed during access. When a message parser starts working, it takes size and modification time of the file at hand. If the folder is written, it checks whether there were changes in the file made by external programs. Calling L on a folder before it being closed will read these new messages. But the real source of this problem is locking: some external program (for instance the mail transfer agent, like sendmail) uses a different locking mechanism as you do and therefore violates your rights. =item Error: Package $package does not implement $method. Fatal error: the specific package (or one of its superclasses) does not implement this method where it should. This message means that some other related classes do implement this method however the class at hand does not. Probably you should investigate this and probably inform the author of the package. =item Warning: Unexpected end of header in $source: $line While parsing a message from the specified source (usually a file name), the parser found a syntax error. According to the MIME specification in the RFCs, each header line must either contain a colon, or start with a blank to indicate a folded field. Apparently, this header contains a line which starts on the first position, but not with a field name. By default, parsing of the header will be stopped. If there are more header lines after the erroneous line, they will be added to the body of the message. In case of new(fix_headers) set, the parsing of the header will be continued. The erroneous line will be added to the preceding field. =back =head1 SEE ALSO This module is part of Mail-Message distribution version 3.006, built on January 24, 2018. Website: F =head1 LICENSE Copyrights 2001-2018 by [Mark Overmeer]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Mail-Message-3.006/lib/Mail/Box/FastScalar.pm0000644000175000001440000001016013232126165021244 0ustar00markovusers00000000000000# Copyrights 2001-2018 by [Mark Overmeer]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.02. # This code is part of distribution Mail-Message. Meta-POD processed with # OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. package Mail::Box::FastScalar; use vars '$VERSION'; $VERSION = '3.006'; use strict; use warnings; use integer; sub new($) { my ($class, $ref) = @_; $$ref = '' unless defined $$ref; bless { ref => $ref, pos => 0 }, $class; } sub autoflush() {} sub binmode() {} sub clearerr { return 0; } sub flush() {} sub sync() { return 0; } sub opened() { return $_[0]->{ref}; } sub open($) { my $self = $_[0]; ${$_[1]} = '' unless defined(${$_[1]}); $self->{ref} = $_[1]; $self->{pos} = 0; } sub close() { undef $_[0]->{ref}; } sub eof() { my $self = $_[0]; return $self->{pos} >= length(${$self->{ref}}); } sub getc() { my $self = $_[0]; return substr(${$self->{ref}}, $self->{pos}++, 1); } sub print { my $self = shift; my $pos = $self->{pos}; my $ref = $self->{ref}; my $len = length($$ref); if ($pos >= $len) { $$ref .= $_ foreach @_; $self->{pos} = length($$ref); } else { my $buf = $#_ ? join('', @_) : $_[0]; $len = length($buf); substr($$ref, $pos, $len) = $buf; $self->{pos} = $pos + $len; } 1; } sub read($$;$) { my $self = $_[0]; my $buf = substr(${$self->{ref}}, $self->{pos}, $_[2]); $self->{pos} += $_[2]; ($_[3] ? substr($_[1], $_[3]) : $_[1]) = $buf; return length($buf); } sub sysread($$;$) { return shift()->read(@_); } sub seek($$) { my $self = $_[0]; my $whence = $_[2]; my $len = length(${$self->{ref}}); if ($whence == 0) { $self->{pos} = $_[1]; } elsif ($whence == 1) { $self->{pos} += $_[1]; } elsif ($whence == 2) { $self->{pos} = $len + $_[1]; } else { return; } if ($self->{pos} > $len) { $self->{pos} = $len; } elsif ($self->{pos} < 0) { $self->{pos} = 0; } return 1; } sub sysseek($$) { return $_[0]->seek($_[1], $_[2]); } sub setpos($) { return $_[0]->seek($_[1], 0); } sub sref() { return $_[0]->{ref}; } sub getpos() { return $_[0]->{pos}; } sub tell() { return $_[0]->{pos}; } sub write($$;$) { my $self = $_[0]; my $pos = $self->{pos}; my $ref = $self->{ref}; my $len = length($$ref); if ($pos >= $len) { $$ref .= substr($_[1], $_[3] || 0, $_[2]); $self->{pos} = length($$ref); $len = $self->{pos} - $len; } else { my $buf = substr($_[1], $_[3] || 0, $_[2]); $len = length($buf); substr($$ref, $pos, $len) = $buf; $self->{pos} = $pos + $len; } return $len; } sub syswrite($;$$) { return shift()->write(@_); } sub getline() { my $self = $_[0]; my $ref = $self->{ref}; my $pos = $self->{pos}; if (!defined($/) || (my $idx = index($$ref, $/, $pos)) == -1) { return if ($pos >= length($$ref)); $self->{pos} = length($$ref); return substr($$ref, $pos); } else { return substr($$ref, $pos, ($self->{pos} = $idx + length($/)) - $pos); } } sub getlines() { my $self = $_[0]; my @lines; my $ref = $self->{ref}; my $pos = $self->{pos}; if (defined($/)) { my $idx; while (($idx = index($$ref, $/, $pos)) != -1) { push(@lines, substr($$ref, $pos, ($idx + 1) - $pos)); $pos = $idx + 1; } } my $r = substr($$ref, $pos); if (length($r) > 0) { push(@lines, $r); } $self->{pos} = length($$ref); return wantarray() ? @lines : \@lines; } sub TIEHANDLE { ((defined($_[1]) && UNIVERSAL::isa($_[1], "Mail::Box::FastScalar")) ? $_[1] : shift->new(@_)); } sub GETC { shift()->getc(@_) } sub PRINT { shift()->print(@_) } sub PRINTF { shift()->print(sprintf(shift, @_)) } sub READ { shift()->read(@_) } sub READLINE { wantarray ? shift()->getlines(@_) : shift()->getline(@_) } sub WRITE { shift()->write(@_); } sub CLOSE { shift()->close(@_); } sub SEEK { shift()->seek(@_); } sub TELL { shift()->tell(@_); } sub EOF { shift()->eof(@_); } 1; 1; Mail-Message-3.006/lib/Mail/Box/Parser.pm0000644000175000001440000000740013232126165020460 0ustar00markovusers00000000000000# Copyrights 2001-2018 by [Mark Overmeer]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.02. # This code is part of distribution Mail-Message. Meta-POD processed with # OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. package Mail::Box::Parser; use vars '$VERSION'; $VERSION = '3.006'; use base 'Mail::Reporter'; use strict; use warnings; use Carp; sub new(@) { my $class = shift; $class eq __PACKAGE__ ? $class->defaultParserType->new(@_) # bootstrap right parser : $class->SUPER::new(@_); } sub init(@) { my ($self, $args) = @_; #warn "PARSER type=".ref $self,$self->VERSION; $self->SUPER::init($args); $self->{MBP_mode} = $args->{mode} || 'r'; unless($self->{MBP_filename} = $args->{filename} || ref $args->{file}) { $self->log(ERROR => "Filename or handle required to create a parser."); return; } $self->start(file => $args->{file}); } #------------------------------------------ sub start(@) { my $self = shift; my %args = (@_, filename => $self->filename, mode => $self->{MBP_mode}); $self->openFile(\%args) or return; $self->takeFileInfo; $self->log(PROGRESS => "Opened folder $args{filename} to be parsed"); $self; } #------------------------------------------ sub stop() { my $self = shift; my $filename = $self->filename; # $self->log(WARNING => "File $filename changed during access.") # if $self->fileChanged; $self->log(NOTICE => "Close parser for file $filename"); $self->closeFile; } sub restart() { my $self = shift; my $filename = $self->filename; $self->closeFile; $self->openFile( {filename => $filename, mode => $self->{MBP_mode}} ) or return; $self->takeFileInfo; $self->log(NOTICE => "Restarted parser for file $filename"); $self; } sub fileChanged() { my $self = shift; my ($size, $mtime) = (stat $self->filename)[7,9]; return 0 if !defined $size || !defined $mtime; $size != $self->{MBP_size} || $mtime != $self->{MBP_mtime}; } sub filename() {shift->{MBP_filename}} #------------------------------------------ sub filePosition(;$) {shift->NotImplemented} sub pushSeparator($) {shift->notImplemented} sub popSeparator($) {shift->notImplemented} sub readSeparator($) {shift->notImplemented} sub readHeader() {shift->notImplemented} sub bodyAsString() {shift->notImplemented} sub bodyAsList() {shift->notImplemented} sub bodyAsFile() {shift->notImplemented} sub bodyDelayed() {shift->notImplemented} sub lineSeparator() {shift->{MBP_linesep}} #------------------------------------------ sub openFile(@) {shift->notImplemented} sub closeFile(@) {shift->notImplemented} sub takeFileInfo() { my $self = shift; @$self{ qw/MBP_size MBP_mtime/ } = (stat $self->filename)[7,9]; } my $parser_type; sub defaultParserType(;$) { my $class = shift; # Select the parser manually? if(@_) { $parser_type = shift; return $parser_type if $parser_type->isa( __PACKAGE__ ); confess "Parser $parser_type does not extend " . __PACKAGE__ . "\n"; } # Already determined which parser we want? return $parser_type if $parser_type; # Try to use C-based parser. eval 'require Mail::Box::Parser::C'; #warn "C-PARSER errors $@\n" if $@; return $parser_type = 'Mail::Box::Parser::C' unless $@; # Fall-back on Perl-based parser. require Mail::Box::Parser::Perl; $parser_type = 'Mail::Box::Parser::Perl'; } #------------------------------------------ sub DESTROY { my $self = shift; $self->stop; $self->SUPER::DESTROY; } 1; Mail-Message-3.006/lib/Mail/Message/0000755000175000001440000000000013232126172017517 5ustar00markovusers00000000000000Mail-Message-3.006/lib/Mail/Message/Field/0000755000175000001440000000000013232126172020542 5ustar00markovusers00000000000000Mail-Message-3.006/lib/Mail/Message/Field/Unstructured.pod0000644000175000001440000003071213232126166023763 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Mail::Message::Field::Unstructured - smart unstructured field =head1 INHERITANCE Mail::Message::Field::Unstructured is a Mail::Message::Field::Full is a Mail::Message::Field is a Mail::Reporter =head1 SYNOPSIS my $f = Mail::Message::Field::Unstructured->new('Comments', 'hi!'); =head1 DESCRIPTION Unstructured fields do contain information which is not restricted in any way. RFC2822 defines some unstructured fields, but by default all unknown fields are unstructured as well. Things like attributes and comments have no meaning for unstructured fields, but encoding does. Extends L<"DESCRIPTION" in Mail::Message::Field::Full|Mail::Message::Field::Full/"DESCRIPTION">. =head1 OVERLOADED Extends L<"OVERLOADED" in Mail::Message::Field::Full|Mail::Message::Field::Full/"OVERLOADED">. =over 4 =item overload: B<""> Inherited, see L =item overload: B<0+> Inherited, see L =item overload: B<<=>> Inherited, see L =item overload: B Inherited, see L =item overload: B Inherited, see L =item overload: B Inherited, see L =back =head1 METHODS Extends L<"METHODS" in Mail::Message::Field::Full|Mail::Message::Field::Full/"METHODS">. =head2 Constructors Extends L<"Constructors" in Mail::Message::Field::Full|Mail::Message::Field::Full/"Constructors">. =over 4 =item $obj-EB() Inherited, see L =item Mail::Message::Field::Unstructured-EB($field, %options) Inherited, see L =item Mail::Message::Field::Unstructured-EB($data) When the $data is specified as single line, the content part is considered to be correcly (character) encoded and escaped. Typically, it is a line as read from file. The folding of the line is kept as is. In case more than one argument is provided, the second is considered the BODY. Attributes and other special things are not defined for unstructured fields, and therefore not valid options. The BODY can be a single string, a single OBJECT, or an array of OBJECTS. The objects are stringified (into a comma separated list). Each BODY element is interpreted with the specified encoding. When the BODY is empty, the construction of the object fails: C is returned. -Option --Defined in --Default charset Mail::Message::Field::Full undef encoding Mail::Message::Field::Full 'q' force Mail::Message::Field::Full false language Mail::Message::Field::Full undef log Mail::Reporter 'WARNINGS' trace Mail::Reporter 'WARNINGS' =over 2 =item charset => STRING =item encoding => 'q'|'Q'|'b'|'B' =item force => BOOLEAN =item language => STRING =item log => LEVEL =item trace => LEVEL =back example: my $s = Mail::Message::Field::Unstructured->new('Comment', 'Hi!'); # Use autodetect my $s = Mail::Message::Field::Full->new('Comment', 'Hi!'); my $s = Mail::Message::Field::Full->new('Comment: Hi!'); =back =head2 The field Extends L<"The field" in Mail::Message::Field::Full|Mail::Message::Field::Full/"The field">. =over 4 =item $obj-EB() =item Mail::Message::Field::Unstructured-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$fh] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$wrap] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Access to the name Extends L<"Access to the name" in Mail::Message::Field::Full|Mail::Message::Field::Full/"Access to the name">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [STRING] ) Inherited, see L =back =head2 Access to the body Extends L<"Access to the body" in Mail::Message::Field::Full|Mail::Message::Field::Full/"Access to the body">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB(%options) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$body] ) Inherited, see L =item $obj-EB( [STRING] ) =item Mail::Message::Field::Unstructured-EB( [STRING] ) Inherited, see L =item $obj-EB( [$body, [$wrap]] ) Inherited, see L =back =head2 Access to the content Extends L<"Access to the content" in Mail::Message::Field::Full|Mail::Message::Field::Full/"Access to the content">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB( $name, [$value] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [STRING] ) Inherited, see L =item $obj-EB(STRING, %options) =item Mail::Message::Field::Unstructured-EB(STRING, %options) Inherited, see L =item $obj-EB(STRING, %options) =item Mail::Message::Field::Unstructured-EB(STRING, %options) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$time] ) =item Mail::Message::Field::Unstructured-EB( [$time] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Other methods Extends L<"Other methods" in Mail::Message::Field::Full|Mail::Message::Field::Full/"Other methods">. =over 4 =item $obj-EB(STRING) =item Mail::Message::Field::Unstructured-EB(STRING) Inherited, see L =back =head2 Internals Extends L<"Internals" in Mail::Message::Field::Full|Mail::Message::Field::Full/"Internals">. =over 4 =item $obj-EB( $line | <$name,<$body|$objects>> ) Inherited, see L =item $obj-EB(STRING, %options) =item Mail::Message::Field::Unstructured-EB(STRING, %options) Inherited, see L =item $obj-EB( [$length] ) Inherited, see L =item $obj-EB(STRING, %options) Inherited, see L =item $obj-EB( $name, $body, [$maxchars] ) =item Mail::Message::Field::Unstructured-EB( $name, $body, [$maxchars] ) Inherited, see L =item $obj-EB( [$length] ) Inherited, see L =item $obj-EB(STRING|ARRAY|$objects) Inherited, see L =item $obj-EB(STRING) Inherited, see L =back =head2 Parsing Extends L<"Parsing" in Mail::Message::Field::Full|Mail::Message::Field::Full/"Parsing">. =over 4 =item $obj-EB(STRING) =item Mail::Message::Field::Unstructured-EB(STRING) Inherited, see L =item $obj-EB(STRING) Inherited, see L =item $obj-EB(STRING) =item Mail::Message::Field::Unstructured-EB(STRING) Inherited, see L =item $obj-EB(STRING) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Error handling Extends L<"Error handling" in Mail::Message::Field::Full|Mail::Message::Field::Full/"Error handling">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB($object) Inherited, see L =item $obj-EB( [$level]|[$loglevel, $tracelevel]|[$level, $callback] ) =item Mail::Message::Field::Unstructured-EB( [$level]|[$loglevel, $tracelevel]|[$level, $callback] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$level, [$strings]] ) =item Mail::Message::Field::Unstructured-EB( [$level, [$strings]] ) Inherited, see L =item $obj-EB($level) =item Mail::Message::Field::Unstructured-EB($level) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Cleanup Extends L<"Cleanup" in Mail::Message::Field::Full|Mail::Message::Field::Full/"Cleanup">. =over 4 =item $obj-EB() Inherited, see L =back =head1 DETAILS Extends L<"DETAILS" in Mail::Message::Field::Full|Mail::Message::Field::Full/"DETAILS">. =head1 DIAGNOSTICS =over 4 =item Warning: Field content is not numerical: $content The numeric value of a field is requested (for instance the C or C fields should be numerical), however the data contains weird characters. =item Warning: Illegal character in charset '$charset' The field is created with an utf8 string which only contains data from the specified character set. However, that character set can never be a valid name because it contains characters which are not permitted. =item Warning: Illegal character in field name $name A new field is being created which does contain characters not permitted by the RFCs. Using this field in messages may break other e-mail clients or transfer agents, and therefore mutulate or extinguish your message. =item Warning: Illegal character in language '$lang' The field is created with data which is specified to be in a certain language, however, the name of the language cannot be valid: it contains characters which are not permitted by the RFCs. =item Warning: Illegal encoding '$encoding', used 'q' The RFCs only permit base64 (C or C) or quoted-printable (C or C) encoding. Other than these four options are illegal. =item Error: Package $package does not implement $method. Fatal error: the specific package (or one of its superclasses) does not implement this method where it should. This message means that some other related classes do implement this method however the class at hand does not. Probably you should investigate this and probably inform the author of the package. =back =head1 SEE ALSO This module is part of Mail-Message distribution version 3.006, built on January 24, 2018. Website: F =head1 LICENSE Copyrights 2001-2018 by [Mark Overmeer]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Mail-Message-3.006/lib/Mail/Message/Field/Date.pm0000644000175000001440000000533113232126165021761 0ustar00markovusers00000000000000# Copyrights 2001-2018 by [Mark Overmeer]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.02. # This code is part of distribution Mail-Message. Meta-POD processed with # OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. package Mail::Message::Field::Date; use vars '$VERSION'; $VERSION = '3.006'; use base 'Mail::Message::Field::Structured'; use warnings; use strict; use POSIX qw/mktime tzset/; my $dayname = qr/Mon|Tue|Wed|Thu|Fri|Sat|Sun/; my @months = qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/; my %monthnr; { my $i; $monthnr{$_} = ++$i for @months } my %tz = qw/EDT -0400 EST -0500 CDT -0500 CST -0600 MDT -0600 MST -0700 PDT -0700 PST -0800 UT +0000 GMT +0000/; sub parse($) { my ($self, $string) = @_; my ($dn, $d, $mon, $y, $h, $min, $s, $z) = $string =~ m/ ^ \s* (?: ($dayname) \s* \, \s* )? ( 0?[1-9] | [12][0-9] | 3[01] ) \s* # day \s+ ( [A-Z][a-z][a-z]|[0-9][0-9] ) \s+ # month ( 19[0-9][0-9] | 2[0-9]{3} ) \s+ # year ( [0-1]?[0-9] | 2[0-3] ) \s* # hour [:.] ( [0-5][0-9] ) \s* # minute (?: [:.] ( [0-5][0-9] ) )? \s+ # second ( [+-][0-9]{4} | [A-Z]+ )? # zone \s* /x or return undef; defined $dn or $dn = ''; $dn =~ s/\s+//g; $mon = $months[$mon-1] if $mon =~ /[0-9]+/; # Broken mail clients $y += 2000 if $y < 50; $y += 1900 if $y < 100; $z ||= '-0000'; $z = $tz{$z} || '-0000' if $z =~ m/[A-Z]/; $self->{MMFD_date} = sprintf "%s%s%02d %s %04d %02d:%02d:%02d %s" , $dn, (length $dn ? ', ' : ''), $d, $mon, $y, $h, $min, $s, $z; $self; } sub produceBody() { shift->{MMFD_date} } sub date() { shift->{MMFD_date} } #------------------------------------------ sub addAttribute($;@) { my $self = shift; $self->log(ERROR => 'No attributes for date fields.'); $self; } sub time() { my $date = shift->{MMFD_date}; my ($d, $mon, $y, $h, $min, $s, $z) = $date =~ m/^ (?:\w\w\w\,\s+)? (\d\d)\s+(\w+)\s+(\d\d\d\d) \s+ (\d\d)\:(\d\d)\:(\d\d) \s+ ([+-]\d\d\d\d)? \s*$ /x; my $oldtz = $ENV{TZ}; $ENV{TZ} = 'UTC'; tzset; my $timestamp = mktime $s, $min, $h, $d, $monthnr{$mon}-1, $y-1900; if(defined $oldtz) { $ENV{TZ} = $oldtz } else { delete $ENV{TZ} } tzset; $timestamp += ($1 eq '-' ? 1 : -1) * ($2*3600 + $3*60) if $z =~ m/^([+-])(\d\d)(\d\d)$/; $timestamp; } #------------------------------------------ 1; Mail-Message-3.006/lib/Mail/Message/Field/Structured.pm0000644000175000001440000000700713232126165023252 0ustar00markovusers00000000000000# Copyrights 2001-2018 by [Mark Overmeer]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.02. # This code is part of distribution Mail-Message. Meta-POD processed with # OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. package Mail::Message::Field::Structured; use vars '$VERSION'; $VERSION = '3.006'; use base 'Mail::Message::Field::Full'; use strict; use warnings; use Mail::Message::Field::Attribute; use Storable 'dclone'; sub init($) { my ($self, $args) = @_; $self->{MMFS_attrs} = {}; $self->{MMFS_datum} = $args->{datum}; $self->SUPER::init($args); my $attr = $args->{attributes} || []; $attr = [ %$attr ] if ref $attr eq 'HASH'; while(@$attr) { my $name = shift @$attr; if(ref $name) { $self->attribute($name) } else { $self->attribute($name, shift @$attr) } } $self; } sub clone() { dclone(shift) } #------------------------------------------ sub attribute($;$) { my ($self, $attr) = (shift, shift); my $name; if(ref $attr) { $name = $attr->name } elsif( !@_ ) { return $self->{MMFS_attrs}{lc $attr} } else { $name = $attr; $attr = Mail::Message::Field::Attribute->new($name, @_); } delete $self->{MMFF_body}; $self->{MMFS_attrs}{$name} = $attr; } sub attributes() { values %{shift->{MMFS_attrs}} } sub beautify() { delete shift->{MMFF_body} } sub attrPairs() { map +($_->name, $_->value), shift->attributes } #------------------------- sub parse($) { my ($self, $string) = @_; # remove FWS, even within quoted strings $string =~ s/\r?\n\s?/ /gs; $string =~ s/ +$//; my $datum = ''; while(length $string && substr($string, 0, 1) ne ';') { (undef, $string) = $self->consumeComment($string); $datum .= $1 if $string =~ s/^([^;(]+)//; } $self->{MMFS_datum} = $datum; my $found = ''; while($string =~ m/\S/) { my $len = length $string; if($string =~ s/^\s*\;\s*// && length $found) { my ($name) = $found =~ m/^([^*]+)\*/; if($name && (my $cont = $self->attribute($name))) { $cont->addComponent($found); # continuation } else { my $attr = Mail::Message::Field::Attribute->new($found); $self->attribute($attr); } $found = ''; } (undef, $string) = $self->consumeComment($string); $string =~ s/^\n//; (my $text, $string) = $self->consumePhrase($string); $found .= $text if defined $text; if(length($string) == $len) { # nothing consumed, remove character to avoid endless loop $string =~ s/^\s*\S//; } } if(length $found) { my ($name) = $found =~ m/^([^*]+)\*/; if($name && (my $cont = $self->attribute($name))) { $cont->addComponent($found); # continuation } else { my $attr = Mail::Message::Field::Attribute->new($found); $self->attribute($attr); } } 1; } sub produceBody() { my $self = shift; my $attrs = $self->{MMFS_attrs}; my $datum = $self->{MMFS_datum}; join '; ' , (defined $datum ? $datum : '') , map {$_->string} @{$attrs}{sort keys %$attrs}; } sub datum(@) { my $self = shift; @_ or return $self->{MMFS_datum}; delete $self->{MMFF_body}; $self->{MMFS_datum} = shift; } 1; Mail-Message-3.006/lib/Mail/Message/Field/AuthResults.pod0000644000175000001440000003270013232126166023536 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Mail::Message::Field::AuthResults - message header field authentication result =head1 INHERITANCE Mail::Message::Field::AuthResults is a Mail::Message::Field::Structured is a Mail::Message::Field::Full is a Mail::Message::Field is a Mail::Reporter =head1 SYNOPSIS my $f = Mail::Message::Field->new('Authentication-Results' => '...'); my $g = Mail::Message::Field->new('Authentication-Results'); $g->addResult(method => 'dkim', result => 'fail'); =head1 DESCRIPTION Mail Transfer Agents may check the authenticity of an incoming message. They add 'Authentication-Results' headers, maybe more than one. This implementation is based on RFC7601. Extends L<"DESCRIPTION" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"DESCRIPTION">. =head1 OVERLOADED Extends L<"OVERLOADED" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"OVERLOADED">. =over 4 =item overload: B<""> Inherited, see L =item overload: B<0+> Inherited, see L =item overload: B<<=>> Inherited, see L =item overload: B Inherited, see L =item overload: B Inherited, see L =item overload: B Inherited, see L =back =head1 METHODS Extends L<"METHODS" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"METHODS">. =head2 Constructors Extends L<"Constructors" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Constructors">. =over 4 =item $obj-EB() Inherited, see L =item Mail::Message::Field::AuthResults-EB($field, %options) Inherited, see L =item Mail::Message::Field::AuthResults-EB($data) -Option --Defined in --Default attributes Mail::Message::Field::Structured charset Mail::Message::Field::Full undef datum Mail::Message::Field::Structured undef encoding Mail::Message::Field::Full 'q' force Mail::Message::Field::Full false language Mail::Message::Field::Full undef log Mail::Reporter 'WARNINGS' results [] server trace Mail::Reporter 'WARNINGS' version undef =over 2 =item attributes => ATTRS =item charset => STRING =item datum => STRING =item encoding => 'q'|'Q'|'b'|'B' =item force => BOOLEAN =item language => STRING =item log => LEVEL =item results => ARRAY Each authentication method is represented by a HASH, which contains the 'method' and 'result' keys. Sometimes, there is a 'comment'. Properties of form 'ptype.pname' will be there as well. =item server => DOMAIN Where the authentication tool ran. This should be your local service, otherwise you may accept spoofed headers! =item trace => LEVEL =item version => INTEGER =back =back =head2 The field Extends L<"The field" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"The field">. =over 4 =item $obj-EB() =item Mail::Message::Field::AuthResults-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$fh] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$wrap] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Access to the name Extends L<"Access to the name" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Access to the name">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [STRING] ) Inherited, see L =back =head2 Access to the body Extends L<"Access to the body" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Access to the body">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB(%options) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$body] ) Inherited, see L =item $obj-EB( [STRING] ) =item Mail::Message::Field::AuthResults-EB( [STRING] ) Inherited, see L =item $obj-EB( [$body, [$wrap]] ) Inherited, see L =back =head2 Access to the content Extends L<"Access to the content" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Access to the content">. =over 4 =item $obj-EB(...) Attributes are not supported here. =item $obj-EB(HASH|PAIRS) Add new results to this header. Invalid results are ignored. =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( $object||<$name,$value,%options> ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [STRING] ) Inherited, see L =item $obj-EB(STRING, %options) =item Mail::Message::Field::AuthResults-EB(STRING, %options) Inherited, see L =item $obj-EB(STRING, %options) =item Mail::Message::Field::AuthResults-EB(STRING, %options) Inherited, see L =item $obj-EB() Returns a LIST of result HASHes. Each HASH at least contains keys 'method', 'method_version', and 'result'. =item $obj-EB() The hostname which ran this authentication tool. =item $obj-EB() Inherited, see L =item $obj-EB( [$time] ) =item Mail::Message::Field::AuthResults-EB( [$time] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() The version of the 'Authentication-Results' header, which may be different from '1' (default) for successors of RFC7601. =back =head2 Other methods Extends L<"Other methods" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Other methods">. =over 4 =item $obj-EB(STRING) =item Mail::Message::Field::AuthResults-EB(STRING) Inherited, see L =back =head2 Internals Extends L<"Internals" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Internals">. =over 4 =item $obj-EB( $line | <$name,<$body|$objects>> ) Inherited, see L =item $obj-EB(STRING, %options) =item Mail::Message::Field::AuthResults-EB(STRING, %options) Inherited, see L =item $obj-EB( [$length] ) Inherited, see L =item $obj-EB(STRING, %options) Inherited, see L =item $obj-EB( $name, $body, [$maxchars] ) =item Mail::Message::Field::AuthResults-EB( $name, $body, [$maxchars] ) Inherited, see L =item $obj-EB( [$length] ) Inherited, see L =item $obj-EB(STRING|ARRAY|$objects) Inherited, see L =item $obj-EB(STRING) Inherited, see L =back =head2 Parsing Extends L<"Parsing" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Parsing">. =over 4 =item $obj-EB(STRING) =item Mail::Message::Field::AuthResults-EB(STRING) Inherited, see L =item $obj-EB(STRING) Inherited, see L =item $obj-EB(STRING) =item Mail::Message::Field::AuthResults-EB(STRING) Inherited, see L =item $obj-EB( [$value] ) Inherited, see L =item $obj-EB(STRING) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Error handling Extends L<"Error handling" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Error handling">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB($object) Inherited, see L =item $obj-EB( [$level]|[$loglevel, $tracelevel]|[$level, $callback] ) =item Mail::Message::Field::AuthResults-EB( [$level]|[$loglevel, $tracelevel]|[$level, $callback] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$level, [$strings]] ) =item Mail::Message::Field::AuthResults-EB( [$level, [$strings]] ) Inherited, see L =item $obj-EB($level) =item Mail::Message::Field::AuthResults-EB($level) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Cleanup Extends L<"Cleanup" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Cleanup">. =over 4 =item $obj-EB() Inherited, see L =back =head1 DETAILS Extends L<"DETAILS" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"DETAILS">. =head1 DIAGNOSTICS =over 4 =item Warning: Field content is not numerical: $content The numeric value of a field is requested (for instance the C or C fields should be numerical), however the data contains weird characters. =item Warning: Illegal character in charset '$charset' The field is created with an utf8 string which only contains data from the specified character set. However, that character set can never be a valid name because it contains characters which are not permitted. =item Warning: Illegal character in field name $name A new field is being created which does contain characters not permitted by the RFCs. Using this field in messages may break other e-mail clients or transfer agents, and therefore mutulate or extinguish your message. =item Warning: Illegal character in language '$lang' The field is created with data which is specified to be in a certain language, however, the name of the language cannot be valid: it contains characters which are not permitted by the RFCs. =item Warning: Illegal encoding '$encoding', used 'q' The RFCs only permit base64 (C or C) or quoted-printable (C or C) encoding. Other than these four options are illegal. =item Error: No attributes for Authentication-Results Is is not possible to add attributes to this field. =item Error: Package $package does not implement $method. Fatal error: the specific package (or one of its superclasses) does not implement this method where it should. This message means that some other related classes do implement this method however the class at hand does not. Probably you should investigate this and probably inform the author of the package. =back =head1 SEE ALSO This module is part of Mail-Message distribution version 3.006, built on January 24, 2018. Website: F =head1 LICENSE Copyrights 2001-2018 by [Mark Overmeer]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Mail-Message-3.006/lib/Mail/Message/Field/Flex.pm0000644000175000001440000000511513232126165022002 0ustar00markovusers00000000000000# Copyrights 2001-2018 by [Mark Overmeer]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.02. # This code is part of distribution Mail-Message. Meta-POD processed with # OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. package Mail::Message::Field::Flex; use vars '$VERSION'; $VERSION = '3.006'; use base 'Mail::Message::Field'; use strict; use warnings; use Carp; sub new($;$$@) { my $class = shift; my $args = @_ <= 2 || ! ref $_[-1] ? {} : ref $_[-1] eq 'ARRAY' ? { @{pop @_} } : pop @_; my ($name, $body) = $class->consume(@_==1 ? (shift) : (shift, shift)); return () unless defined $body; # Attributes preferably stored in array to protect order. my $attr = $args->{attributes}; $attr = [ %$attr ] if defined $attr && ref $attr eq 'HASH'; push @$attr, @_; $class->SUPER::new(%$args, name => $name, body => $body, attributes => $attr); } sub init($) { my ($self, $args) = @_; @$self{ qw/MMFF_name MMFF_body/ } = @$args{ qw/name body/ }; $self->comment($args->{comment}) if exists $args->{comment}; my $attr = $args->{attributes}; $self->attribute(shift @$attr, shift @$attr) while @$attr; $self; } #------------------------------------------ sub clone() { my $self = shift; (ref $self)->new($self->Name, $self->body); } #------------------------------------------ sub length() { my $self = shift; length($self->{MMFF_name}) + 1 + length($self->{MMFF_body}); } #------------------------------------------ sub name() { lc shift->{MMFF_name}} #------------------------------------------ sub Name() { shift->{MMFF_name}} #------------------------------------------ sub folded(;$) { my $self = shift; return $self->{MMFF_name}.':'.$self->{MMFF_body} unless wantarray; my @lines = $self->foldedBody; my $first = $self->{MMFF_name}. ':'. shift @lines; ($first, @lines); } #------------------------------------------ sub unfoldedBody($;@) { my $self = shift; $self->{MMFF_body} = $self->fold($self->{MMFF_name}, @_) if @_; $self->unfold($self->{MMFF_body}); } #------------------------------------------ sub foldedBody($) { my ($self, $body) = @_; if(@_==2) { $self->{MMFF_body} = $body } else { $body = $self->{MMFF_body} } wantarray ? (split /^/, $body) : $body; } #------------------------------------------ 1; Mail-Message-3.006/lib/Mail/Message/Field/Unstructured.pm0000644000175000001440000000175013232126165023614 0ustar00markovusers00000000000000# Copyrights 2001-2018 by [Mark Overmeer]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.02. # This code is part of distribution Mail-Message. Meta-POD processed with # OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. package Mail::Message::Field::Unstructured; use vars '$VERSION'; $VERSION = '3.006'; use base 'Mail::Message::Field::Full'; use strict; use warnings; sub init($) { my ($self, $args) = @_; if($args->{body} && ($args->{encoding} || $args->{charset})) { $args->{body} = $self->encode($args->{body}, %$args); } $self->SUPER::init($args) or return; $self->log(WARNING =>"Attributes are not supported for unstructured fields") if defined $args->{attributes}; $self->log(WARNING => "No extras for unstructured fields") if defined $args->{extra}; $self; } 1; Mail-Message-3.006/lib/Mail/Message/Field/Address.pod0000644000175000001440000001532013232126166022637 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Mail::Message::Field::Address - One e-mail address =head1 INHERITANCE Mail::Message::Field::Address is a Mail::Identity is an User::Identity::Item =head1 SYNOPSIS my $addr = Mail::Message::Field::Address->new(...); my $ui = User::Identity->new(...); my $addr = Mail::Message::Field::Address->coerce($ui); my $mi = Mail::Identity->new(...); my $addr = Mail::Message::Field::Address->coerce($mi); print $addr->address; print $addr->fullName; # possibly unicode! print $addr->domain; =head1 DESCRIPTION Many header fields can contain e-mail addresses. Each e-mail address can be represented by an object of this class. These objects will handle interpretation and character set encoding and decoding for you. Extends L<"DESCRIPTION" in Mail::Identity|Mail::Identity/"DESCRIPTION">. =head1 OVERLOADED =over 4 =item overload: B The object used as boolean will always return C =item overload: B Two address objects are the same when their email addresses are the same. =item overload: B When the object is used in string context, it will return the encoded representation of the e-mail address, just like L does. =back =head1 METHODS Extends L<"METHODS" in Mail::Identity|Mail::Identity/"METHODS">. =head2 Constructors Extends L<"Constructors" in Mail::Identity|Mail::Identity/"Constructors">. =over 4 =item $obj-EB( , %options ) Try to coerce the $object into a C. In case of a STRING, it is interpreted as an email address. The %options are passed to the object creation, and overrule the values found in the $object. The result may be C or a newly created object. If the $object is already of the correct type, it is returned unmodified. The $object may currently be a L, a L, or a L. In case of the latter, one of the user's addresses is chosen at random. =item Mail::Message::Field::Address-EB( [$name], %options ) Inherited, see L =item $obj-EB(STRING) Parse the string for an address. You never know whether one or more addresses are specified on a line (often applications are wrong), therefore, the STRING is first parsed for as many addresses as possible and then the one is taken at random. =back =head2 Attributes Extends L<"Attributes" in Mail::Identity|Mail::Identity/"Attributes">. =over 4 =item $obj-EB
    () Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [STRING] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$newname] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Collections Extends L<"Collections" in Mail::Identity|Mail::Identity/"Collections">. =over 4 =item $obj-EB($collection, $role) Inherited, see L =item $obj-EB( $object | <[$type], %options> ) Inherited, see L =item $obj-EB($name) Inherited, see L =item $obj-EB( [$parent] ) Inherited, see L =item $obj-EB($object|$name) Inherited, see L =item $obj-EB() =item Mail::Message::Field::Address-EB() Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Searching Extends L<"Searching" in Mail::Identity|Mail::Identity/"Searching">. =over 4 =item $obj-EB($collection, $role) Inherited, see L =back =head2 Accessors =over 4 =item $obj-EB() Character-set encoding, like 'q' and 'b', to be used when non-ascii characters are to be transmitted. =back =head2 Access to the content =over 4 =item $obj-EB() Returns an RFC compliant e-mail address, which will have character set encoding if needed. The objects are also overloaded to call this method in string context. example: print $address->string; print $address; # via overloading =back =head1 DIAGNOSTICS =over 4 =item Error: $object is not a collection. The first argument is an object, but not of a class which extends L. =item Error: Cannot coerce a $type into a Mail::Message::Field::Address When addresses are specified to be included in header fields, they may be coerced into L objects first. What you specify is not accepted as address specification. This may be an internal error. =item Error: Cannot load collection module for $type ($class). Either the specified $type does not exist, or that module named $class returns compilation errors. If the type as specified in the warning is not the name of a package, you specified a nickname which was not defined. Maybe you forgot the 'require' the package which defines the nickname. =item Error: Creation of a collection via $class failed. The $class did compile, but it was not possible to create an object of that class using the options you specified. =item Error: Don't know what type of collection you want to add. If you add a collection, it must either by a collection object or a list of options which can be used to create a collection object. In the latter case, the type of collection must be specified. =item Warning: No collection $name The collection with $name does not exist and can not be created. =back =head1 SEE ALSO This module is part of Mail-Message distribution version 3.006, built on January 24, 2018. Website: F =head1 LICENSE Copyrights 2001-2018 by [Mark Overmeer]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Mail-Message-3.006/lib/Mail/Message/Field/DKIM.pm0000644000175000001440000000400013232126165021620 0ustar00markovusers00000000000000# Copyrights 2001-2018 by [Mark Overmeer]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.02. # This code is part of distribution Mail-Message. Meta-POD processed with # OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. package Mail::Message::Field::DKIM; use vars '$VERSION'; $VERSION = '3.006'; use base 'Mail::Message::Field::Structured'; use warnings; use strict; use URI; sub init($) { my ($self, $args) = @_; $self->{MMFD_tags} = { v => 1, a => 'rsa-sha256' }; $self->SUPER::init($args); } sub parse($) { my ($self, $string) = @_; my $tags = $self->{MMFD_tags}; foreach (split /\;/, $string) { m/^\s*([a-z][a-z0-9_]*)\s*\=\s*([\s\x21-\x7E]+?)\s*$/is or next; # tag-values stay unparsed (for now) $self->addTag($1, $2); } (undef, $string) = $self->consumeComment($string); $self; } sub produceBody() { my $self = shift; } #------------------------------------------ sub addAttribute($;@) { my $self = shift; $self->log(ERROR => 'No attributes for DKIM headers.'); $self; } sub addTag($$) { my ($self, $name) = (shift, lc shift); $self->{MMFD_tags}{$name} = join ' ', @_; $self; } sub tag($) { $_[0]->{MMFD_tags}{lc $_[1]} } #------------------------------------------ sub tagAlgorithm() { shift->tag('a') } sub tagSignData() { shift->tag('b') } sub tagSignature() { shift->tag('bh') } sub tagC14N() { shift->tag('c') } sub tagDomain() { shift->tag('d') } sub tagSignedHeaders() { shift->tag('h') } sub tagAgentID() { shift->tag('i') } sub tagBodyLength(){ shift->tag('l') } sub tagQueryMethods() { shift->tag('q') } sub tagSelector() { shift->tag('s') } sub tagTimestamp() { shift->tag('t') } sub tagExpires() { shift->tag('x') } sub tagVersion() { shift->tag('v') } sub tagExtract() { shift->tag('z') } #------------------------------------------ 1; Mail-Message-3.006/lib/Mail/Message/Field/Fast.pod0000644000175000001440000002553013232126166022153 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Mail::Message::Field::Fast - one line of a message header =head1 INHERITANCE Mail::Message::Field::Fast is a Mail::Message::Field is a Mail::Reporter =head1 SYNOPSIS See Mail::Message::Field =head1 DESCRIPTION This is the faster, but less flexible implementation of a header field. The data is stored in an array, and some hacks are made to speeds things up. Be gentle with me, and consider that each message contains many of these lines, so speed is very important here. Extends L<"DESCRIPTION" in Mail::Message::Field|Mail::Message::Field/"DESCRIPTION">. =head1 OVERLOADED Extends L<"OVERLOADED" in Mail::Message::Field|Mail::Message::Field/"OVERLOADED">. =over 4 =item overload: B<""> Inherited, see L =item overload: B<0+> Inherited, see L =item overload: B<<=>> Inherited, see L =item overload: B Inherited, see L =item overload: B Inherited, see L =back =head1 METHODS Extends L<"METHODS" in Mail::Message::Field|Mail::Message::Field/"METHODS">. =head2 Constructors Extends L<"Constructors" in Mail::Message::Field|Mail::Message::Field/"Constructors">. =over 4 =item $obj-EB() Inherited, see L =item Mail::Message::Field::Fast-EB($data) The constructor of this object does not follow the usual practise within the Mail::Box suite: it does not use the constructor L. Therefor it has no logging or tracing facilities. The method can be used in one of the following ways: =over 4 =item * B LINE Pass a LINE as it could be found in a file: a (possibly folded) line which is terminated by a new-line. =item * B NAME, (BODY|OBJECTS), [ATTRIBUTES] A set of values which shape the line. =back Create a new header field object. Specify the whole LINE at once, and it will be split-up for you. I case you already have the parts of the header line, you may specify them separately as NAME and BODY. In case you specify a single OBJECT, or a reference to an array of OBJECTS, these objects are processed to become suitable to fill a field, usually by simple strification. When you specify one or more L objects, these are transformed into a string using their C method. You may also add one L, whose body is taken. In case of an array, the elements are joined into one string with a comma. ATTRIBUTES can be exactly one string which may contain multiple attributes at once, quoted and formatted as required in RFC2822. As alternative, list of key-value pairs can be used. In this case, the values will get quoted if needed and everything formatted as the protocol demands. -Option--Defined in --Default log Mail::Reporter trace Mail::Reporter =over 2 =item log => LEVEL =item trace => LEVEL =back example: my $mime = Mail::Message::Field->new( 'Content-Type: text/plain; charset=US-ASCII'); my $mime = Mail::Message::Field->new( 'Content-Type' => 'text/plain; charset=US-ASCII'); my $mime = Mail::Message::Field->new( 'Content-Type' => 'text/plain', 'charset=US-ASCII'); my $mime = Mail::Message::Field->new( 'Content-Type' => 'text/plain', charset => 'Latin1'); my $mime = Mail::Message::Field->new( To => Mail::Address->new('My', 'me@example.com'); my $mime = Mail::Message::Field->new( Cc => [ Mail::Address->new('You', 'you@example.com') , Mail::Address->new('His', 'he@example.com') ]); But in practice, you can simply call my $head = Mail::Message::Head->new; $head->add( 'Content-Type' => 'text/plain' , charset => 'utf8'); which implicitly calls this constructor (when needed). You can specify the same things for L as this C accepts. =back =head2 The field Extends L<"The field" in Mail::Message::Field|Mail::Message::Field/"The field">. =over 4 =item $obj-EB() =item Mail::Message::Field::Fast-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$fh] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$wrap] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Access to the name Extends L<"Access to the name" in Mail::Message::Field|Mail::Message::Field/"Access to the name">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [STRING] ) Inherited, see L =back =head2 Access to the body Extends L<"Access to the body" in Mail::Message::Field|Mail::Message::Field/"Access to the body">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$body] ) Inherited, see L =item $obj-EB( [STRING] ) =item Mail::Message::Field::Fast-EB( [STRING] ) Inherited, see L =item $obj-EB( [$body, [$wrap]] ) Inherited, see L =back =head2 Access to the content Extends L<"Access to the content" in Mail::Message::Field|Mail::Message::Field/"Access to the content">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB( $name, [$value] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [STRING] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$time] ) =item Mail::Message::Field::Fast-EB( [$time] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Other methods Extends L<"Other methods" in Mail::Message::Field|Mail::Message::Field/"Other methods">. =over 4 =item $obj-EB(STRING) =item Mail::Message::Field::Fast-EB(STRING) Inherited, see L =back =head2 Internals Extends L<"Internals" in Mail::Message::Field|Mail::Message::Field/"Internals">. =over 4 =item $obj-EB( $line | <$name,<$body|$objects>> ) Inherited, see L =item $obj-EB( [$length] ) Inherited, see L =item $obj-EB( $name, $body, [$maxchars] ) =item Mail::Message::Field::Fast-EB( $name, $body, [$maxchars] ) Inherited, see L =item $obj-EB( [$length] ) Inherited, see L =item $obj-EB(STRING|ARRAY|$objects) Inherited, see L =item $obj-EB(STRING) Inherited, see L =back =head2 Error handling Extends L<"Error handling" in Mail::Message::Field|Mail::Message::Field/"Error handling">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB($object) Inherited, see L =item $obj-EB( [$level]|[$loglevel, $tracelevel]|[$level, $callback] ) =item Mail::Message::Field::Fast-EB( [$level]|[$loglevel, $tracelevel]|[$level, $callback] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$level, [$strings]] ) =item Mail::Message::Field::Fast-EB( [$level, [$strings]] ) Inherited, see L =item $obj-EB($level) =item Mail::Message::Field::Fast-EB($level) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Cleanup Extends L<"Cleanup" in Mail::Message::Field|Mail::Message::Field/"Cleanup">. =over 4 =item $obj-EB() Inherited, see L =back =head1 DETAILS Extends L<"DETAILS" in Mail::Message::Field|Mail::Message::Field/"DETAILS">. =head1 DIAGNOSTICS =over 4 =item Warning: Field content is not numerical: $content The numeric value of a field is requested (for instance the C or C fields should be numerical), however the data contains weird characters. =item Warning: Illegal character in field name $name A new field is being created which does contain characters not permitted by the RFCs. Using this field in messages may break other e-mail clients or transfer agents, and therefore mutulate or extinguish your message. =item Error: Package $package does not implement $method. Fatal error: the specific package (or one of its superclasses) does not implement this method where it should. This message means that some other related classes do implement this method however the class at hand does not. Probably you should investigate this and probably inform the author of the package. =back =head1 SEE ALSO This module is part of Mail-Message distribution version 3.006, built on January 24, 2018. Website: F =head1 LICENSE Copyrights 2001-2018 by [Mark Overmeer]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Mail-Message-3.006/lib/Mail/Message/Field/Address.pm0000644000175000001440000000407013232126165022470 0ustar00markovusers00000000000000# Copyrights 2001-2018 by [Mark Overmeer]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.02. # This code is part of distribution Mail-Message. Meta-POD processed with # OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. package Mail::Message::Field::Address; use vars '$VERSION'; $VERSION = '3.006'; use base 'Mail::Identity'; use strict; use warnings; use Mail::Message::Field::Addresses; use Mail::Message::Field::Full; my $format = 'Mail::Message::Field::Full'; use overload '""' => 'string' , bool => sub {1} , cmp => sub { lc($_[0]->address) eq lc($_[1]) } ; #------------------------------------------ sub coerce($@) { my ($class, $addr, %args) = @_; return () unless defined $addr; ref $addr or return $class->parse($addr); $addr->isa($class) and return $addr; my $from = $class->from($addr, %args); Mail::Reporter->log(ERROR => "Cannot coerce a ".ref($addr)." into a $class"), return () unless defined $from; bless $from, $class; } sub init($) { my ($self, $args) = @_; $self->SUPER::init($args); $self->{MMFA_encoding} = delete $args->{encoding}; $self; } sub parse($) { my $self = shift; my $parsed = Mail::Message::Field::Addresses->new('To' => shift); defined $parsed ? ($parsed->addresses)[0] : (); } #------------------------------------------ sub encoding() {shift->{MMFA_encoding}} #------------------------------------------ sub string() { my $self = shift; my @opts = (charset => $self->charset, encoding => $self->encoding); # language => $self->language my @parts; my $name = $self->phrase; push @parts, $format->createPhrase($name, @opts) if defined $name; my $address = $self->address; push @parts, @parts ? '<'.$address.'>' : $address; my $comment = $self->comment; push @parts, $format->createComment($comment, @opts) if defined $comment; join ' ', @parts; } 1; Mail-Message-3.006/lib/Mail/Message/Field/Attribute.pm0000644000175000001440000001233113232126165023045 0ustar00markovusers00000000000000# Copyrights 2001-2018 by [Mark Overmeer]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.02. # This code is part of distribution Mail-Message. Meta-POD processed with # OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. package Mail::Message::Field::Attribute; use vars '$VERSION'; $VERSION = '3.006'; use base 'Mail::Reporter'; use strict; use warnings; use Encode (); use Carp; use Carp 'cluck'; use overload '""' => sub {shift->value} , cmp => sub { my ($self, $other) = @_; UNIVERSAL::isa($other, 'Mail::Message::Field') ? (lc($_[0])->name cmp lc($_[1]->name) || $_[0]->value cmp $_[1]->value) : $_[0]->value cmp $_[1] } , fallback => 1; sub new($$@) { my ($class, $attr) = (shift, shift); my $value = @_ % 2 == 1 ? shift : undef; $class->SUPER::new(attr => $attr, value => $value, @_); } sub init($$) { my ($self, $args) = @_; $self->SUPER::init($args); my ($attr, $value, $cont) = @$args{ qw/attr value use_continuations/ }; my $name = ($attr =~ m/^(.*?)(?:\*\d+)?\*?\s*\=\s*/ ? $1 : $attr); $self->log(WARNING => "Illegal character in parameter name '$name'.") if $name !~ m/^[!#-'*+\-.0-9A-Z^-~]+$/; $self->{MMFF_name} = $name; $self->{MMFF_usecont} = defined $cont ? $cont : 1; $self->{MMFF_charset} = $args->{charset} if defined $args->{charset}; $self->{MMFF_language} = $args->{language} if defined $args->{language}; $self->value(defined $value ? $value : ''); $self->addComponent($attr) unless $attr eq $name; $self; } #------------------------------------------ sub name() { shift->{MMFF_name} } sub value(;$) { my $self = shift; if(@_) { delete $self->{MMFF_cont}; return $self->{MMFF_value} = shift; } exists $self->{MMFF_value} ? $self->{MMFF_value} : $self->decode; } sub addComponent($) { my ($self, $component) = @_; delete $self->{MMFF_value}; my ($name, $value) = split /\=/, $component, 2; if( substr($name, -1) eq '*' && $value =~ m/^([^']*)\'([^']*)\'/ ) { $self->{MMFF_charset} = length $1 ? $1 : undef; $self->{MMFF_language} = length $2 ? $2 : undef; } if( $name =~ m/\*([0-9]+)\*?$/ ) { $self->{MMFF_cont}[$1] = $component } else { $self->{MMFF_cont} = [ $component ] } $component; } sub charset() { shift->{MMFF_charset} } sub language() { shift->{MMFF_language} } sub string() { my $self = shift; my $cont = $self->{MMFF_cont} || $self->encode; return @$cont if wantarray; return [] unless @$cont; local $" = "; "; "; @$cont"; } #------------------------------------------ sub encode() { my $self = shift; my $value = $self->{MMFF_value}; my @lines; my ($pre, $encoded); my $charset = $self->{MMFF_charset} || ''; my $lang = $self->{MMFF_language} || ''; my $name = $self->{MMFF_name}; my $cont = $self->{MMFF_usecont}; if($charset || $lang) { $pre = "$name*0*=$charset'$lang'"; $value = Encode::encode($charset, $value, 0); $encoded = 1; } elsif(grep m/[^\x20-\x7E]/, $value) { $pre = "$name*0*=''"; $encoded = 1; } else { $pre = "$name*0="; $value =~ s/"/\\"/g; $encoded = 0; } if($encoded) { # Use encoding my @c = split //, $value; while(@c) { my $c = shift @c; $c = '%'. sprintf "%02X", ord $c unless $c =~ m/[a-zA-Z0-9]/; if($cont && length($pre) + length($c)> 76) { push @lines, $pre; $pre = $name . '*' . @lines . '*=' . $c; } else { $pre .= $c } } push @lines, $pre; } elsif($cont) { # Simple string, but with continuations while(1) { push @lines, $pre.'"'. substr($value, 0, 75-length($pre), '') .'"'; last unless length $value; $pre = $name . '*' . @lines . '='; } } else { # Single string only push @lines, $pre . $value; } $lines[0] =~ s/\*0// if @lines==1; $self->{MMFF_cont} = \@lines; } sub decode() { my $self = shift; my $value = ''; foreach my $cont ( @{$self->{MMFF_cont}} ) { unless(defined $cont) { $value .= "[continuation missing]"; next; } (my $name, local $_) = split /\=/, $cont, 2; if(substr($name, -1) eq '*') { s/^[^']*\'[^']*\'//; s/\%([a-fA-F0-9]{2})/chr hex $1/ge; } elsif( s/^\"(.*)\"$/$1/ ) { s/\\\"/"/g } elsif( s/^\'(.*)\'$/$1/ ) { s/\\\'/'/g } $value .= $_; } my $charset = $self->{MMFF_charset}; $value = Encode::decode($charset, $value, 0) if $charset; $self->{MMFF_value} = $value; } #------------------------------------------ sub mergeComponent($) { my ($self, $comp) = @_; my $cont = $self->{MMFF_cont} or croak "ERROR: Too late to merge: value already changed."; defined $_ && $self->addComponent($_) foreach @{$comp->{MMFF_cont}}; $self; } 1; Mail-Message-3.006/lib/Mail/Message/Field/Flex.pod0000644000175000001440000002313213232126166022150 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Mail::Message::Field::Flex - one line of a message header =head1 INHERITANCE Mail::Message::Field::Flex is a Mail::Message::Field is a Mail::Reporter =head1 SYNOPSIS =head1 DESCRIPTION This is the flexible implementation of a field: it can easily be extended because it stores its data in a hash and the constructor (C) and initializer (C) are split. However, you pay the price in performance. L is faster (as the name predicts). Extends L<"DESCRIPTION" in Mail::Message::Field|Mail::Message::Field/"DESCRIPTION">. =head1 OVERLOADED Extends L<"OVERLOADED" in Mail::Message::Field|Mail::Message::Field/"OVERLOADED">. =over 4 =item overload: B<""> Inherited, see L =item overload: B<0+> Inherited, see L =item overload: B<<=>> Inherited, see L =item overload: B Inherited, see L =item overload: B Inherited, see L =back =head1 METHODS Extends L<"METHODS" in Mail::Message::Field|Mail::Message::Field/"METHODS">. =head2 Constructors Extends L<"Constructors" in Mail::Message::Field|Mail::Message::Field/"Constructors">. =over 4 =item $obj-EB() Inherited, see L =item Mail::Message::Field::Flex-EB($data) If you stick to this flexible class of header fields, you have a bit more facilities than with L. Amongst it, you can specify options with the creation. Possible arguments: =over 4 =item * B LINE ass a LINE as it could be found in a file: a (possibly folded) line which is terminated by a new-line. =item * B NAME, (BODY|OBJECTS), [ATTRIBUTES], OPTIONS A set of values which shape the line. =back To be able to distinguish the different parameters, you will have to specify the OPTIONS as ARRAY of option pairs, or HASH of options. The ATTRIBUTES are a flat list of key-value pairs. The body is specified as one BODY string, one OBJECT, or a reference to an array of OBJECTS. See L: -Option --Defined in --Default attributes [] comment undef log Mail::Reporter 'WARNINGS' trace Mail::Reporter 'WARNINGS' =over 2 =item attributes => ATTRS Reference to array with list of key-value pairs representing attributes, or reference to a hash containing these pairs. This is an alternative notation for specifying ATTRIBUTES directly as method arguments. =item comment => STRING A pre-formatted list of attributes. =item log => LEVEL =item trace => LEVEL =back =back =head2 The field Extends L<"The field" in Mail::Message::Field|Mail::Message::Field/"The field">. =over 4 =item $obj-EB() =item Mail::Message::Field::Flex-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$fh] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$wrap] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Access to the name Extends L<"Access to the name" in Mail::Message::Field|Mail::Message::Field/"Access to the name">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [STRING] ) Inherited, see L =back =head2 Access to the body Extends L<"Access to the body" in Mail::Message::Field|Mail::Message::Field/"Access to the body">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$body] ) Inherited, see L =item $obj-EB( [STRING] ) =item Mail::Message::Field::Flex-EB( [STRING] ) Inherited, see L =item $obj-EB( [$body, [$wrap]] ) Inherited, see L =back =head2 Access to the content Extends L<"Access to the content" in Mail::Message::Field|Mail::Message::Field/"Access to the content">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB( $name, [$value] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [STRING] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$time] ) =item Mail::Message::Field::Flex-EB( [$time] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Other methods Extends L<"Other methods" in Mail::Message::Field|Mail::Message::Field/"Other methods">. =over 4 =item $obj-EB(STRING) =item Mail::Message::Field::Flex-EB(STRING) Inherited, see L =back =head2 Internals Extends L<"Internals" in Mail::Message::Field|Mail::Message::Field/"Internals">. =over 4 =item $obj-EB( $line | <$name,<$body|$objects>> ) Inherited, see L =item $obj-EB( [$length] ) Inherited, see L =item $obj-EB( $name, $body, [$maxchars] ) =item Mail::Message::Field::Flex-EB( $name, $body, [$maxchars] ) Inherited, see L =item $obj-EB( [$length] ) Inherited, see L =item $obj-EB(STRING|ARRAY|$objects) Inherited, see L =item $obj-EB(STRING) Inherited, see L =back =head2 Error handling Extends L<"Error handling" in Mail::Message::Field|Mail::Message::Field/"Error handling">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB($object) Inherited, see L =item $obj-EB( [$level]|[$loglevel, $tracelevel]|[$level, $callback] ) =item Mail::Message::Field::Flex-EB( [$level]|[$loglevel, $tracelevel]|[$level, $callback] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$level, [$strings]] ) =item Mail::Message::Field::Flex-EB( [$level, [$strings]] ) Inherited, see L =item $obj-EB($level) =item Mail::Message::Field::Flex-EB($level) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Cleanup Extends L<"Cleanup" in Mail::Message::Field|Mail::Message::Field/"Cleanup">. =over 4 =item $obj-EB() Inherited, see L =back =head1 DETAILS Extends L<"DETAILS" in Mail::Message::Field|Mail::Message::Field/"DETAILS">. =head1 DIAGNOSTICS =over 4 =item Warning: Field content is not numerical: $content The numeric value of a field is requested (for instance the C or C fields should be numerical), however the data contains weird characters. =item Warning: Illegal character in field name $name A new field is being created which does contain characters not permitted by the RFCs. Using this field in messages may break other e-mail clients or transfer agents, and therefore mutulate or extinguish your message. =item Error: Package $package does not implement $method. Fatal error: the specific package (or one of its superclasses) does not implement this method where it should. This message means that some other related classes do implement this method however the class at hand does not. Probably you should investigate this and probably inform the author of the package. =back =head1 SEE ALSO This module is part of Mail-Message distribution version 3.006, built on January 24, 2018. Website: F =head1 LICENSE Copyrights 2001-2018 by [Mark Overmeer]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Mail-Message-3.006/lib/Mail/Message/Field/DKIM.pod0000644000175000001440000003441513232126166022004 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Mail::Message::Field::DKIM - message header field for dkim signatures =head1 INHERITANCE Mail::Message::Field::DKIM is a Mail::Message::Field::Structured is a Mail::Message::Field::Full is a Mail::Message::Field is a Mail::Reporter =head1 SYNOPSIS my $f = Mail::Message::Field->new('DKIM-Signature' => '...'); my $g = Mail::Message::Field->new('DKIM-Signature'); $g->add... =head1 DESCRIPTION Decode the information contained in a DKIM header. You can also construct DKIM-Signature headers this way. However, verification and signing is not yet implemented. This implementation is based on RFC6376. Extends L<"DESCRIPTION" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"DESCRIPTION">. =head1 OVERLOADED Extends L<"OVERLOADED" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"OVERLOADED">. =over 4 =item overload: B<""> Inherited, see L =item overload: B<0+> Inherited, see L =item overload: B<<=>> Inherited, see L =item overload: B Inherited, see L =item overload: B Inherited, see L =item overload: B Inherited, see L =back =head1 METHODS Extends L<"METHODS" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"METHODS">. =head2 Constructors Extends L<"Constructors" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Constructors">. =over 4 =item $obj-EB() Inherited, see L =item Mail::Message::Field::DKIM-EB($field, %options) Inherited, see L =item Mail::Message::Field::DKIM-EB($data) -Option --Defined in --Default attributes Mail::Message::Field::Structured charset Mail::Message::Field::Full undef datum Mail::Message::Field::Structured undef encoding Mail::Message::Field::Full 'q' force Mail::Message::Field::Full false language Mail::Message::Field::Full undef log Mail::Reporter 'WARNINGS' trace Mail::Reporter 'WARNINGS' =over 2 =item attributes => ATTRS =item charset => STRING =item datum => STRING =item encoding => 'q'|'Q'|'b'|'B' =item force => BOOLEAN =item language => STRING =item log => LEVEL =item trace => LEVEL =back =back =head2 The field Extends L<"The field" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"The field">. =over 4 =item $obj-EB() =item Mail::Message::Field::DKIM-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$fh] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$wrap] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Access to the name Extends L<"Access to the name" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Access to the name">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [STRING] ) Inherited, see L =back =head2 Access to the body Extends L<"Access to the body" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Access to the body">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB(%options) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$body] ) Inherited, see L =item $obj-EB( [STRING] ) =item Mail::Message::Field::DKIM-EB( [STRING] ) Inherited, see L =item $obj-EB( [$body, [$wrap]] ) Inherited, see L =back =head2 Access to the content Extends L<"Access to the content" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Access to the content">. =over 4 =item $obj-EB(...) Attributes are not supported here. =item $obj-EB($name, $value|@values) Add a tag to the set. When the tag already exists, it is replaced. Names are (converted to) lower-case. When multiple values are given, they will be concatenated with a blank (and may get folded there later) =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( $object||<$name,$value,%options> ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [STRING] ) Inherited, see L =item $obj-EB(STRING, %options) =item Mail::Message::Field::DKIM-EB(STRING, %options) Inherited, see L =item $obj-EB(STRING, %options) =item Mail::Message::Field::DKIM-EB(STRING, %options) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB($name) Returns the value for the named tag. =item $obj-EB( [$time] ) =item Mail::Message::Field::DKIM-EB( [$time] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head3 DKIM-Signature tags The tag methods return the tag-value content without any validation or modification. For many situations, the actual content does not need (expensive) validation and interpretation. =over 4 =item $obj-EB() The Agent or User Identifier (AUID). Defaults to C<@$domain> =item $obj-EB() Signature algorithm. Should be rsa-sha(1|256): check before use. Required. =item $obj-EB() The number of octets which where used to calculate the hash. By default, the whole body was used. =item $obj-EB() The canonicalization method used. Defaults to 'simple/simple'. =item $obj-EB() The sub-domain (SDID) which claims responsibility for this signature. Required. =item $obj-EB() The timestamp when the signature will expire. Recommended. =item $obj-EB() Some headers from the original message packed together. =item $obj-EB() A colon-separated list of method which can be used to retrieve the public key. The default is "dns/txt" (currently the only valid option) =item $obj-EB() The selector subdividing the $domain tag. Required. =item $obj-EB() =item $obj-EB() Message signature in base64, with whitespaces removed. Required. =item $obj-EB() The colon separated list of headers which need to be included in the signature. Required. =item $obj-EB() When the signature was created in UNIX-like seconds (since 1970). Recommended. =item $obj-EB() Signature header syntax version (usually 1) =back =head2 Other methods Extends L<"Other methods" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Other methods">. =over 4 =item $obj-EB(STRING) =item Mail::Message::Field::DKIM-EB(STRING) Inherited, see L =back =head2 Internals Extends L<"Internals" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Internals">. =over 4 =item $obj-EB( $line | <$name,<$body|$objects>> ) Inherited, see L =item $obj-EB(STRING, %options) =item Mail::Message::Field::DKIM-EB(STRING, %options) Inherited, see L =item $obj-EB( [$length] ) Inherited, see L =item $obj-EB(STRING, %options) Inherited, see L =item $obj-EB( $name, $body, [$maxchars] ) =item Mail::Message::Field::DKIM-EB( $name, $body, [$maxchars] ) Inherited, see L =item $obj-EB( [$length] ) Inherited, see L =item $obj-EB(STRING|ARRAY|$objects) Inherited, see L =item $obj-EB(STRING) Inherited, see L =back =head2 Parsing Extends L<"Parsing" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Parsing">. =over 4 =item $obj-EB(STRING) =item Mail::Message::Field::DKIM-EB(STRING) Inherited, see L =item $obj-EB(STRING) Inherited, see L =item $obj-EB(STRING) =item Mail::Message::Field::DKIM-EB(STRING) Inherited, see L =item $obj-EB( [$value] ) Inherited, see L =item $obj-EB(STRING) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Error handling Extends L<"Error handling" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Error handling">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB($object) Inherited, see L =item $obj-EB( [$level]|[$loglevel, $tracelevel]|[$level, $callback] ) =item Mail::Message::Field::DKIM-EB( [$level]|[$loglevel, $tracelevel]|[$level, $callback] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$level, [$strings]] ) =item Mail::Message::Field::DKIM-EB( [$level, [$strings]] ) Inherited, see L =item $obj-EB($level) =item Mail::Message::Field::DKIM-EB($level) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB( [$level] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Cleanup Extends L<"Cleanup" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Cleanup">. =over 4 =item $obj-EB() Inherited, see L =back =head1 DETAILS Extends L<"DETAILS" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"DETAILS">. =head1 DIAGNOSTICS =over 4 =item Warning: Field content is not numerical: $content The numeric value of a field is requested (for instance the C or C fields should be numerical), however the data contains weird characters. =item Warning: Illegal character in charset '$charset' The field is created with an utf8 string which only contains data from the specified character set. However, that character set can never be a valid name because it contains characters which are not permitted. =item Warning: Illegal character in field name $name A new field is being created which does contain characters not permitted by the RFCs. Using this field in messages may break other e-mail clients or transfer agents, and therefore mutulate or extinguish your message. =item Warning: Illegal character in language '$lang' The field is created with data which is specified to be in a certain language, however, the name of the language cannot be valid: it contains characters which are not permitted by the RFCs. =item Warning: Illegal encoding '$encoding', used 'q' The RFCs only permit base64 (C or C) or quoted-printable (C or C) encoding. Other than these four options are illegal. =item Error: No attributes for DKIM headers Is is not possible to add attributes to this field. =item Error: Package $package does not implement $method. Fatal error: the specific package (or one of its superclasses) does not implement this method where it should. This message means that some other related classes do implement this method however the class at hand does not. Probably you should investigate this and probably inform the author of the package. =back =head1 SEE ALSO This module is part of Mail-Message distribution version 3.006, built on January 24, 2018. Website: F =head1 LICENSE Copyrights 2001-2018 by [Mark Overmeer]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Mail-Message-3.006/lib/Mail/Message/Field/AddrGroup.pod0000644000175000001440000001714313232126166023146 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Mail::Message::Field::AddrGroup - A group of Mail::Message::Field::Address objects =head1 INHERITANCE Mail::Message::Field::AddrGroup is an User::Identity::Collection::Emails is an User::Identity::Collection is an User::Identity::Item =head1 SYNOPSIS my $g = Mail::Message::Field::AddrGroup->new(name => 'name'); my $a = Mail::Message::Field::Address->new(...); $g->addAddress($a); my $f = Mail::Message::Field::Addresses->new; $f->addGroup($g); =head1 DESCRIPTION An address group collects a set of e-mail addresses (in this case they are L objects). Extends L<"DESCRIPTION" in User::Identity::Collection::Emails|User::Identity::Collection::Emails/"DESCRIPTION">. =head1 OVERLOADED Extends L<"OVERLOADED" in User::Identity::Collection::Emails|User::Identity::Collection::Emails/"OVERLOADED">. =over 4 =item overload: B<@{}> Inherited, see L =item overload: B Returns the L value. =item overload: B Inherited, see L =back =head1 METHODS Extends L<"METHODS" in User::Identity::Collection::Emails|User::Identity::Collection::Emails/"METHODS">. =over 4 =item $obj-EB() Returns the address group as string. When no name is specified, it will only be a comma separated list of addresses. With a name, the groups name will be prepended and a semi-colon appended. When no addresses where included and there is no name, then C is returned. =back =head2 Constructors Extends L<"Constructors" in User::Identity::Collection::Emails|User::Identity::Collection::Emails/"Constructors">. =over 4 =item $obj-EB($object) Coerce an $object into a L. Currently, you can only coerce L (which is the base class for this one) into this one. =item Mail::Message::Field::AddrGroup-EB( [$name], %options ) Inherited, see L =back =head2 Attributes Extends L<"Attributes" in User::Identity::Collection::Emails|User::Identity::Collection::Emails/"Attributes">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$newname] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Collections Extends L<"Collections" in User::Identity::Collection::Emails|User::Identity::Collection::Emails/"Collections">. =over 4 =item $obj-EB($collection, $role) Inherited, see L =item $obj-EB( $object | <[$type], %options> ) Inherited, see L =item $obj-EB($name) Inherited, see L =item $obj-EB( [$parent] ) Inherited, see L =item $obj-EB($object|$name) Inherited, see L =item $obj-EB() =item Mail::Message::Field::AddrGroup-EB() Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Maintaining roles Extends L<"Maintaining roles" in User::Identity::Collection::Emails|User::Identity::Collection::Emails/"Maintaining roles">. =over 4 =item $obj-EB($role| <[$name],%options> | ARRAY) Inherited, see L =item $obj-EB($role|$name) Inherited, see L =item $obj-EB( <$role|$oldname>, $newname ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Searching Extends L<"Searching" in User::Identity::Collection::Emails|User::Identity::Collection::Emails/"Searching">. =over 4 =item $obj-EB($name|CODE|undef) Inherited, see L =back =head2 Addresses =over 4 =item $obj-EB(STRING|$address|%options) Add one e-mail address to the list which is maintained in the group. This is a wrapper around L adding flexibility on how addresses are specified. An $address can be anything which is acceptable for L or a list of options which will create such an object. example: of adding an address to an address group my @data = (full_name => "Myself", address => 'me@tux.org'); $group->addAddress(@data); my $addr = Mail::Message::Field::Address->new(@data); $group->addAddress(@data); my $ma = Mail::Address->new(...); $group->addAddress($ma); =item $obj-EB() Returns all addresses defined in this group. The addresses will be ordered alphabetically to make automated testing possible: roles are stored in a hash, so have an unpredictable order by default. example: getting all addresses from a group my @addrs = $group->addresses; my @addrs = map { $_->address } $self->roles; #same =back =head2 Error handling =encoding utf8 =head1 DIAGNOSTICS =over 4 =item Error: $object is not a collection. The first argument is an object, but not of a class which extends L. =item Error: Cannot coerce a $type into a Mail::Message::Field::AddrGroup =item Error: Cannot create a $type to add this to my collection. Some options are specified to create a $type object, which is native to this collection. However, for some reason this failed. =item Error: Cannot load collection module for $type ($class). Either the specified $type does not exist, or that module named $class returns compilation errors. If the type as specified in the warning is not the name of a package, you specified a nickname which was not defined. Maybe you forgot the 'require' the package which defines the nickname. =item Error: Cannot rename $name into $newname: already exists =item Error: Cannot rename $name into $newname: doesn't exist =item Error: Creation of a collection via $class failed. The $class did compile, but it was not possible to create an object of that class using the options you specified. =item Error: Don't know what type of collection you want to add. If you add a collection, it must either by a collection object or a list of options which can be used to create a collection object. In the latter case, the type of collection must be specified. =item Warning: No collection $name The collection with $name does not exist and can not be created. =item Error: Wrong type of role for $collection: requires a $expect but got a $type Each $collection groups sets of roles of one specific type ($expect). You cannot add objects of a different $type. =back =head1 SEE ALSO This module is part of Mail-Message distribution version 3.006, built on January 24, 2018. Website: F =head1 LICENSE Copyrights 2001-2018 by [Mark Overmeer]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Mail-Message-3.006/lib/Mail/Message/Field/AddrGroup.pm0000644000175000001440000000324413232126165022774 0ustar00markovusers00000000000000# Copyrights 2001-2018 by [Mark Overmeer]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.02. # This code is part of distribution Mail-Message. Meta-POD processed with # OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. package Mail::Message::Field::AddrGroup; use vars '$VERSION'; $VERSION = '3.006'; use base 'User::Identity::Collection::Emails'; use strict; use warnings; use overload '""' => 'string'; #------------------------------------------ sub string() { my $self = shift; my $name = $self->name; my @addr = sort map $_->string, $self->addresses; local $" = ', '; length $name ? "$name: @addr;" : @addr ? "@addr" : ''; } #------------------------------------------ sub coerce($@) { my ($class, $addr, %args) = @_; return () unless defined $addr; if(ref $addr) { return $addr if $addr->isa($class); return bless $addr, $class if $addr->isa('User::Identity::Collection::Emails'); } $class->log(ERROR => "Cannot coerce a ".(ref($addr)|'string'). " into a $class"); (); } #------------------------------------------ sub addAddress(@) { my $self = shift; my $addr = @_ > 1 ? Mail::Message::Field::Address->new(@_) : !$_[0] ? return () : Mail::Message::Field::Address->coerce(shift); $self->addRole($addr); $addr; } # roles are stored in a hash, so produce sub addresses() { shift->roles } #------------------------------------------ 1; Mail-Message-3.006/lib/Mail/Message/Field/AuthResults.pm0000644000175000001440000001244613232126165023374 0ustar00markovusers00000000000000# Copyrights 2001-2018 by [Mark Overmeer]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.02. # This code is part of distribution Mail-Message. Meta-POD processed with # OODoc into POD and HTML manual-pages. See README.md # Copyright Mark Overmeer. Licensed under the same terms as Perl itself. package Mail::Message::Field::AuthResults; use vars '$VERSION'; $VERSION = '3.006'; use base 'Mail::Message::Field::Structured'; use warnings; use strict; use URI; sub init($) { my ($self, $args) = @_; $self->{MMFA_server} = delete $args->{server}; $self->{MMFA_version} = delete $args->{version}; $self->{MMFA_results} = []; $self->addResult($_) for @{delete $args->{results} || []}; $self->SUPER::init($args); } sub parse($) { my ($self, $string) = @_; $string =~ s/\r?\n/ /g; (undef, $string) = $self->consumeComment($string); $self->{MMFA_server} = $string =~ s/^\s*([.\w-]*\w)// ? $1 : 'unknown'; (undef, $string) = $self->consumeComment($string); $self->{MMFA_version} = $string =~ s/^\s*([0-9]+)// ? $1 : 1; (undef, $string) = $self->consumeComment($string); $string =~ s/^.*?\;/;/; # remove accidents my @results; while( $string =~ s/^\s*\;// ) { (undef, $string) = $self->consumeComment($string); if($string =~ s/^\s*none//) { (undef, $string) = $self->consumeComment($string); next; } my %result; push @results, \%result; $string =~ s/^\s*([\w-]*\w)// or next; $result{method} = $1; (undef, $string) = $self->consumeComment($string); if($string =~ s!^\s*/!!) { (undef, $string) = $self->consumeComment($string); $result{method_version} = $1 if $string =~ s/^\s*([0-9]+)//; } (undef, $string) = $self->consumeComment($string); if($string =~ s/^\s*\=//) { (undef, $string) = $self->consumeComment($string); $result{result} = $1 if $string =~ s/^\s*(\w+)//; } (my $comment, $string) = $self->consumeComment($string); if($comment) { $result{comment} = $comment; (undef, $string) = $self->consumeComment($string); } if($string =~ s/\s*reason//) { (undef, $string) = $self->consumeComment($string); if($string =~ s/\s*\=//) { (undef, $string) = $self->consumeComment($string); $result{reason} = $1 if $string =~ s/^\"([^"]*)\"// || $string =~ s/^\'([^']*)\'// || $string =~ s/^(\w+)//; } } while($string =~ /\S/) { (undef, $string) = $self->consumeComment($string); last if $string =~ /^\s*\;/; my $ptype = $string =~ s/^\s*([\w-]+)// ? $1 : last; (undef, $string) = $self->consumeComment($string); my ($property, $value); if($string =~ s/^\s*\.//) { (undef, $string) = $self->consumeComment($string); $property = $string =~ s/^\s*([\w-]+)// ? $1 : last; (undef, $string) = $self->consumeComment($string); if($string =~ s/^\s*\=//) { (undef, $string) = $self->consumeComment($string); $string =~ s/^\s+//; $string =~ s/^\"([^"]*)\"// || $string =~ s/^\'([^']*)\'// || $string =~ s/^([\w@.-]+)// or last; $value = $1; } } if(defined $value) { $result{"$ptype.$property"} = $value; } else { $string =~ s/^.*?\;/;/g; # recover from parser problem } } } $self->addResult($_) for @results; $self; } sub produceBody() { my $self = shift; my $source = $self->server; my $version = $self->version; $source .= " $version" if $version!=1; my @results; foreach my $r ($self->results) { my $method = $r->{method}; $method .= "/$r->{method_version}" if $r->{method_version} != 1; my $result = "$method=$r->{result}"; $result .= ' ' . $self->createComment($r->{comment}) if defined $r->{comment}; if(my $reason = $r->{reason}) { $reason =~ s/"/\\"/g; $result .= qq{ reason="$reason"}; } foreach my $prop (sort keys %$r) { index($prop, '.') > -1 or next; my $value = $r->{$prop}; $value =~ s/"/\\"/g; $result .= qq{ $prop="$value"}; } push @results, $result; } push @results, 'none' unless @results; join '; ', $source, @results; } #------------------------------------------ sub addAttribute($;@) { my $self = shift; $self->log(ERROR => 'No attributes for Authentication-Results.'); $self; } sub server() { shift->{MMFA_server} } sub version() { shift->{MMFA_version} } sub results() { @{shift->{MMFA_results}} } sub addResult($) { my $self = shift; my $r = @_==1 ? shift : {@_}; $r->{method} && $r->{result} or return (); $r->{method_version} ||= 1; push @{$self->{MMFA_results}}, $r; delete $self->{MMFF_body}; $r; } #------------------------------------------ 1; Mail-Message-3.006/lib/Mail/Message/Field/Date.pod0000644000175000001440000003076113232126166022135 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME Mail::Message::Field::Date - message header field with uris =head1 INHERITANCE Mail::Message::Field::Date is a Mail::Message::Field::Structured is a Mail::Message::Field::Full is a Mail::Message::Field is a Mail::Reporter =head1 SYNOPSIS my $f = Mail::Message::Field->new(Date => time); =head1 DESCRIPTION Dates are a little more tricky than it should be: the formatting permits a few constructs more than other RFCs use for timestamps. For instance, a small subset of timezone abbreviations are permitted. The studied date field will reformat the content into a standard form. Extends L<"DESCRIPTION" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"DESCRIPTION">. =head1 OVERLOADED Extends L<"OVERLOADED" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"OVERLOADED">. =over 4 =item overload: B<""> Inherited, see L =item overload: B<0+> Inherited, see L =item overload: B<<=>> Inherited, see L =item overload: B Inherited, see L =item overload: B Inherited, see L =item overload: B Inherited, see L =back =head1 METHODS Extends L<"METHODS" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"METHODS">. =head2 Constructors Extends L<"Constructors" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Constructors">. =over 4 =item $obj-EB() Inherited, see L =item Mail::Message::Field::Date-EB($field, %options) Inherited, see L =item Mail::Message::Field::Date-EB($data) -Option --Defined in --Default attributes Mail::Message::Field::Structured charset Mail::Message::Field::Full undef datum Mail::Message::Field::Structured undef encoding Mail::Message::Field::Full 'q' force Mail::Message::Field::Full false language Mail::Message::Field::Full undef log Mail::Reporter 'WARNINGS' trace Mail::Reporter 'WARNINGS' =over 2 =item attributes => ATTRS =item charset => STRING =item datum => STRING =item encoding => 'q'|'Q'|'b'|'B' =item force => BOOLEAN =item language => STRING =item log => LEVEL =item trace => LEVEL =back example: my $mmfd = 'Mail::Message::Field::Date'; my $f = $mmfd->new(Date => time); =back =head2 The field Extends L<"The field" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"The field">. =over 4 =item $obj-EB() =item Mail::Message::Field::Date-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$fh] ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$wrap] ) Inherited, see L =item $obj-EB() Inherited, see L =back =head2 Access to the name Extends L<"Access to the name" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Access to the name">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [STRING] ) Inherited, see L =back =head2 Access to the body Extends L<"Access to the body" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Access to the body">. =over 4 =item $obj-EB() Inherited, see L =item $obj-EB(%options) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [$body] ) Inherited, see L =item $obj-EB( [STRING] ) =item Mail::Message::Field::Date-EB( [STRING] ) Inherited, see L =item $obj-EB( [$body, [$wrap]] ) Inherited, see L =back =head2 Access to the content Extends L<"Access to the content" in Mail::Message::Field::Structured|Mail::Message::Field::Structured/"Access to the content">. =over 4 =item $obj-EB(...) Attributes are not supported for date fields. =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( $object||<$name,$value,%options> ) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB( [STRING] ) Inherited, see L =item $obj-EB(STRING, %options) =item Mail::Message::Field::Date-EB(STRING, %options) Inherited, see L =item $obj-EB(STRING, %options) =item Mail::Message::Field::Date-EB(STRING, %options) Inherited, see L =item $obj-EB() Inherited, see L =item $obj-EB