Mail-Box-2.118/ 0000755 0001750 0000144 00000000000 12473604501 013655 5 ustar 00markov users 0000000 0000000 Mail-Box-2.118/tests/ 0000755 0001750 0000144 00000000000 12473604501 015017 5 ustar 00markov users 0000000 0000000 Mail-Box-2.118/tests/60imap/ 0000755 0001750 0000144 00000000000 12473604501 016113 5 ustar 00markov users 0000000 0000000 Mail-Box-2.118/tests/60imap/Definition.pm 0000644 0001750 0000144 00000000556 12473604424 020553 0 ustar 00markov users 0000000 0000000 # Copyrights 2001-2015 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.01.
package MailBox::Test::60imap::Definition;
use vars '$VERSION';
$VERSION = '2.118';
sub name {"Mail::Server::IMAP; imap server"}
sub critical {0}
sub skip { undef }
1;
Mail-Box-2.118/tests/60imap/10fetch.t 0000644 0001750 0000144 00000014111 12473603434 017534 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
#
# Test body-structure capturing for IMAP servers
use strict;
use warnings;
use Test::More;
use lib qw(. .. tests);
use Tools;
use Mail::Message;
use Mail::Message::Body::Lines;
use Mail::Server::IMAP4::Fetch;
my $msif = 'Mail::Server::IMAP4::Fetch';
BEGIN
{ plan tests => 44;
}
my $msg = Mail::Message->build
( From => 'I myself and me '
, To => 'you@example.com'
, Date => 'now'
, Subject => 'Life of Brian'
, 'Message-ID' => 'unique'
, data => [ "two\n", "lines\n" ]
);
ok($msg, "First, simple message built");
my $f = $msif->new($msg);
isa_ok($f, $msif);
ok($f->part() == $f);
ok(!defined $f->part('1'));
#use Data::Dumper;
#print Dumper $f;
is($f->fetchBody(0)."\n", <<__BODY, '...body');
("TEXT" "PLAIN" ("charset" "utf-8") "" NIL "8BIT" 10 2)
__BODY
is($f->fetchBody(1)."\n", <<__BODYSTRUCT, '...bodystruct');
("TEXT" "PLAIN" ("charset" "utf-8") "" NIL "8BIT" 10 2 NIL ("inline") NIL)
__BODYSTRUCT
is($f->fetchEnvelope."\n", <<__ENVELOPE, '...envelope');
("now" "Life of Brian" ("I myself and me" NIL "me" "localhost") NIL NIL (NIL NIL "you" "example.com") NIL NIL NIL "")
__ENVELOPE
#
# Simple multipart
#
my $data = Mail::Message::Body::Lines->new
( mime_type => 'audio/mpeg3'
, transfer_encoding => 'base64'
, charset => 'utf8'
, data => "ABBA\n"
);
my $mp = Mail::Message->build
( From => 'me'
, Date => 'now'
, Subject => 'multi'
, 'Message-ID' => 'unique'
, data => [ "two\n", "lines\n" ]
, attach => $data
);
ok(defined $mp, "Simple multipart");
$f = $msif->new($mp);
isa_ok($f, $msif);
ok($f->part() == $f);
is($f->fetchBody(0)."\n", <<__BODY, '...body');
(("TEXT" "PLAIN" ("charset" "utf-8") NIL NIL "8BIT" 10 2)("AUDIO" "MPEG3" () NIL NIL "BASE64" 5 1) "MIXED")
__BODY
is($f->fetchBody(1)."\n", <<__BODYSTRUCT, '...bodystruct');
(("TEXT" "PLAIN" ("charset" "utf-8") NIL NIL "8BIT" 10 2 NIL ("inline") NIL)("AUDIO" "MPEG3" () NIL NIL "BASE64" 5 1 NIL ("attachment") NIL) "MIXED")
__BODYSTRUCT
is($f->fetchEnvelope."\n", <<__ENVELOPE, '...envelope');
("now" "multi" NIL NIL NIL NIL NIL NIL NIL "")
__ENVELOPE
ok($f->part('1'), "Has two parts");
ok($f->part('2'));
ok(!$f->part('3'));
ok(!$f->part('1.1'));
my $g = $f->part('2');
isa_ok($g, $msif);
is($g->fetchBody(0)."\n", <<__BODY, '...body');
("AUDIO" "MPEG3" () NIL NIL "BASE64" 5 1)
__BODY
is($g->fetchBody(1)."\n", <<__BODYSTRUCT, '...bodystruct');
("AUDIO" "MPEG3" () NIL NIL "BASE64" 5 1 NIL ("attachment") NIL)
__BODYSTRUCT
is($g->fetchEnvelope."\n", <<__ENVELOPE, '...envelope');
(NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL)
__ENVELOPE
#
# All fields in an envelope
#
my $a = Mail::Message->build
( From => 'FROM '
, To => 'TO '
, Cc => 'CC '
, Bcc => 'BCC '
, Sender => 'SENDER '
, 'Reply-To' => 'RT '
, Date => 'today'
, Subject => 'subject'
, 'Content-Type' => 'video/vhs'
, 'Content-Disposition' => 'attachment; filename="private-video.ras"; size=100'
, 'Content-Language' => 'nl-NL, nl-BE'
, 'Content-Description' => 'blue movie'
, 'Message-ID' => 'unique-id-123'
, data => "BINARY data for video"
);
ok(defined $a, "Full envelope");
#$a->print(\*STDERR);
##### get should become study
## my $s = $a->study('Content-Disposition');
## isa_ok($s, 'Mail::Message::Field::Structured');
my $s = $a->head->get('Content-Disposition');
isa_ok($s, 'Mail::Message::Field');
is($s->attribute('filename'), 'private-video.ras', '...one attr');
my %attrs = $s->attributes;
cmp_ok(keys %attrs, '==', 2, '...nr attrs');
is($attrs{filename}, 'private-video.ras', '...filename');
is($attrs{size}, 100, '...size');
$f = $msif->new($a);
isa_ok($f, $msif);
is($f->fetchBody(0)."\n", <<__BODY, "...body");
("VIDEO" "VHS" () "" "blue movie" "BASE64" 29 1)
__BODY
is($f->fetchBody(1)."\n", <<__BODYSTRUCT, "...bodystruct");
("VIDEO" "VHS" () "" "blue movie" "BASE64" 29 1 NIL ("attachment" "filename" "private-video.ras" "size" "100") "nl-NL, nl-BE")
__BODYSTRUCT
is($f->fetchEnvelope."\n", <<__ENVELOPE, "...envelope");
("today" "subject" ("FROM" NIL "from" "from.home") ("SENDER" NIL "sender" "sender.home") ("RT" NIL "replyto" "rt.home") ("TO" NIL "to" "to.home") ("CC" NIL "cc" "cc.home") ("BCC" NIL "bcc" "bcc.home") NIL "")
__ENVELOPE
#
# Nested
#
my $b = Mail::Message->build
( To => 'someelse@somewhere.aq'
, 'Message-Id' => 'newid'
, Date => 'tomorrow'
, attach => $msg
);
ok(defined $b, "Constructed nested message");
isa_ok($b, 'Mail::Message');
ok($b->isNested, 'check structure');
$f = $msif->new($b);
isa_ok($f, $msif);
#$b->print(\*STDERR);
is($f->fetchBody(0)."\n", <<__BODY, "...body");
("MESSAGE" "RFC822" () "" NIL "8BIT" 212 ("now" "Life of Brian" ("I myself and me" NIL "me" "localhost") NIL NIL (NIL NIL "you" "example.com") NIL NIL NIL "") ("TEXT" "PLAIN" ("charset" "utf-8") "" NIL "8BIT" 10 2) 11)
__BODY
is($f->fetchBody(1)."\n", <<__BODYSTRUCT, "...bodystruct");
("MESSAGE" "RFC822" () "" NIL "8BIT" 212 ("now" "Life of Brian" ("I myself and me" NIL "me" "localhost") NIL NIL (NIL NIL "you" "example.com") NIL NIL NIL "") ("TEXT" "PLAIN" ("charset" "utf-8") "" NIL "8BIT" 10 2 NIL ("inline") NIL) 11 NIL ("inline") NIL)
__BODYSTRUCT
is($f->fetchEnvelope."\n", <<__ENVELOPE, "...envelope");
("tomorrow" NIL NIL NIL NIL (NIL NIL "someelse" "somewhere.aq") NIL NIL NIL "")
__ENVELOPE
#$b->print(\*STDERR);
$g = $f->part('1');
ok(defined $g, "nested info");
isa_ok($g, $msif);
ok($f != $g);
is($g->fetchBody(0)."\n", <<__BODY, "...body");
("TEXT" "PLAIN" ("charset" "utf-8") "" NIL "8BIT" 10 2)
__BODY
is($g->fetchBody(1)."\n", <<__BODYSTRUCT, "...bodystruct");
("TEXT" "PLAIN" ("charset" "utf-8") "" NIL "8BIT" 10 2 NIL ("inline") NIL)
__BODYSTRUCT
is($g->fetchEnvelope."\n", <<__ENVELOPE, "...envelope");
("now" "Life of Brian" ("I myself and me" NIL "me" "localhost") NIL NIL (NIL NIL "you" "example.com") NIL NIL NIL "")
__ENVELOPE
Mail-Box-2.118/tests/60imap/20list.t 0000644 0001750 0000144 00000013433 12473603434 017425 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
# Test list command for IMAP servers
#
# A lot of the basic administration handling is tested in 52manager/30collect.t
use strict;
use warnings;
use Test::More;
use lib qw(. .. tests);
use Tools;
use Mail::Server::IMAP4::List;
use Mail::Box::MH;
use Mail::Box::Identity;
my $msil = 'Mail::Server::IMAP4::List';
my $mbi = 'Mail::Box::Identity';
BEGIN
{ plan tests => 41;
}
my @boxes =
qw( a1
a1/b1
a1/b2
a1/b2/c1
a1/b2/c2
a1/b2/c3
a1/b2/c3/d1
a1/b2/c3/d2
a1/b3
a2
a3
);
# Create the directory hierarchy
my $top = '60imap-test';
clean_dir($top);
mkdir $top or die "$top: $!";
foreach my $box (@boxes)
{ my $dir = "$top/$box";
mkdir $dir or die "$dir: $!";
}
# Create the top object
my $folders = $mbi->new
( name => '='
, folder_type => 'Mail::Box::MH'
, only_subs => 1
);
ok(defined $folders, "Created the top folder");
isa_ok($folders, $mbi);
# Load the structure
my $count = 0;
sub setloc($)
{ my $node = shift;
my $full = $node->fullname;
$full =~ s/^\=/$top/;
$node->location($full);
$count++;
}
$folders->foreach(\&setloc);
cmp_ok($count, '==', @boxes+1, "Succesfully expanded");
ok($folders->onlySubfolders, "top without msgs");
my $a1 = $folders->folder('a1');
ok(defined $a1, "found $a1");
ok(!$a1->onlySubfolders, "other with msgs");
#
# Let's do the simple LIST check.
#
sub str(@)
{ return '' unless @_;
my @lines;
foreach my $record (@_)
{ my($flags, $delim, $rest) = @$record;
$rest = '""' unless length $rest;
push @lines, "$flags \"$delim\" $rest\n";
}
join '', @lines;
}
my $imap = $msil->new(folders => $folders, delimiter => '#');
isa_ok($imap, $msil);
is(str($imap->list('', '')), <<'__DELIM', 'as for delim');
(\Noselect) "#" ""
__DELIM
is(str($imap->list('#', 'a1')), <<'__DELIM');
() "#" #a1
__DELIM
$folders->folder('a1')->deleted(1);
is(str($imap->list('#', 'a1')), <<'__DELIM');
(\Noselect) "#" #a1
__DELIM
$folders->folder('a1')->deleted(0);
is(str($imap->list('#', 'a1')), <<'__DELIM');
() "#" #a1
__DELIM
$folders->folder('a1')->onlySubfolders(1);
is(str($imap->list('#', 'a1')), <<'__DELIM');
(\Noselect) "#" #a1
__DELIM
$folders->folder('a1')->marked(1);
is(str($imap->list('#', 'a1')), <<'__DELIM', 'marked');
(\Noselect \Marked) "#" #a1
__DELIM
$folders->folder('a1')->marked(0);
is(str($imap->list('#', 'a1')), <<'__DELIM', 'unmarked');
(\Noselect \Unmarked) "#" #a1
__DELIM
$folders->folder('a1')->marked(undef);
is(str($imap->list('#', 'a1')), <<'__DELIM', 'not marked');
(\Noselect) "#" #a1
__DELIM
is(str($imap->list('a1', 'b1')), <<'__DELIM', 'straight forward');
() "#" #a1#b1
__DELIM
is(str($imap->list('a1', 'none')), <<'__DELIM', 'missing');
__DELIM
is(str($imap->list('a1#b2', 'c3')), <<'__DELIM', 'stacking');
() "#" #a1#b2#c3
__DELIM
#
# Flags
#
my $abc = $folders->folder('a1', 'b2', 'c3');
ok(defined $abc, 'got abc');
$abc->marked(1);
is(str($imap->list('a1#b2', 'c3')), <<'__DELIM', 'abc marked');
(\Marked) "#" #a1#b2#c3
__DELIM
$abc->marked(0);
is(str($imap->list('a1#b2', 'c3')), <<'__DELIM', 'abc unmarked');
(\Unmarked) "#" #a1#b2#c3
__DELIM
$abc->marked(undef);
is(str($imap->list('a1#b2', 'c3')), <<'__DELIM', 'abc undef marked');
() "#" #a1#b2#c3
__DELIM
$abc->inferiors(0);
is(str($imap->list('a1#b2', 'c3')), <<'__DELIM', 'abc no inferiors');
(\Noinferiors) "#" #a1#b2#c3
__DELIM
$abc->inferiors(1);
is(str($imap->list('a1#b2', 'c3')), <<'__DELIM', 'abc inferiors');
() "#" #a1#b2#c3
__DELIM
$abc->inferiors(0);
$abc->marked(1);
is(str($imap->list('a1#b2', 'c3')), <<'__DELIM', 'abc inferiors');
(\Noinferiors \Marked) "#" #a1#b2#c3
__DELIM
$abc->inferiors(1);
$abc->marked(1);
is(str($imap->list('a1#b2', 'c3')), <<'__DELIM', 'abc inferiors');
(\Marked) "#" #a1#b2#c3
__DELIM
#
# Now for some real searching
#
is(str($imap->list('a1#none', '%')), <<'__DELIM', 'find none %');
__DELIM
is(str($imap->list('a1#none', '*')), <<'__DELIM', 'find none *');
__DELIM
is(str($imap->list('a1#b1', '%')), <<'__DELIM', 'find here %');
() "#" #a1#b1
__DELIM
is(str($imap->list('a1#b1', '*')), <<'__DELIM', 'find here *');
() "#" #a1#b1
__DELIM
is(str($imap->list('a1#b2', '%')), <<'__DELIM', 'find none %');
() "#" #a1#b2#c1
() "#" #a1#b2#c2
(\Marked) "#" #a1#b2#c3
__DELIM
is(str($imap->list('a1#b2', '*')), <<'__DELIM', 'find none *');
() "#" #a1#b2
() "#" #a1#b2#c1
() "#" #a1#b2#c2
(\Marked) "#" #a1#b2#c3
() "#" #a1#b2#c3#d1
() "#" #a1#b2#c3#d2
__DELIM
is(str($imap->list('a1', '%#b3')), <<'__DELIM', 'find inside %');
__DELIM
is(str($imap->list('a1', '*#b3')), <<'__DELIM', 'find inside *');
() "#" #a1#b3
__DELIM
is(str($imap->list('a1', 'b2#*')), <<'__DELIM', 'find inside *');
() "#" #a1#b2
() "#" #a1#b2#c1
() "#" #a1#b2#c2
(\Marked) "#" #a1#b2#c3
() "#" #a1#b2#c3#d1
() "#" #a1#b2#c3#d2
__DELIM
is(str($imap->list('a1', '*#c2')), <<'__DELIM', 'find inside *');
() "#" #a1#b2#c2
__DELIM
is(str($imap->list('a1', '*#d2')), <<'__DELIM', 'find inside *');
() "#" #a1#b2#c3#d2
__DELIM
#
# Complicated delimiter, as defined by the RFC. Examples in 6.3.8
#
sub combi_delim($)
{ my $path = shift;
my ($delim, $root)
= $path =~ m/^(#news\.)/ ? ('.', $1)
: $path =~ m!^/! ? ('/', '/')
: ('/', '');
wantarray ? ($delim, $root) : $delim;
}
$folders->onlySubfolders(0);
ok(! $folders->onlySubfolders);
$imap = $msil->new(folders => $folders, delimiter => \&combi_delim);
is(str($imap->list('', '')), <<'__DELIM', 'combi delim');
(\Noselect) "/" ""
__DELIM
is(str($imap->list('#news.comp.mail.misc', '')), <<'__DELIM');
(\Noselect) "." #news.
__DELIM
is(str($imap->list('/usr/staff/jones', '')), <<'__DELIM');
(\Noselect) "/" /
__DELIM
clean_dir($top);
Mail-Box-2.118/tests/31fgroups/ 0000755 0001750 0000144 00000000000 12473604501 016650 5 ustar 00markov users 0000000 0000000 Mail-Box-2.118/tests/31fgroups/Definition.pm 0000644 0001750 0000144 00000000602 12473604424 021300 0 ustar 00markov users 0000000 0000000 # Copyrights 2001-2015 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.01.
package MailBox::Test::31fgroups::Definition;
use vars '$VERSION';
$VERSION = '2.118';
sub name {"Mail::Message::Head::FieldGroup; grouping fields"}
sub critical {0}
sub skip { undef }
1;
Mail-Box-2.118/tests/31fgroups/sgfolder 0000644 0001750 0000144 00000112021 12473603434 020401 0 ustar 00markov users 0000000 0000000 From 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-Box-2.118/tests/31fgroups/mlfolder 0000644 0001750 0000144 00000121534 12473603434 020411 0 ustar 00markov users 0000000 0000000 From 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-Box-2.118/tests/31fgroups/10resent.t 0000644 0001750 0000144 00000005555 12473603434 020514 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
#
# Test the processing of resent groups.
#
use strict;
use warnings;
use lib qw(. .. tests);
use Tools;
use Test::More tests => 26;
use IO::Scalar;
use Mail::Message::Head::ResentGroup;
use Mail::Message::Head::Complete;
#
# 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-Box-2.118/tests/31fgroups/20list.t 0000644 0001750 0000144 00000015737 12473603434 020173 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
#
# Test the processing of list groups.
#
use strict;
use warnings;
use lib qw(. .. tests);
use Tools;
use Test::More;
use IO::Scalar;
use File::Spec;
use Mail::Message::Head::Complete;
use Mail::Message;
use Mail::Box::Mbox;
BEGIN {
if($] < 5.007003)
{ plan skip_all => "Requires module Encode, which requires Perl 5.7.3";
exit 0;
}
eval { require Mail::Message::Head::ListGroup };
if($@)
{ plan skip_all => 'Extended attributes not available (install Encode?)';
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 = 'mlfolder';
$fn = File::Spec->catfile('31fgroups', $fn) unless -f $fn;
$fn = File::Spec->catfile('tests', $fn) unless -f $fn;
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-Box-2.118/tests/31fgroups/30spam.t 0000644 0001750 0000144 00000007033 12473603434 020147 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
#
# Test the processing of spam groups.
#
use strict;
use warnings;
use lib qw(. .. tests);
use Tools;
use File::Spec;
use Test::More tests => 75;
use Mail::Message::Head::Complete;
use Mail::Message::Head::SpamGroup;
use Mail::Box::Mbox;
#
# 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 = 'sgfolder';
$fn = File::Spec->catfile('31fgroups', $fn) unless -f $fn;
$fn = File::Spec->catfile('tests', $fn) unless -f $fn;
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-Box-2.118/tests/10reporter/ 0000755 0001750 0000144 00000000000 12473604501 017022 5 ustar 00markov users 0000000 0000000 Mail-Box-2.118/tests/10reporter/Definition.pm 0000644 0001750 0000144 00000000563 12473604424 021460 0 ustar 00markov users 0000000 0000000 # Copyrights 2001-2015 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.01.
package MailBox::Test::10reporter::Definition;
use vars '$VERSION';
$VERSION = '2.118';
sub name {"Mail::Report; general base class"}
sub critical {1}
sub skip { undef }
1;
Mail-Box-2.118/tests/10reporter/20reports.t 0000644 0001750 0000144 00000005113 12473603434 021053 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
#
# Test reporting warnings and errors
#
use strict;
use warnings;
use lib qw(. .. tests);
use Tools;
use Test::More tests => 51;
use Mail::Reporter;
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-Box-2.118/tests/10reporter/30callback.t 0000644 0001750 0000144 00000002022 12473603434 021106 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
#
# Test installing a log callback
#
use strict;
use warnings;
use lib qw(. .. tests);
use Tools;
use Test::More tests => 13;
use Mail::Reporter;
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-Box-2.118/tests/10reporter/10errors.t 0000644 0001750 0000144 00000004575 12473603434 020703 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
#
# Test producing warnings, errors and family.
#
use strict;
use warnings;
use lib qw(. .. tests);
use Tools;
use Test::More tests => 41;
use Mail::Reporter;
#
# 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-Box-2.118/tests/12head/ 0000755 0001750 0000144 00000000000 12473604501 016063 5 ustar 00markov users 0000000 0000000 Mail-Box-2.118/tests/12head/Definition.pm 0000644 0001750 0000144 00000000563 12473604425 020522 0 ustar 00markov users 0000000 0000000 # Copyrights 2001-2015 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.01.
package MailBox::Test::12head::Definition;
use vars '$VERSION';
$VERSION = '2.118';
sub name {"Mail::Message::Head; message headers"}
sub critical {1}
sub skip { undef }
1;
Mail-Box-2.118/tests/12head/10create.t 0000644 0001750 0000144 00000003770 12473603434 017667 0 ustar 00markov users 0000000 0000000 #!/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 lib qw(. .. tests);
use Tools;
use Test::More tests => 25;
use IO::Scalar;
use Mail::Message::Head::Complete;
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-Box-2.118/tests/12head/30partial.t 0000644 0001750 0000144 00000001752 12473603434 020060 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
#
# Test the removing fields in partial headers.
#
use strict;
use warnings;
use lib qw(. .. tests);
use Tools;
use Test::More tests => 15;
use IO::Scalar;
use Mail::Message::Head::Complete;
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-Box-2.118/tests/40mbox/ 0000755 0001750 0000144 00000000000 12473604501 016130 5 ustar 00markov users 0000000 0000000 Mail-Box-2.118/tests/40mbox/Definition.pm 0000644 0001750 0000144 00000000554 12473604424 020566 0 ustar 00markov users 0000000 0000000 # Copyrights 2001-2015 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.01.
package MailBox::Test::40mbox::Definition;
use vars '$VERSION';
$VERSION = '2.118';
sub name {"Mail::Box::Mbox; mbox folders"}
sub critical {1}
sub skip { undef }
1;
Mail-Box-2.118/tests/40mbox/30delay.t 0000644 0001750 0000144 00000010057 12473603434 017565 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
#
# Test delay-loading on mbox folders.
#
use strict;
use warnings;
use lib qw(. .. tests);
use Tools;
use Test::More tests => 288;
use File::Compare;
use File::Copy;
use Mail::Box::Mbox;
#
# We will work with a copy of the original to avoid that we write
# over our test file.
#
copy $src, $cpy
or die "Cannot create test folder $cpy: $!\n";
my $folder = new Mail::Box::Mbox
( folder => "=$cpyfn"
, folderdir => $folderdir
, lock_type => 'NONE'
, extract => 'LAZY'
, access => 'rw'
);
die "Couldn't read $cpy: $!\n"
unless $folder;
#
# Check that the whole folder is continuous
#
my $blank = $crlf_platform ? 2 : 1;
my ($end, $msgnr) = (-$blank, 0);
foreach my $message ($folder->messages)
{ my ($msgbegin, $msgend) = $message->fileLocation;
my ($headbegin, $headend) = $message->head->fileLocation;
my ($bodybegin, $bodyend) = $message->body->fileLocation;
cmp_ok($msgbegin, "==", $end+$blank, "begin $msgnr");
cmp_ok($headbegin, ">", $msgbegin, "end $msgnr");
cmp_ok($bodybegin, "==", $headend, "glue $msgnr");
$end = $bodyend;
$msgnr++;
}
cmp_ok($end+$blank , "==", -s $folder->filename, "full folder read");
#
# None of the messages should be modified.
#
my $modified = 0;
$modified ||= $_->modified foreach $folder->messages;
ok(! $modified, "folder not modified");
#
# Write unmodified folder to different file.
# Because file-to-file copy of unmodified messages, the result must be
# the same.
#
my $oldsize = -s $folder->filename;
$folder->modified(1); # force write
ok($folder->write, "writing folder");
cmp_ok($oldsize, "==", -s $folder->filename, "expected size");
# Try to read it back
my $copy = new Mail::Box::Mbox
( folder => "=$cpyfn"
, folderdir => $folderdir
, lock_type => 'NONE'
, extract => 'LAZY'
);
ok(defined $copy, "re-reading folder");
cmp_ok($folder->messages, "==", $copy->messages, "all messages found");
# Check also if the subjects are the same.
my @f_subjects = map {$_->head->get('subject') ||''} $folder->messages;
my @c_subjects = map {$_->head->get('subject') ||''} $copy->messages;
while(@f_subjects)
{ my $f = shift @f_subjects;
my $c = shift @c_subjects;
last unless $f eq $c;
}
ok(!@f_subjects, "all msg-subjects found");
#
# None of the messages should be parsed yet.
#
my $parsed = 0;
$_->isParsed && $parsed++ foreach $folder->messages;
cmp_ok($parsed, "==", 0, "none of the msgs parsed");
#
# Check that the whole folder is continuous
#
($end, $msgnr) = (-$blank, 0);
foreach my $message ($copy->messages)
{ my ($msgbegin, $msgend) = $message->fileLocation;
my ($headbegin, $headend) = $message->head->fileLocation;
my ($bodybegin, $bodyend) = $message->body->fileLocation;
#warn "($msgbegin, $msgend) ($headbegin, $headend) ($bodybegin, $bodyend)\n";
cmp_ok($msgbegin, "==", $end+$blank, "begin $msgnr");
cmp_ok($headbegin, ">", $msgbegin, "end $msgnr");
cmp_ok($bodybegin, "==", $headend, "glue $msgnr");
$end = $bodyend;
$msgnr++;
}
cmp_ok($end+$blank, "==", -s $copy->filename, "written file size ok");
#
# None of the messages should be parsed still.
#
$parsed = 0;
$_->isParsed && $parsed++ foreach $copy->messages;
cmp_ok($parsed, "==", 0, "none of the msgs parsed");
#
# Force one message to be loaded.
#
my $message = $copy->message(3)->forceLoad;
ok(ref $message, "force load of one msg");
my $body = $message->body;
ok($message->isParsed);
isa_ok($message, 'Mail::Message');
#
# Ask for a new field from the header, which is not taken by
# default. The message should get parsed.
#
ok(!defined $message->head->get('xyz'));
ok(not $copy->message(2)->isParsed);
ok(defined $copy->message(2)->head->get('x-mailer'));
isa_ok($copy->message(2)->head, 'Mail::Message::Head::Complete');
ok(not $copy->message(2)->isParsed);
unlink $cpy;
Mail-Box-2.118/tests/40mbox/40append.t 0000644 0001750 0000144 00000006605 12473603434 017743 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
#
# Test appending messages on Mbox folders.
#
use strict;
use warnings;
use lib qw(. .. tests);
use Tools;
use Test::More tests => 32;
use File::Compare;
use File::Copy;
use Mail::Box::Manager;
use Mail::Message::Construct;
#
# We will work with a copy of the original to avoid that we write
# over our test file.
#
my $empty = File::Spec->catfile($folderdir, 'empty');
copy $src, $cpy
or die "Cannot create test folder $cpy: $!\n";
unlink $empty;
my $mgr = Mail::Box::Manager->new;
my @fopts =
( lock_type => 'NONE'
, extract => 'LAZY'
, access => 'rw'
, save_on_exit => 0
);
my $folder = $mgr->open
( folder => "=$cpyfn"
, folderdir => $folderdir
, @fopts
);
die "Couldn't read $cpy: $!\n"
unless $folder;
cmp_ok($folder->messages, "==", 45);
# Add a message which is already in the opened folder. This should
# be ignored.
$folder->addMessage($folder->message(3)->clone);
cmp_ok($folder->messages, "==", 45);
#
# Create an Mail::Message and add this to the open folder.
#
my $msg = Mail::Message->build
( From => 'me@example.com'
, To => 'you@anywhere.aq'
, Subject => 'Just a try'
, data => [ "a short message\n", "of two lines.\n" ]
);
ok(defined $msg, "message build successful");
my @appended = $mgr->appendMessage("=$cpyfn", $msg);
cmp_ok($folder->messages, "==", 46, "message extends folder");
cmp_ok(scalar @appended, "==", 1, "coerced message returned");
isa_ok($appended[0], 'Mail::Box::Message');
cmp_ok($mgr->openFolders, "==", 1);
$mgr->close($folder);
cmp_ok($mgr->openFolders, "==", 0, "folder is closed");
my $msg2 = Mail::Message->build
( From => 'me_too@example.com'
, To => 'yourself@anywhere.aq'
, Subject => 'Just one more try'
, data => [ "a short message\n", "of two lines.\n" ]
);
my $old_size = -s $cpy;
@appended = $mgr->appendMessage($cpy, $msg2
, lock_type => 'NONE'
, extract => 'LAZY'
, access => 'rw'
);
cmp_ok(@appended, "==", 1);
cmp_ok($mgr->openFolders, "==", 0);
ok($old_size != -s $cpy);
$folder = $mgr->open
( folder => "=$cpyfn"
, folderdir => $folderdir
, @fopts
, access => 'rw'
);
ok($folder);
cmp_ok($folder->messages, "==", 47);
my $sec = $mgr->open
( folder => '=empty'
, folderdir => $folderdir
, @fopts
, create => 1
);
ok(defined $sec, "open newly created empty folder");
exit unless defined $sec;
cmp_ok($sec->messages, "==", 0, "no messages in new folder");
cmp_ok($mgr->openFolders, "==", 2, "but the manager knows it is created");
my $move = $folder->message(1);
ok(defined $move, "select a message to be moved");
my @moved = $mgr->moveMessage($sec, $move);
cmp_ok(@moved, "==", 1, "one message has been moved");
isa_ok($moved[0], 'Mail::Box::Message');
is($moved[0]->folder->name, $sec->name);
ok($move->deleted);
cmp_ok($folder->messages, "==", 47);
cmp_ok($sec->messages, "==", 1);
my $copy = $folder->message(2);
ok(defined $copy);
die unless defined $copy;
my @copied = $mgr->copyMessage($sec, $copy);
cmp_ok(@copied, "==", 1);
isa_ok($copied[0], 'Mail::Box::Message');
ok(!$copy->deleted);
cmp_ok($folder->messages, "==", 47);
cmp_ok($sec->messages, "==", 2);
ok($sec->modified);
$folder->close;
$sec->close;
ok(-f $empty);
ok(-s $empty);
unlink $empty;
Mail-Box-2.118/tests/40mbox/70inplace.t 0000644 0001750 0000144 00000011723 12473603434 020107 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
#
# Test writing of mbox folders using the inplace policy.
#
use strict;
use warnings;
use lib qw(. .. tests);
use Tools;
use Test::More tests => 116;
use File::Compare;
use File::Copy;
use Mail::Box::Mbox;
#
# We will work with a copy of the original to avoid that we write
# over our test file.
#
unlink $cpy;
copy $src, $cpy
or die "Cannot create test folder $cpy: $!\n";
my $folder = new Mail::Box::Mbox
( folder => "=$cpyfn"
, folderdir => $folderdir
, lock_type => 'NONE'
, extract => 'LAZY'
, access => 'rw'
, log => 'NOTICES'
#, trace => 'NOTICES'
);
die "Couldn't read $cpy: $!\n"
unless $folder;
#
# None of the messages should be modified.
#
my $modified = 0;
$modified ||= $_->modified foreach $folder->messages;
ok(!$modified);
#
# Write unmodified folder. This should be ready immediately.
#
ok($folder->write(policy => 'INPLACE'));
my @progress = $folder->report('PROGRESS');
ok(grep m/not changed/, @progress);
#
# All messages must still be delayed.
#
my $msgnr = 0;
foreach ($folder->messages)
{ my $body = $_->body;
if($body->isDelayed || $body->isNested || $body->isMultipart) {ok(1)}
else { warn "Warn: failed message $msgnr.\n"; ok(0) }
$msgnr++;
}
#
# Now MODIFY the folder, and write it again.
#
my $modmsgnr = 30;
$folder->message($modmsgnr)->modified(1);
ok($folder->write(policy => 'INPLACE'));
ok(not $folder->modified);
#
# All before messages before $modmsgnr must still be delayed.
#
$msgnr = 0;
foreach ($folder->messages)
{ my $body = $_->body;
my $right = ($body->isDelayed || $body->isMultipart || $body->isNested)
? ($msgnr < $modmsgnr) : ($msgnr >= $modmsgnr);
ok($right, "delayed message $msgnr");
$msgnr++;
}
my @folder_subjects = sort map {$_->get('subject')||''} $folder->messages;
my $folder_messages = $folder->messages;
ok(not $folder->modified);
$folder->close;
# Check also if the subjects are the same.
# Try to read it back
my $copy = new Mail::Box::Mbox
( folder => "=$cpyfn"
, folderdir => $folderdir
, lock_type => 'NONE'
, extract => 'ALWAYS'
);
ok(defined $copy);
cmp_ok($copy->messages, "==", $folder_messages);
# Check also if the subjects are the same.
my @copy_subjects = sort map {$_->get('subject')||''} $copy->messages;
my $msg12subject = $copy->message(12)->get('subject');
ok(defined $msg12subject, "got msg12 subject");
while(@folder_subjects)
{ last unless shift(@folder_subjects) eq shift(@copy_subjects);
}
ok(!@folder_subjects);
#
# Check wether inplace rewrite works when a few messages are deleted.
#
$copy = new Mail::Box::Mbox
( folder => "=$cpyfn"
, folderdir => $folderdir
, lock_type => 'NONE'
, extract => 'LAZY'
, access => 'rw'
, log => 'NOTICES'
#, trace => 'NOTICES'
);
die "Couldn't read $cpyfn: $!\n"
unless $copy;
$copy->message(-1)->delete; # last flagged for deletion
ok($copy->message(-1)->deleted);
ok($copy->write(policy => 'INPLACE'), "write folder with fewer messsages");
$copy = new Mail::Box::Mbox
( folder => "=$cpyfn"
, folderdir => $folderdir
, lock_type => 'NONE'
, extract => 'ALWAYS'
);
ok(defined $copy, "Reopen succesful");
cmp_ok($copy->messages+1, "==", $folder_messages, "1 message less");
#
# Rewrite it again, with again 1 fewer message
#
$copy->close;
ok(! defined $copy, "Folder is really closed");
$copy = new Mail::Box::Mbox
( folder => "=$cpyfn"
, folderdir => $folderdir
, lock_type => 'NONE'
, extract => 'ALWAYS'
, access => 'rw'
);
cmp_ok($copy->messages, "==", $folder_messages-1, "1 message still away");
$copy->message(10)->delete; # some other, doesn't matter
ok($copy->message(10)->deleted);
ok($copy->write(policy => 'INPLACE'), "write folder with fewer messsages");
$copy = new Mail::Box::Mbox
( folder => "=$cpyfn"
, folderdir => $folderdir
, lock_type => 'NONE'
, extract => 'ALWAYS'
);
cmp_ok($copy->messages, "==", $folder_messages-2, "2 messages fewer");
is($copy->message(11)->get('subject'), $msg12subject, "move message");
#
# Rewrite it again, with again 1 fewer message: this time the first message
#
$copy->close;
ok(! defined $copy, "Folder is really closed");
$copy = new Mail::Box::Mbox
( folder => "=$cpyfn"
, folderdir => $folderdir
, lock_type => 'NONE'
, extract => 'ALWAYS'
, access => 'rw'
);
cmp_ok($copy->messages, "==", $folder_messages-2, "2 message still away");
$copy->message(0)->delete; # first flagged for deletion
ok($copy->message(0)->deleted);
ok($copy->write(policy => 'INPLACE'), "write folder with fewer messsages");
$copy = new Mail::Box::Mbox
( folder => "=$cpyfn"
, folderdir => $folderdir
, lock_type => 'NONE'
, extract => 'ALWAYS'
);
cmp_ok($copy->messages, "==", $folder_messages-3, "3 messages fewer");
is($copy->message(10)->get('subject'), $msg12subject, "move message");
unlink $cpy;
Mail-Box-2.118/tests/40mbox/60thread.t 0000644 0001750 0000144 00000011365 12473603434 017744 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
#
# Test threading on Mbox folders.
#
use strict;
use warnings;
use lib qw(. .. tests);
use Tools;
use Test::More tests => 23;
use File::Copy;
use Mail::Box::Manager;
#
# We will work with a copy of the original to avoid that we write
# over our test file.
#
copy $src, $cpy
or die "Cannot create test folder $cpy: $!\n";
my $mgr = Mail::Box::Manager->new;
ok($mgr);
my $folder = $mgr->open
( folder => "=$cpyfn"
, folderdir => $folderdir
, lock_type => 'NONE'
, extract => 'LAZY'
, access => 'rw'
, save_on_exit => 0
# , thread_timespan => 'EVER'
);
ok($folder);
my $threads = $mgr->threads(folder => $folder);
# First try message which is single.
my $single = $folder->messageID(
'<200010041822.e94IMZr19712@mystic.es.dupont.com>');
ok($single);
my $single2 = $folder->messageID(
'200010041822.e94IMZr19712@mystic.es.dupont.com');
ok($single2);
is($single2, $single);
my $single3 = $folder->messageID(
'garbage <200010041822.e94IMZr19712@mystic.es.dupont.com> trash');
ok($single3);
is($single3, $single);
my $start = $threads->threadStart($single);
ok($start);
is($single->messageID, $start->message->messageID);
my $message = $folder->messageID('NDBBJJFDMKFOAIFBEPPJIELLCBAA.cknoos@atg.com');
ok($message);
my $this = $threads->thread($message);
ok($this);
compare_thread_dumps($this->threadToString, <<'MIDDLE', 'thread from here');
1.2K Problem resizing images through perl script
820 `- Re: Problem resizing images through perl script
1.8K `- RE: Problem resizing images through perl script
1.0K `- Re: Problem resizing images through perl script
MIDDLE
$start = $threads->threadStart($message);
ok(defined $start);
my $startmsg = $start->message;
ok(defined $startmsg);
isa_ok($startmsg, 'Mail::Message::Dummy');
isa_ok($startmsg, 'Mail::Message');
ok($startmsg->isDummy);
ok($startmsg->messageID ne $message->messageID);
compare_thread_dumps($start->threadToString, <<'START', 'thread from top');
1.2K *- Problem resizing images through perl script
820 | `- Re: Problem resizing images through perl script
1.8K | `- RE: Problem resizing images through perl script
1.0K | `- Re: Problem resizing images through perl script
1.2K `- Re: Convert HTM, HTML files to the .jpg format
START
$this->folded(1);
compare_thread_dumps($start->threadToString, <<'FOLDED', 'folded thread');
*- [4] Problem resizing images through perl script
1.2K `- Re: Convert HTM, HTML files to the .jpg format
FOLDED
$this->folded(0);
compare_thread_dumps($start->threadToString, <<'START', 'unfolded thread');
1.2K *- Problem resizing images through perl script
820 | `- Re: Problem resizing images through perl script
1.8K | `- RE: Problem resizing images through perl script
1.0K | `- Re: Problem resizing images through perl script
1.2K `- Re: Convert HTM, HTML files to the .jpg format
START
my $out = join '', map {$_->threadToString} $threads->sortedKnown;
my @lines = sort split "\n", $out;
ok(@lines = $folder->messages);
$out = join '', @lines;
my $dump = <<'DUMP';
1.3K Resize with Transparency
1.2K *- Re: File Conversion From HTML to PS and TIFF
2.1K `--*- Re: File Conversion From HTML to PS and TIFF
2.1K `- Re: File Conversion From HTML to PS and TIFF
1.4K Transparency question
2.4K RE: Transparency question
3.3K RE: Transparency question
5.5K RE: Transparency question
7.2K RE: Transparency question
2.7K RE: jpeg2000 question
1.2K *- Problem resizing images through perl script
820 | `- Re: Problem resizing images through perl script
1.8K | `- RE: Problem resizing images through perl script
1.0K | `- Re: Problem resizing images through perl script
1.2K `- Re: Convert HTM, HTML files to the .jpg format
747 Undefined Symbol: SetWarningHandler
1.1K `- Re: Undefined Symbol: SetWarningHandler
1.8K *- Re: watermarks/embossing
307 Re: Annotate problems (PR#298)
573 `- Re: Annotate problems (PR#298)
1.0K
1.4K `- Re: your mail
1.9K `- Re: your mail
152 Re: your mail
686 `- Re: your mail
189 Re: your mail
2.0K
670 Re: your mail
4.4K `- Re: your mail
552 mailing list archives
1.4K delegates.mgk set-up for unixware printing
1.5K printing solution for UW 7.1
1.4K *- Re: converts new sharpen factors
1.2K New ImageMagick mailing list
27 subscribe
822 Confirmation for subscribe magick-developer
63 `- Re: Confirmation for subscribe magick-developer
11K Welcome to magick-developer
1.7K core dump in simple ImageMagick example
2.2K `- Re: core dump in simple ImageMagick example
882 `- Re: core dump in simple ImageMagick example
754 `- Re: core dump in simple ImageMagick example
2.0K Core Dump on ReadImage
1.0K `- Re: Core Dump on ReadImage
1.6K Font metrics
DUMP
$dump = join '', sort split /^/, $out;
compare_thread_dumps($out, $dump , 'sorted full dump');
Mail-Box-2.118/tests/40mbox/20write.t 0000644 0001750 0000144 00000002746 12473603434 017626 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
#
# Test writing of mbox folders.
#
use strict;
use warnings;
use lib qw(. .. tests);
use Tools;
use Test::More tests => 5;
use File::Compare;
use File::Copy;
use Mail::Box::Mbox;
#
# We will work with a copy of the original to avoid that we write
# over our test file.
#
unlink $cpy;
copy $src, $cpy
or die "Cannot create test folder $cpy: $!\n";
my $folder = new Mail::Box::Mbox
( folder => "=$cpyfn"
, folderdir => $folderdir
, lock_type => 'NONE'
, extract => 'ALWAYS'
, access => 'rw'
);
die "Couldn't read $cpy: $!\n"
unless $folder;
#
# None of the messages should be modified.
#
my $modified = 0;
$modified ||= $_->modified foreach $folder->messages;
ok(!$modified);
#
# Write unmodified folder to different file.
# Because file-to-file copy of unmodified messages, the result must be
# the same.
#
$folder->modified(1); # force write
ok($folder->write(policy => 'REPLACE'));
# Try to read it back
my $copy = new Mail::Box::Mbox
( folder => "=$cpyfn"
, folderdir => $folderdir
, lock_type => 'NONE'
, extract => 'ALWAYS'
);
ok($copy);
cmp_ok($folder->messages, "==", $copy->messages);
# Check also if the subjects are the same.
my @folder_subjects = sort map {$_->head->get('subject')||''} $folder->messages;
my @copy_subjects = sort map {$_->head->get('subject')||''} $copy->messages;
while(@folder_subjects)
{ last unless shift(@folder_subjects) eq shift(@copy_subjects);
}
ok(!@folder_subjects);
Mail-Box-2.118/tests/40mbox/10read.t 0000644 0001750 0000144 00000004521 12473603434 017377 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
#
# Test reading of mbox folders.
#
use strict;
use warnings;
use lib qw(. .. tests);
use Tools;
use Test::More tests => 151;
use File::Compare;
use Mail::Box::Mbox;
my @src = (folder => "=$fn", folderdir => $folderdir);
ok(Mail::Box::Mbox->foundIn(@src), 'check foundIn');
#
# The folder is read.
#
my $folder = Mail::Box::Mbox->new
( @src
, lock_type => 'NONE'
, extract => 'ALWAYS'
);
ok(defined $folder, 'check success open folder');
exit 1 unless defined $folder;
cmp_ok($folder->messages , "==", 45, 'found all messages');
is($folder->organization, 'FILE', 'folder organization FILE');
#
# Extract one message.
#
my $message = $folder->message(2);
ok(defined $message, 'take one message');
isa_ok($message, 'Mail::Box::Message');
isa_ok($message, 'Mail::Box::Mbox::Message');
#
# Extract a few messages.
#
my @some = $folder->messages(3,7);
cmp_ok(@some, "==", 5, 'take range of messages');
isa_ok($some[0], 'Mail::Box::Message');
#
# All message should be parsed: extract => ALWAYS
#
my $parsed = 1;
$parsed &&= $_->isParsed foreach $folder->messages;
ok($parsed, 'all messages parsed');
#
# Check whether all message's locations are nicely connected.
#
my $blank = $crlf_platform ? 2 : 1;
my ($end, $msgnr) = (-$blank, 0);
foreach $message ($folder->messages)
{ my ($msgbegin, $msgend) = $message->fileLocation;
my ($headbegin, $headend) = $message->head->fileLocation;
my ($bodybegin, $bodyend) = $message->body->fileLocation;
#warn "($msgbegin, $msgend) ($headbegin, $headend) ($bodybegin, $bodyend)\n";
cmp_ok($msgbegin, "==", $end+$blank, "begin $msgnr");
cmp_ok($headbegin, ">", $msgbegin, "end $msgnr");
cmp_ok($bodybegin, "==", $headend, "glue $msgnr");
$end = $bodyend;
$msgnr++;
}
cmp_ok($end+$blank, "==", -s $folder->filename);
#
# Try to delete a message
#
ok(!$folder->message(2)->deleted, 'msg2 not yet deleted');
$folder->message(2)->delete;
ok($folder->message(2)->deleted, 'flag msg for deletion');
cmp_ok($folder->messages , "==", 45, 'deletion not performed yet');
cmp_ok($folder->messages('ACTIVE') , "==", 44, 'less messages ACTIVE');
cmp_ok($folder->messages('DELETED') , "==", 1, 'more messages DELETED');
$folder->close(write => 'NEVER');
exit 0;
Mail-Box-2.118/tests/40mbox/80update.t 0000644 0001750 0000144 00000002152 12473603434 017753 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
#
# Test appending messages on Mbox folders.
#
use strict;
use warnings;
use lib qw(. .. tests);
use Tools;
use Test::More tests => 4;
use File::Copy;
use Mail::Box::Manager;
#
# We will work with a copy of the original to avoid that we write
# over our test file.
#
unlink $cpy;
copy $src, $cpy
or die "Cannot create test folder $cpy: $!\n";
my $mgr = Mail::Box::Manager->new;
my @fopts =
( lock_type => 'NONE'
, extract => 'LAZY'
, access => 'rw'
, save_on_exit => 0
);
my $folder = $mgr->open
( folder => "=$cpyfn"
, folderdir => $folderdir
, @fopts
);
die "Couldn't read $cpy: $!\n"
unless $folder;
cmp_ok($folder->messages, "==", 45);
my $msg = Mail::Message->build
( From => 'me', To => 'you', Subject => 'Hello!'
, data => [ "one line\n" ]
);
ok(defined $msg);
my $filename = $folder->filename;
die "Cannot open $filename: $!"
unless open OUT, '>>', $filename;
print OUT $msg->head->createFromLine;
$msg->print(\*OUT);
close OUT;
cmp_ok($folder->messages, "==", 45);
$folder->update;
cmp_ok($folder->messages, "==", 46);
$folder->close;
Mail-Box-2.118/tests/40mbox/50create.t 0000644 0001750 0000144 00000013126 12473603434 017734 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
#
# Test creation/deletion and listing of folders.
#
use strict;
use warnings;
use lib qw(. .. tests);
use Tools;
use Test::More tests => 28;
use File::Copy;
use File::Spec;
use Mail::Box::Mbox;
use Mail::Message::Construct;
my $top = File::Spec->catdir($folderdir, 'Mail');
clean_dir $top;
#
# Create a nice structure which looks like a set of mbox folders.
#
sub dir($;$)
{ my $dirname = shift;
$dirname = File::Spec->catdir($dirname, shift) if @_;
die "Cannot create $dirname: $!\n"
unless -d $dirname || mkdir $dirname, 0700;
$dirname;
}
sub folder($$;$)
{ my $filename = File::Spec->catfile(shift, shift);
my $content = shift || $src; # by default copies whole default mbox
copy $content, $filename
or die "Cannot copy $content to $filename: $!\n";
}
clean_dir $top; # restart
dir $top;
folder $top, "f1", $0;
folder $top, "f2";
{ # Create an empty file.
my $f = IO::File->new(File::Spec->catfile($top,'f3'), 'w')
or die "Empty? $top/f3: $!";
$f->close;
}
my $dir = dir $top, "sub1";
folder $dir, "s1f1";
folder $dir, "s1f2";
folder $dir, "s1f3";
dir $top, "sub2"; # empty dir
folder $top, "f4";
$dir = dir $top, "f4.d"; # fake subfolder
folder $dir, "f4f1";
folder $dir, "f4f2";
folder $dir, "f4f3";
my $success =
compare_lists [ sort Mail::Box::Mbox->listSubFolders(folderdir => $top) ]
, [ qw/f1 f2 f3 f4 sub1 sub2/ ];
ok($success, 'Initial tree creation');
unless($success)
{ require File::Find;
File::Find::find( { wanted => sub {print STDERR "$_\n" }
, no_chdir => 1
}, $top);
exit 1;
}
ok(compare_lists [ sort Mail::Box::Mbox->listSubFolders(folderdir => $top) ]
, [ qw/f1 f2 f3 f4 sub1 sub2/ ]
);
ok(compare_lists [ sort Mail::Box::Mbox->listSubFolders
( folderdir => $top
, skip_empty => 1
) ]
, [ qw/f1 f2 f4 sub1/ ]
);
ok(compare_lists [ sort Mail::Box::Mbox->listSubFolders
( folderdir => $top
, check => 1
) ]
, [ qw/f2 f3 f4 sub1 sub2/ ]
);
ok(compare_lists [ sort Mail::Box::Mbox->listSubFolders
( folderdir => File::Spec->catfile($top, "f4.d")
) ]
, [ qw/f4f1 f4f2 f4f3/ ]
);
ok(compare_lists [ sort Mail::Box::Mbox->listSubFolders
( folderdir => $top
, folder => "=f4.d"
)
]
, [ qw/f4f1 f4f2 f4f3/ ]
);
ok(compare_lists [ sort Mail::Box::Mbox->listSubFolders
( folder => File::Spec->catfile($top, "f4")) ]
, [ qw/f4f1 f4f2 f4f3/ ]
);
#
# Open a folder in a sub-dir which uses the extention.
#
my $folder = Mail::Box::Mbox->new
( folderdir => $top
, folder => '=f4/f4f2'
, lock_type => 'NONE'
);
ok(defined $folder, 'open =f4/f4f2');
die unless defined $folder;
cmp_ok($folder->messages, "==", 45, 'found all messages');
$folder->close;
#
# Open a new folder.
#
ok(! -f File::Spec->catfile($top, 'f4', 'newfolder'));
Mail::Box::Mbox->create('=f4/newfolder', folderdir => $top);
ok(-f File::Spec->catfile($top, "f4.d", "newfolder"));
$folder = Mail::Box::Mbox->new
( folderdir => $top
, folder => '=f4/newfolder'
, access => 'rw'
, lock_type => 'NONE'
);
ok($folder);
cmp_ok($folder->messages, "==", 0);
my $msg = Mail::Message->build
( From => 'me@example.com'
, To => 'you@anywhere.aq'
, Subject => 'Just a try'
, data => [ "a short message\n", "of two lines.\n" ]
);
$folder->addMessage($msg);
cmp_ok($folder->messages, "==", 1);
$folder->close;
ok(-s File::Spec->catfile($top, 'f4.d', 'newfolder'));
#
# Delete a folder.
#
$folder = Mail::Box::Mbox->new
( folderdir => $top
, folder => '=f4'
, access => 'rw'
, lock_type => 'NONE'
);
ok(defined $folder. 'open folder =f4');
die unless defined $folder;
ok(-f File::Spec->catfile($top, "f4"), 'folder-file found');
$folder->delete(recurse=>1); # remove folder contents
$folder->close if defined $folder;
ok(! -f File::Spec->catfile($top, "f4"), 'empty folder clean-up');
ok(! -d File::Spec->catfile($top, "f4.d"), 'subfolder dir clean-up');
#
# Write a folder, but at the same place is a subdir. The subdir should
# be moved to a name ending on `.d'
#
my $sub1 = File::Spec->catfile($top, "sub1");
ok(-d $sub1, 'dir to be promoted');
ok(Mail::Box::Mbox->create('=sub1', folderdir => $top),
'promote dir to subfolder');
ok(-d File::Spec->catfile($top, "sub1.d"), 'check promotion');
ok(-f $sub1, 'new folder exists');
ok(-z $sub1, 'new folder is empty');
$folder = Mail::Box::Mbox->new
( folderdir => $top
, folder => '=sub1'
, access => 'rw'
, lock_type => 'NONE'
);
ok(defined $folder, 'open empty subfolder');
cmp_ok($folder->messages, "==", 0, 'subfolder is empty');
my $msg2 = Mail::Message->build
( From => 'me@example.com'
, To => 'you@anywhere.aq'
, Subject => 'Just a try'
, data => [ "a short message\n", "of two lines.\n" ]
);
$folder->addMessage($msg2);
cmp_ok($folder->messages, "==", 1, 'one message into empty folder');
$folder->close;
ok(-s $sub1, 'subfolder must exist now');
Mail-Box-2.118/tests/41mh/ 0000755 0001750 0000144 00000000000 12473604501 015570 5 ustar 00markov users 0000000 0000000 Mail-Box-2.118/tests/41mh/Definition.pm 0000644 0001750 0000144 00000000546 12473604425 020230 0 ustar 00markov users 0000000 0000000 # Copyrights 2001-2015 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.01.
package MailBox::Test::41mh::Definition;
use vars '$VERSION';
$VERSION = '2.118';
sub name {"Mail::Box::MH; mh folders"}
sub critical {0}
sub skip { undef }
1;
Mail-Box-2.118/tests/41mh/30append.t 0000644 0001750 0000144 00000003404 12473603434 017374 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
#
# Test appending messages on MH folders.
#
use strict;
use warnings;
use lib qw(. .. tests);
use Tools;
use Test::More tests => 10;
use File::Compare;
use File::Copy;
use Mail::Box::Manager;
use Mail::Message::Construct;
my $mhsrc = File::Spec->catfile('folders', 'mh.src');
clean_dir $mhsrc;
unpack_mbox2mh($src, $mhsrc);
my $mgr = Mail::Box::Manager->new;
my $folder = $mgr->open
( folder => $mhsrc
, lock_type => 'NONE'
, extract => 'LAZY'
, access => 'rw'
, save_on_exit => 0
);
die "Couldn't read $mhsrc: $!\n"
unless $folder;
# We checked this in other scripts before, but just want to be
# sure we have enough messages again.
cmp_ok($folder->messages, "==", 45);
# Add a message which is already in the opened folder. However, the
# message heads are not yet parsed, hence the message can not be
# ignored.
my $message3 = $folder->message(3);
ok($message3->isDelayed);
my $added = $message3->clone;
ok(!$message3->isDelayed);
$folder->addMessage($added);
cmp_ok($folder->messages, "==", 45);
ok(not $message3->deleted);
ok($added->deleted);
#
# Create an Mail::Message and add this to the open folder.
#
my $msg = Mail::Message->build
( From => 'me@example.com'
, To => 'you@anywhere.aq'
, Subject => 'Just a try'
, data => [ "a short message\n", "of two lines.\n" ]
);
$mgr->appendMessage($mhsrc, $msg);
cmp_ok($folder->messages, "==", 46);
cmp_ok($mgr->openFolders, "==", 1);
$mgr->close($folder); # changes are not saved.
cmp_ok($mgr->openFolders, "==", 0);
$mgr->appendMessage($mhsrc, $msg
, lock_type => 'NONE'
, extract => 'LAZY'
, access => 'rw'
, keep_index => 1
);
ok(-f File::Spec->catfile($mhsrc, "47")); # skipped 13, so new is 46+1
clean_dir $mhsrc;
Mail-Box-2.118/tests/41mh/60thread.t 0000644 0001750 0000144 00000010475 12473603434 017405 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
#
# Test threading of MH folders.
#
use strict;
use warnings;
use lib qw(. .. tests);
use Tools;
use Test::More tests => 5;
use File::Spec;
use List::Util 'sum';
use Mail::Box::Manager;
my $mhsrc = File::Spec->catfile('folders', 'mh.src');
clean_dir $mhsrc;
unpack_mbox2mh($src, $mhsrc);
my $mgr = new Mail::Box::Manager;
my $folder = $mgr->open
( folder => $mhsrc
, lock_type => 'NONE'
, extract => 'LAZY'
, access => 'rw'
);
my $threads = $mgr->threads(folder => $folder);
cmp_ok($threads->known , "==", 0);
my @all = $threads->sortedAll;
cmp_ok(scalar(@all) , "==", 28);
my $msgs = sum map {$_->numberOfMessages} @all;
cmp_ok($msgs, "==", scalar($folder->messages));
my $out = join '', map {$_->threadToString} @all;
my @lines = split /^/, $out;
cmp_ok(@lines, '==', $folder->messages);
$out = join '', sort @lines;
my $dump = $Mail::Message::crlf_platform ? <<'__DUMP_CRLF' : <<'__DUMP_LF';
1.4K Resize with Transparency
1.3K *- Re: File Conversion From HTML to PS and TIFF
2.1K `--*- Re: File Conversion From HTML to PS and TIFF
2.1K `- Re: File Conversion From HTML to PS and TIFF
1.5K Transparency question
2.5K RE: Transparency question
3.4K RE: Transparency question
5.7K RE: Transparency question
7.4K RE: Transparency question
2.8K RE: jpeg2000 question
1.3K *- Problem resizing images through perl script
843 | `- Re: Problem resizing images through perl script
1.9K | `- RE: Problem resizing images through perl script
1.0K | `- Re: Problem resizing images through perl script
1.2K `- Re: Convert HTM, HTML files to the .jpg format
766 Undefined Symbol: SetWarningHandler
1.1K `- Re: Undefined Symbol: SetWarningHandler
1.9K *- Re: watermarks/embossing
316 Re: Annotate problems (PR#298)
585 `- Re: Annotate problems (PR#298)
1.0K
1.4K `- Re: your mail
2.0K `- Re: your mail
156 Re: your mail
703 `- Re: your mail
194 Re: your mail
2.0K
684 Re: your mail
4.5K `- Re: your mail
569 mailing list archives
1.4K delegates.mgk set-up for unixware printing
1.5K printing solution for UW 7.1
1.5K *- Re: converts new sharpen factors
1.2K New ImageMagick mailing list
28 subscribe
847 Confirmation for subscribe magick-developer
64 `- Re: Confirmation for subscribe magick-developer
11K Welcome to magick-developer
1.7K core dump in simple ImageMagick example
2.2K `- Re: core dump in simple ImageMagick example
908 `- Re: core dump in simple ImageMagick example
770 `- Re: core dump in simple ImageMagick example
2.0K Core Dump on ReadImage
1.0K `- Re: Core Dump on ReadImage
1.6K Font metrics
__DUMP_CRLF
1.3K Resize with Transparency
1.2K *- Re: File Conversion From HTML to PS and TIFF
2.1K `--*- Re: File Conversion From HTML to PS and TIFF
2.1K `- Re: File Conversion From HTML to PS and TIFF
1.4K Transparency question
2.4K RE: Transparency question
3.3K RE: Transparency question
5.5K RE: Transparency question
7.2K RE: Transparency question
2.7K RE: jpeg2000 question
1.2K *- Problem resizing images through perl script
820 | `- Re: Problem resizing images through perl script
1.8K | `- RE: Problem resizing images through perl script
1.0K | `- Re: Problem resizing images through perl script
1.2K `- Re: Convert HTM, HTML files to the .jpg format
747 Undefined Symbol: SetWarningHandler
1.1K `- Re: Undefined Symbol: SetWarningHandler
1.8K *- Re: watermarks/embossing
307 Re: Annotate problems (PR#298)
573 `- Re: Annotate problems (PR#298)
1.0K
1.4K `- Re: your mail
1.9K `- Re: your mail
152 Re: your mail
686 `- Re: your mail
189 Re: your mail
2.0K
670 Re: your mail
4.4K `- Re: your mail
552 mailing list archives
1.4K delegates.mgk set-up for unixware printing
1.5K printing solution for UW 7.1
1.4K *- Re: converts new sharpen factors
1.2K New ImageMagick mailing list
27 subscribe
822 Confirmation for subscribe magick-developer
63 `- Re: Confirmation for subscribe magick-developer
11K Welcome to magick-developer
1.7K core dump in simple ImageMagick example
2.2K `- Re: core dump in simple ImageMagick example
882 `- Re: core dump in simple ImageMagick example
754 `- Re: core dump in simple ImageMagick example
2.0K Core Dump on ReadImage
1.0K `- Re: Core Dump on ReadImage
1.6K Font metrics
__DUMP_LF
$dump = join '', sort split /^/, $dump;
compare_thread_dumps($out, $dump, 'sort thread full dump');
clean_dir $mhsrc;
Mail-Box-2.118/tests/41mh/20write.t 0000644 0001750 0000144 00000002741 12473603434 017261 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
#
# Test writing of MH folders.
#
use strict;
use warnings;
use lib qw(. .. tests);
use Tools;
use Test::More tests => 54;
use File::Compare;
use File::Copy;
use Mail::Box::MH;
use Mail::Box::Mbox;
my $mhsrc = File::Spec->catfile('folders', 'mh.src');
clean_dir $mhsrc;
unpack_mbox2mh($src, $mhsrc);
my $folder = new Mail::Box::MH
( folder => $mhsrc
, lock_type => 'NONE'
, extract => 'LAZY'
, access => 'rw'
, keep_index => 1
);
ok(defined $folder);
cmp_ok($folder->messages, "==", 45);
my $msg3 = $folder->message(3);
# Nothing yet...
$folder->modified(1);
$folder->write(renumber => 0);
ok(compare_lists [sort {$a cmp $b} listdir $mhsrc],
[sort {$a cmp $b} '.index', '.mh_sequences', 1..12, 14..46]
);
$folder->modified(1);
$folder->write(renumber => 1);
ok(compare_lists [sort {$a cmp $b} listdir $mhsrc],
[sort {$a cmp $b} '.index', '.mh_sequences', 1..45]
);
$folder->message(2)->delete;
ok($folder->message(2)->isDelayed);
ok(defined $folder->message(3)->get('subject')); # load, creates index
$folder->write;
ok(compare_lists [sort {$a cmp $b} listdir $mhsrc],
[sort {$a cmp $b} '.index', '.mh_sequences', 1..44]
);
cmp_ok($folder->messages, "==", 44);
$folder->message(8)->delete;
ok($folder->message(8)->deleted);
cmp_ok($folder->messages, "==", 44);
$folder->write;
cmp_ok($folder->messages, "==", 43);
foreach ($folder->messages) { ok(! $_->deleted) }
$folder->close;
clean_dir $mhsrc;
Mail-Box-2.118/tests/41mh/10read.t 0000644 0001750 0000144 00000007656 12473603434 017053 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
#
# Test reading of MH folders.
#
use strict;
use warnings;
use lib qw(. .. tests);
use Tools;
use Test::More tests => 27;
use File::Compare;
use File::Copy;
use Mail::Box::MH;
use Mail::Box::Mbox;
my $mhsrc = File::Spec->catfile('folders', 'mh.src');
unpack_mbox2mh($src, $mhsrc);
ok(Mail::Box::MH->foundIn($mhsrc));
my $folder = new Mail::Box::MH
( folder => $mhsrc
, lock_type => 'NONE'
, extract => 'LAZY'
, access => 'rw'
);
ok(defined $folder);
# We skipped message number 13 in the production, but that shouldn't
# distrub things.
cmp_ok($folder->messages, "==", 45);
is($folder->organization, 'DIRECTORY');
#
# No single head should be read now, because extract == LAZY
# the default.
#
my $heads = 0;
foreach ($folder->messages)
{ $heads++ unless $_->head->isDelayed;
}
cmp_ok($heads, "==", 0);
#
# Loading a header should not be done unless really necessary.
#
my $message = $folder->message(7);
ok($message->head->isDelayed);
ok($message->filename); # already known, but should not trigger header
ok($message->head->isDelayed);
#
# Nothing should be parsed yet
#
my $parsed = 0;
foreach ($folder->messages)
{ $parsed++ if $_->isParsed;
}
cmp_ok($parsed, "==", 0);
#
# Trigger one message to get read.
#
ok($message->body->string); # trigger body loading.
ok($message->isParsed);
#
# Test taking header
#
$message = $folder->message(8);
ok(defined $message->head->get('subject'));
ok(not $message->isParsed);
is(ref $message->head, 'Mail::Message::Head::Complete');
# This shouldn't cause any parsings: we do lazy extract, but Mail::Box
# will always take the `Subject' header for us.
my @subjects = map { chomp; $_ }
map {$_->head->get('subject') || '' }
$folder->messages;
$parsed = 0;
$heads = 0;
foreach ($folder->messages)
{ $parsed++ unless $_->isDelayed;
$heads++ unless $_->head->isDelayed;
}
cmp_ok($parsed, "==", 1); # message 7
cmp_ok($heads, "==", 45);
#
# The subjects must be the same as from the original Mail::Box::Mbox
# There are some differences with new-lines at the end of headerlines
#
my $mbox = Mail::Box::Mbox->new
( folder => $src
, folderdir => 't'
, lock_type => 'NONE'
, access => 'r'
);
my @fsubjects = map { chomp; $_ }
map {$_->head->get('subject') || ''}
$mbox->messages;
my (%subjects);
$subjects{$_}++ foreach @subjects;
$subjects{$_}-- foreach @fsubjects;
my $missed = 0;
foreach (keys %subjects)
{ $missed++ if $subjects{$_};
warn "Still left: $_ ($subjects{$_}x)\n" if $subjects{$_};
}
ok(!$missed);
#
# Check if we can read a body.
#
my $msg3 = $folder->message(3);
my $body = $msg3->body;
ok(defined $body);
cmp_ok(@$body, "==", 42); # check expected number of lines in message 4.
$folder->close;
#
# Now with partially lazy extract.
#
my $parse_size = 5000;
$folder = new Mail::Box::MH
( folder => $mhsrc
, folderdir => 't'
, lock_type => 'NONE'
, extract => $parse_size # messages > $parse_size bytes stay unloaded.
, access => 'rw'
);
ok(defined $folder);
cmp_ok($folder->messages, "==", 45);
$parsed = 0;
$heads = 0;
my $mistake = 0;
foreach ($folder->messages)
{ $parsed++ unless $_->isDelayed;
$heads++ unless $_->head->isDelayed;
$mistake++ if !$_->isDelayed && $_->size > $parse_size;
}
ok(not $mistake);
ok(not $parsed);
ok(not $heads);
foreach (5..13)
{ $folder->message($_)->head->get('subject');
}
$parsed = 0;
$heads = 0;
$mistake = 0;
foreach ($folder->messages)
{ $parsed++ unless $_->isDelayed;
$heads++ unless $_->head->isDelayed;
$mistake++ if !$_->isDelayed && $_->body->size > $parse_size;
}
ok(not $mistake);
cmp_ok($parsed , "==", 7);
cmp_ok($heads , "==", 9);
# No clean-dir: see how it behaves when the folder is not explictly
# closed before the program terminates. Terrible things can happen
# during auto-cleanup
#clean_dir $mhsrc;
Mail-Box-2.118/tests/41mh/70seqs.t 0000644 0001750 0000144 00000003066 12473603434 017110 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
#
# Test mh-sequences
#
use strict;
use warnings;
use lib qw(. .. tests);
use Tools;
use Test::More tests => 11;
use File::Spec;
use Mail::Box::Manager;
my $mhsrc = File::Spec->catfile('folders', 'mh.src');
my $seq = File::Spec->catfile($mhsrc, '.mh_sequences');
clean_dir $mhsrc;
unpack_mbox2mh($src, $mhsrc);
# Create a sequences file.
open SEQ, ">$seq" or die "Cannot write to $seq: $!\n";
# Be warned that message number 13 has been skipped from the MH-box.
print SEQ <<'MH_SEQUENCES';
unseen: 12-15 3 34 36 16
cur: 5
MH_SEQUENCES
close SEQ;
my $mgr = Mail::Box::Manager->new;
my $folder = $mgr->open
( folder => $mhsrc
, folderdir => 't'
, lock_type => 'NONE'
, extract => 'LAZY'
, access => 'rw'
, save_on_exit => 0
);
die "Couldn't read $mhsrc: $!\n" unless $folder;
isa_ok($folder, 'Mail::Box::MH');
ok($folder->message(1)->label('seen'));
ok(not $folder->message(2)->label('seen'));
ok($folder->message(3)->label('seen'));
ok($folder->message(4)->label('current'));
is($folder->current->messageID, $folder->message(4)->messageID);
ok(not $folder->message(1)->label('current'));
$folder->current($folder->message(1));
ok(not $folder->message(0)->label('current'));
ok($folder->message(1)->label('current'));
$folder->modified(1);
$folder->close(write => 'ALWAYS');
open SEQ, $seq or die "Cannot read from $seq: $!\n";
my @seq = ;
close SEQ;
my ($cur) = grep /^cur\: /, @seq;
is($cur, "cur: 2\n");
my ($unseen) = grep /^unseen\: /, @seq;
is($unseen, "unseen: 3 12-15 33 35\n");
clean_dir $mhsrc;
Mail-Box-2.118/tests/41mh/50create.t 0000644 0001750 0000144 00000007363 12473603434 017402 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
#
# Test creation/deletion and listing of folders.
#
use strict;
use warnings;
use lib qw(. .. tests);
use Tools;
use Test::More tests => 20;
use File::Copy;
use File::Spec;
use Mail::Box::Mbox;
use Mail::Box::MH;
use Mail::Message::Construct;
my $top = File::Spec->catfile('folders', 'Mail');
clean_dir $top;
my $mbox = Mail::Box::Mbox->new
( folder => $src
, lock_type => 'NONE'
);
#
# Create a nice structure which looks like a set of MH folders.
#
sub folder($;$@)
{ my $dirname = shift;
$dirname = File::Spec->catfile($dirname, shift) if @_;
die "Cannot create directory $dirname: $!\n"
unless -d $dirname || mkdir $dirname, 0700;
foreach (@_)
{ my $f = File::Spec->catfile($dirname, $_);
open CREATE, ">$f" or die "Cannot create $f: $!\n";
$mbox->message($_)->print(\*CREATE) if m/^\d+$/;
close CREATE;
}
$dirname;
}
folder $top;
folder $top, 'f1', qw/a b c/;
folder $top, 'f2', 1, 2, 3; # only real folder
folder $top, 'f3'; # empty folder
my $sub1 = folder $top, 'sub1';
folder $sub1, 's1f1';
folder $sub1, 's1f2';
folder $sub1, 's1f3';
folder $top, 'sub2'; # empty dir
my $f4 = folder $top, 'f4', 1, 2, 3;
folder $f4, 'f4f1';
unpack_mbox2mh $src, File::Spec->catfile($f4, 'f4f2');
folder $f4, 'f4f3';
ok(compare_lists
[ sort Mail::Box::MH->listSubFolders(folderdir => $top) ]
, [ qw/f1 f2 f3 f4 sub1 sub2/ ]
);
ok(compare_lists
[ sort Mail::Box::MH->listSubFolders(folderdir => $top) ]
, [ qw/f1 f2 f3 f4 sub1 sub2/ ]
);
ok(compare_lists
[ sort Mail::Box::MH->listSubFolders
( folderdir => $top
, skip_empty => 1
) ]
, [ qw/f2 f4 sub1/ ]
);
ok(compare_lists
[ sort Mail::Box::MH->listSubFolders
( folderdir => $top
, check => 1
) ]
, [ qw/f2 f4/ ]
);
ok(compare_lists
[ sort Mail::Box::MH->listSubFolders
( folderdir => $top
, folder => "=f4"
)
]
, [ qw/f4f1 f4f2 f4f3/ ]
);
ok(compare_lists [ sort Mail::Box::MH->listSubFolders(folderdir => "$top/f4") ]
, [ qw/f4f1 f4f2 f4f3/ ]
);
#
# Open a folder in a sub-dir which uses the extention.
#
my $folder = Mail::Box::MH->new
( folderdir => $top
, folder => '=f4/f4f2'
, lock_type => 'NONE'
);
ok($folder);
cmp_ok($folder->messages, "==", 45);
$folder->close;
#
# Open a new folder.
#
my $newfolder = File::Spec->catfile($f4, 'newfolder');
ok(! -d $newfolder);
Mail::Box::MH->create('=f4/newfolder', folderdir => $top);
ok(-d $newfolder);
$folder = Mail::Box::MH->new
( folderdir => $top
, folder => '=f4/newfolder'
, access => 'rw'
, keep_index => 1
, lock_type => 'NONE'
);
ok($folder);
cmp_ok($folder->messages, "==", 0);
my $msg = Mail::Message->build
( From => 'me@example.com'
, To => 'you@anywhere.aq'
, Subject => 'Just a try'
, data => [ "a short message\n", "of two lines.\n" ]
);
$folder->addMessage($msg);
cmp_ok($folder->messages, "==", 1);
$folder->close;
ok(-f File::Spec->catfile($newfolder, '1'));
opendir DIR, $newfolder or die "Cannot read directory $newfolder: $!\n";
my @all = grep !/^\./, readdir DIR;
closedir DIR;
cmp_ok(@all, "==", 1);
my $seq = File::Spec->catfile($newfolder, '.mh_sequences');
open SEQ, $seq or die "Cannot read $seq: $!\n";
my @seq = ;
close SEQ;
cmp_ok(@seq, "==", 1);
is($seq[0],"unseen: 1\n");
#
# Delete a folder.
#
$folder = Mail::Box::MH->new
( folderdir => $top
, folder => '=f4'
, access => 'rw'
, lock_type => 'NONE'
, keep_index => 1
);
ok(-d $f4);
$folder->delete;
ok(1);
$folder->close;
ok(1);
clean_dir $top;
Mail-Box-2.118/tests/54search/ 0000755 0001750 0000144 00000000000 12473604501 016435 5 ustar 00markov users 0000000 0000000 Mail-Box-2.118/tests/54search/Definition.pm 0000644 0001750 0000144 00000000641 12473604425 021071 0 ustar 00markov users 0000000 0000000 # Copyrights 2001-2015 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.01.
package MailBox::Test::54search::Definition;
use vars '$VERSION';
$VERSION = '2.118';
sub name {"Mail::Box::Search; searching folders"}
sub critical {0}
sub skip {undef} # run tests even without Mail::SpamAssassin
1;
Mail-Box-2.118/tests/54search/10grep.t 0000644 0001750 0000144 00000020617 12473603434 017732 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
#
# Test searching with grep
#
use strict;
use warnings;
use lib qw(. .. tests);
use Tools;
use Test::More tests => 58;
use IO::Scalar;
use File::Copy;
use Mail::Box::Manager;
use Mail::Box::Search::Grep;
copy $src, $cpy
or die "Cannot create test folder $cpy: $!\n";
my $mgr = Mail::Box::Manager->new;
my $folder = $mgr->open($cpy, lock_type => 'NONE');
ok(defined $folder, 'open folder');
cmp_ok($folder->messages , "==", 45, 'folder full of messages');
#
# Simple search in body
#
my $output= '';
my $fh = IO::Scalar->new(\$output)
or die "Cannot create an IO::Scalar: $!";
my $oldfh = select $fh;
my $grep1 = Mail::Box::Search::Grep->new
( match => 'However'
, in => 'BODY'
, deliver => 'PRINT'
);
$grep1->search($folder);
$fh->close;
select $oldfh;
$output =~ s#\\#/#g; # windows
is($output, <<'EXPECTED', 'search for However');
folders/mbox.cpy, message 8: Resize with Transparency
21: However, ImageMagick (ImageMagick 4.2.7, PerlMagick 4.27 on Linux)
folders/mbox.cpy, message 38: Re: core dump in simple ImageMagick example
38: However, it is only reproduceable when this statement is included in
folders/mbox.cpy, message 41: Re: core dump in simple ImageMagick example
4: > However, it is only reproduceable when this statement is included in
EXPECTED
undef $grep1;
#
# search in head with limit
#
$output = '';
$fh = IO::Scalar->new(\$output) or die $!;
select $fh;
my $grep2 = Mail::Box::Search::Grep->new
( match => 'atcmpg'
, in => 'HEAD'
, limit => -4
, deliver => 'PRINT'
);
my @m2 = $grep2->search($folder);
$fh->close;
select $oldfh;
cmp_ok(@m2, "==", 4);
my $last = shift @m2;
foreach (@m2)
{ ok($last->seqnr < $_->seqnr, 'messages ordered');
$last = $_;
}
# messages are reversed ordered here, but in order returned: looking
# backwards in the folder file.
$output =~ s#\\#/#g; # windows
is($output, <<'EXPECTED', 'search result atcmp in head');
folders/mbox.cpy, message 44: Font metrics
Received: from ns.ATComputing.nl (ns.ATComputing.nl [195.108.229.25])
by atcmpg.ATComputing.nl (8.9.0/8.9.0) with ESMTP id TAA26427
for ; Wed, 4 Oct 2000 19:56:00 +0200 (MET DST)
folders/mbox.cpy, message 43: Core Dump on ReadImage
Received: from ns.ATComputing.nl (ns.ATComputing.nl [195.108.229.25])
by atcmpg.ATComputing.nl (8.9.0/8.9.0) with ESMTP id WAA14913
for ; Tue, 1 Aug 2000 22:37:13 +0200 (MET DST)
folders/mbox.cpy, message 42: Re: Core Dump on ReadImage
Message-ID: <20000807113844.A22119@atcmpg.ATComputing.nl>
folders/mbox.cpy, message 41: Re: core dump in simple ImageMagick example
Received: from ns.ATComputing.nl (ns.ATComputing.nl [195.108.229.25])
by atcmpg.ATComputing.nl (8.9.0/8.9.0) with ESMTP id NAA29434
for ; Wed, 26 Jul 2000 13:46:33 +0200 (MET DST)
References: <397C6C6B.989E4BB2@catchword.com> <20000726133231.G25170@atcmpg.ATComputing.nl>
EXPECTED
undef $grep2;
#
# Test regexp search
#
my @hits;
my $grep3 = Mail::Box::Search::Grep->new
( match => qr/ImageMagick/
, in => 'MESSAGE'
, deliver => \@hits
);
my @m3 = $grep3->search($folder);
#warn $_.": ".$_->subject, "\n" for @m3;
cmp_ok(@m3, "==", 24, 'messages with ImageMagick');
cmp_ok(@hits, "==", 60, 'hits on ImageMagick');
$last = shift @m3;
my %m3 = ($last->seqnr => 1);
foreach (@m3) # in order?
{ ok($last->seqnr < $_->seqnr, 'messages ordered');
$m3{$_->seqnr}++;
$last = $_;
}
cmp_ok(keys %m3, "==", 24, 'returned message unique');
my %h3 = map { ($_->{message}->seqnr => 1) } @hits;
cmp_ok(keys %h3, "==", 24, 'returned hits in the messages');
undef $grep3;
#
# Test regexp search with case-ignore
#
@hits = ();
my $grep4 = Mail::Box::Search::Grep->new
( match => qr/ImageMagick/i
, in => 'MESSAGE'
, deliver => \@hits
);
my @m4 = $grep4->search($folder);
cmp_ok(@m4, "==", 28, 'messages with /ImageMagick/i');
cmp_ok(@hits, "==", 102, 'hits with /ImageMagick/i');
undef $grep4;
#
# Test regexp search with case-ignore and some deleted messages
#
@hits = ();
$folder->message($_)->delete(1) for 3, 6, 8, 9, 11, 13, 23, 33;
my $grep5 = Mail::Box::Search::Grep->new
( match => qr/ImageMagick/i
, in => 'MESSAGE'
, deliver => \@hits
);
my @m5 = $grep5->search($folder);
cmp_ok(@m5, "==", 22, 'msgs, search excludes deleted');
cmp_ok(@hits, "==", 89, 'hits, search excludes deleted');
undef $grep5;
# Include-deleted
@hits = ();
my $grep6 = Mail::Box::Search::Grep->new
( match => qr/ImageMagick/i
, in => 'MESSAGE'
, deleted => 1
, deliver => \@hits
);
my @m6 = $grep6->search($folder);
cmp_ok(@m6, "==", 28, 'msgs, search includes deleted');
cmp_ok(@hits, "==", 102, 'hits, search includes deleted');
undef $grep6;
# only in header
@hits = ();
my $grep7 = Mail::Box::Search::Grep->new
( match => qr/ImageMagick/i
, in => 'HEAD'
, deliver => \@hits
);
my @m7 = $grep7->search($folder);
cmp_ok(@m7, "==", 11, 'msgs, /ImageMagick/i in head');
cmp_ok(@hits, "==", 27, 'hits, /ImageMagick/i in head');
undef $grep7;
# only in body
@hits = ();
my $grep8 = Mail::Box::Search::Grep->new
( match => qr/ImageMagick/i
, in => 'BODY'
, deliver => \@hits
);
my @m8 = $grep8->search($folder);
cmp_ok(@m8, "==", 20, 'msgs, /ImageMagick/i in body');
cmp_ok(@hits, "==", 62, 'hits, /ImageMagick/i in body');
cmp_ok($grep8->search($folder), "==", 20, 'search returns msgs in scalar');
undef $grep8;
# only test for match: stops at first hit
my $grep9 = Mail::Box::Search::Grep->new
( match => qr/ImageMagick/i
, in => 'BODY'
);
cmp_ok($grep9->search($folder), "==", 1, 'no deliver, then only find one');
undef $grep9;
#
# Search in thread
#
undef $output;
$fh = IO::Scalar->new(\$output) or die $!;
select $fh;
my $grep10 = Mail::Box::Search::Grep->new
( match => 'ImageMagick'
, in => 'BODY'
, deliver => 'PRINT'
);
my $t = $mgr->threads($folder);
my $start = $t->threadStart($folder->message(25)); #isa multipart
my @msgs = $start->threadMessages;
cmp_ok(@msgs, "==", 2, 'messages in thread');
ok($grep10->search($start), 'found in thread');
$output =~ s#\\#/#g; # windows
is($output, <<'EXPECTED', 'result search in thread');
folders/mbox.cpy, message 26: Re: your mail
13: Are you using ImageMagick 5.2.0? When I used the script I sent the
folders/mbox.cpy, message 25: Re: your mail
p 19: > Are you using ImageMagick 5.2.0? When I used the script I sent the
EXPECTED
my @m10 = $grep10->search(\@msgs);
cmp_ok(@m10, "==", 2, 'messages found in list');
cmp_ok($m10[0], "==", $msgs[0]);
cmp_ok($m10[1], "==", $msgs[1]);
$fh->close;
select $oldfh;
undef $grep10;
# Without multipart
undef $output;
$fh = IO::Scalar->new(\$output) or die $!;
select $fh;
my $grep11 = Mail::Box::Search::Grep->new
( match => 'ImageMagick'
, in => 'BODY'
, deliver => 'PRINT'
, multiparts => 0
);
my @m11 = $grep11->search($start);
cmp_ok(@m11, "==", 1, 'do not search multiparts');
$fh->close;
select $oldfh;
$output =~ s#\\#/#g; # windows
is($output, <<'EXPECTED', 'not in multipart');
folders/mbox.cpy, message 26: Re: your mail
13: Are you using ImageMagick 5.2.0? When I used the script I sent the
EXPECTED
undef $grep11;
#
# Check search in encoded part
#
my $msg = $folder->messageId('8172.960997992@mystic');
ok($msg);
undef $output;
$fh = IO::Scalar->new(\$output) or die $!;
select $fh;
my $grep12 = Mail::Box::Search::Grep->new
( match => 'pointsize'
, in => 'MESSAGE'
, binaries => 1
, deliver => 'PRINT'
);
my @m12 = $grep12->search($msg);
cmp_ok(@m12, "==", 1, 'search binaries');
$fh->close;
select $oldfh;
$output =~ s#\\#/#g; # windows
is($output, <<'EXPECTED', 'found in encoded text');
folders/mbox.cpy, message 20:
p 12: , pointsize => $poinsize
EXPECTED
$folder->close(write => 'NEVER');
undef $grep12;
Mail-Box-2.118/tests/02dist/ 0000755 0001750 0000144 00000000000 12473604501 016124 5 ustar 00markov users 0000000 0000000 Mail-Box-2.118/tests/02dist/Definition.pm 0000644 0001750 0000144 00000000576 12473604425 020567 0 ustar 00markov users 0000000 0000000 # Copyrights 2001-2015 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.01.
package MailBox::Test::02dist::Definition;
use vars '$VERSION';
$VERSION = '2.118';
sub name {"check distribution"}
sub critical {0} # currently only man-pages
sub skip { undef }
1;
Mail-Box-2.118/tests/02dist/10pod.t 0000644 0001750 0000144 00000000630 12473603434 017237 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
use warnings;
use strict;
use Test::More;
use File::Spec::Functions qw/updir catdir/;
BEGIN
{ eval "use Test::Pod 1.00";
plan skip_all => "Test::Pod 1.00 required for testing POD"
if $@;
plan skip_all => "devel home uses OODoc"
if qx(/bin/pwd) =~ m[^/home/markov/];
}
my @dirs = map catdir(updir, $_), qw(lib script);
all_pod_files_ok all_pod_files @dirs;
Mail-Box-2.118/tests/20pparser/ 0000755 0001750 0000144 00000000000 12473604501 016635 5 ustar 00markov users 0000000 0000000 Mail-Box-2.118/tests/20pparser/50nested.t 0000644 0001750 0000144 00000004500 12473603434 020454 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
#
# Test processing a message/rfc822
#
use strict;
use warnings;
use lib qw(. .. tests);
use Tools;
use Test::More tests => 2;
use IO::Scalar;
use Mail::Message;
#
# 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-Box-2.118/tests/20pparser/Definition.pm 0000644 0001750 0000144 00000000576 12473604425 021300 0 ustar 00markov users 0000000 0000000 # Copyrights 2001-2015 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.01.
package MailBox::Test::20pparser::Definition;
use vars '$VERSION';
$VERSION = '2.118';
sub name {"Mail::Box::Parser::Perl; parser in pure perl"}
sub critical {1}
sub skip { undef }
1;
Mail-Box-2.118/tests/20pparser/40readmp.t 0000644 0001750 0000144 00000005562 12473603434 020452 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
#
# Test the reading from file of message bodies which are multiparts
#
use strict;
use warnings;
use lib qw(. .. tests);
use Tools;
use Test::More tests => 66;
use IO::File;
use Mail::Message;
#
# 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-Box-2.118/tests/20pparser/33bodyf.t 0000644 0001750 0000144 00000013307 12473603434 020303 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
#
# Test the reading from file of message bodies which have their content
# stored in external files as long as the folder is open.
use strict;
use warnings;
use lib qw(. .. tests);
use Tools;
use Test::More tests => 945;
use Mail::Box::Parser::Perl;
use Mail::Message::Body::File;
use Mail::Message::Head;
# MO: I do not know whether there is an other way to get this to work
# on Windows without error messages.
my $trusted = $Mail::Message::crlf_platform;
###
### First carefully read the first message
###
my $parser = Mail::Box::Parser::Perl->new(filename => $src, trusted =>$trusted);
ok(defined $parser, "creation of parser");
$parser->pushSeparator('From ');
my ($where, $sep) = $parser->readSeparator;
cmp_ok($where, "==", 0, "begin at file-start");
ok(defined $sep, "reading first separator");
like($sep, qr/^From /, "correctness first separator")
if defined $sep;
my $head = Mail::Message::Head->new;
ok(defined $head);
$head->read($parser);
ok(defined $head);
ok($head, "overloaded boolean");
my $hard_coded_lines_msg0 = 33;
my $hard_coded_length_msg0 = 1280;
my $binary_size = $hard_coded_length_msg0
+ ($crlf_platform ? $hard_coded_lines_msg0 : 0);
my $length = int $head->get('Content-Length');
cmp_ok($length, "==", $binary_size, "first message size");
my $lines = int $head->get('Lines');
cmp_ok($lines, "==", $hard_coded_lines_msg0, "first message lines");
my $body = Mail::Message::Body::File->new;
$body->read($parser, $head, undef, $length, $lines);
ok(defined $body, "reading of first body");
cmp_ok($body->size, "==", $hard_coded_length_msg0, "size of body");
my @lines = $body->lines;
cmp_ok(@lines, "==", $lines, "lines of body");
#
# Try to read the rest of the folder, with specified content-length
# and lines if available.
#
my @msgs;
push @msgs, # first message already read.
{ fields => scalar $head->names
, lines => $hard_coded_lines_msg0
, size => $hard_coded_length_msg0
, sep => $sep
, subject=> $head->get('subject')
};
while(1)
{ my ($where, $sep) = $parser->readSeparator;
last unless $sep;
my $count = @msgs;
like($sep, qr/^From /, "1 from $count");
$head = Mail::Message::Head->new;
ok(defined $head, "1 head count");
$head->read($parser);
my $cl = int $head->get('Content-Length');
my $li = int $head->get('Lines');
my $su = $head->get('Subject');
$body = Mail::Message::Body::File->new
->read($parser, $head, undef, $cl, $li);
ok(defined $body, "1 body $count");
my $size = $body->size;
my $lines = $body->nrLines;
cmp_ok($li , "==", $lines, "1 lines $count")
if defined $li;
$cl -= $li if $crlf_platform;
cmp_ok($cl , "==", $size, "1 size $count")
if defined $cl;
my $msg =
{ size => $size
, lines => $lines
, fields => scalar $head->names
, sep => $sep
, subject=> $su
};
push @msgs, $msg;
}
cmp_ok(@msgs, "==", 45);
$parser->stop;
###
### Now read the whole folder again, but without help of content-length
### and nor lines.
###
undef $parser;
$parser = Mail::Box::Parser::Perl->new(filename => $src, trusted => $trusted);
$parser->pushSeparator('From ');
my $count = 0;
while($sep = $parser->readSeparator)
{ my $msg = $msgs[$count];
like($sep, qr/^From /, "2 from $count");
$head = Mail::Message::Head->new->read($parser);
ok(defined $head, "2 head $count");
$body = Mail::Message::Body::File->new->read($parser, $head, undef);
ok(defined $body, "2 body $count");
my $su = $head->get('Subject');
my $size = $body->size;
my $lines = $body->nrLines;
cmp_ok($size, "==", $msg->{size}, "2 size $count");
cmp_ok($lines, "==", $msg->{lines}, "2 lines $count");
is($su, $msg->{subject}, "2 subject $count")
if defined $su && defined $msg->{subject};
cmp_ok($head->names , "==", $msg->{fields}, "2 names $count");
is($sep, $msg->{sep}, "2 sep $count");
$count++;
}
$parser->stop;
###
### Now read the whole folder again, but with deceiving values for
### content-length and lines
###
undef $parser;
$parser = Mail::Box::Parser::Perl->new(filename => $src, trusted => $trusted);
$parser->pushSeparator('From ');
$count = 0;
while(1)
{ my ($where, $sep) = $parser->readSeparator;
last unless $sep;
my $msg = $msgs[$count];
like($sep, qr/^From /, "3 From $count");
$head = Mail::Message::Head->new->read($parser);
ok(defined $head, "3 Head $count");
$body = Mail::Message::Body::File->new;
$body->read($parser, $head, undef, $msg->{size}-15, $msg->{lines}-3);
ok(defined $body, "3 Body $count");
my $su = $head->get('Subject');
my $size = $body->size;
my $lines = $body->nrLines;
# two messages contain one trailing blank, which is removed because
# of the wrong number of lines. The will have an extra OK.
my $wrong = $count==14 || $count==18;
cmp_ok($size, '==', $msg->{size}, "3 size $count")
unless $wrong;
cmp_ok($lines, '==', $msg->{lines}, "3 lines $count")
unless $wrong;
is($su, $msg->{subject}, "3 subject $count")
if defined $su && defined $msg->{subject};
cmp_ok($head->names, '==', $msg->{fields}, "3 name $count");
is($sep, $msg->{sep}, "3 sep $count");
$count++;
}
Mail-Box-2.118/tests/20pparser/31bodyl.t 0000644 0001750 0000144 00000012766 12473603434 020317 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
#
# Test the reading from file of message bodies which have their content
# stored in a an array of lines.
use strict;
use warnings;
use lib qw(. .. tests);
use Tools;
use Test::More tests => 945;
use Mail::Box::Parser::Perl;
use Mail::Message::Body::Lines;
use Mail::Message::Head;
###
### First carefully read the first message
###
my $parser = Mail::Box::Parser::Perl->new(filename => $src);
ok(defined $parser, "creation of parser");
$parser->pushSeparator('From ');
my ($where, $sep) = $parser->readSeparator;
cmp_ok($where, "==", 0, "begin at file-start");
ok(defined $sep, "reading first separator");
like($sep, qr/^From /, "correctness first separator")
if defined $sep;
my $head = Mail::Message::Head->new;
ok(defined $head);
$head->read($parser);
ok(defined $head);
ok($head, "overloaded boolean");
my $hard_coded_lines_msg0 = 33;
my $hard_coded_length_msg0 = 1280;
my $binary_size = $hard_coded_length_msg0
+ ($crlf_platform ? $hard_coded_lines_msg0 : 0);
my $length = int $head->get('Content-Length');
cmp_ok($length, "==", $binary_size, "first message size");
my $lines = int $head->get('Lines');
cmp_ok($lines, "==", $hard_coded_lines_msg0, "first message lines");
my $body = Mail::Message::Body::Lines->new;
$body->read($parser, $head, undef, $length, $lines);
ok(defined $body, "reading of first body");
my @lines = $body->lines;
$length -= @lines if $crlf_platform;
cmp_ok($body->size, "==", $length, "size of body");
cmp_ok(@lines, "==", $lines, "lines of body");
#
# Try to read the rest of the folder, with specified content-length
# and lines if available.
#
my @msgs;
push @msgs, # first message already read.
{ fields => scalar $head->names
, lines => $hard_coded_lines_msg0
, size => $hard_coded_length_msg0
, sep => $sep
, subject=> $head->get('subject')
};
while(1)
{ my ($where, $sep) = $parser->readSeparator;
last unless $sep;
my $count = @msgs;
like($sep, qr/^From /, "1 from $count");
$head = Mail::Message::Head->new;
ok(defined $head, "1 head count");
$head->read($parser);
my $cl = int $head->get('Content-Length');
my $li = int $head->get('Lines');
my $su = $head->get('Subject');
$body = Mail::Message::Body::Lines->new
->read($parser, $head, undef, $cl, $li);
ok(defined $body, "1 body $count");
my $size = $body->size;
my $lines = $body->nrLines;
cmp_ok($li , "==", $lines, "1 lines $count")
if defined $li;
$cl -= $li if $crlf_platform;
cmp_ok($cl , "==", $size, "1 size $count")
if defined $cl;
my $msg =
{ size => $size
, lines => $lines
, fields => scalar $head->names
, sep => $sep
, subject=> $su
};
push @msgs, $msg;
}
cmp_ok(@msgs, "==", 45);
$parser->stop;
###
### Now read the whole folder again, but without help of content-length
### and nor lines.
###
undef $parser;
$parser = Mail::Box::Parser::Perl->new(filename => $src);
$parser->pushSeparator('From ');
my $count = 0;
while($sep = $parser->readSeparator)
{ my $msg = $msgs[$count];
like($sep, qr/^From /, "2 from $count");
$head = Mail::Message::Head->new->read($parser);
ok(defined $head, "2 head $count");
$body = Mail::Message::Body::Lines->new->read($parser, $head, undef);
ok(defined $body, "2 body $count");
my $su = $head->get('Subject');
my $size = $body->size;
my $lines = $body->nrLines;
cmp_ok($size, "==", $msg->{size}, "2 size $count");
cmp_ok($lines, "==", $msg->{lines}, "2 lines $count");
is($su, $msg->{subject}, "2 subject $count")
if defined $su && defined $msg->{subject};
cmp_ok($head->names , "==", $msg->{fields}, "2 names $count");
is($sep, $msg->{sep}, "2 sep $count");
$count++;
}
$parser->stop;
###
### Now read the whole folder again, but with deceiving values for
### content-length and lines
###
undef $parser;
$parser = Mail::Box::Parser::Perl->new(filename => $src);
$parser->pushSeparator('From ');
$count = 0;
while(1)
{ my ($where, $sep) = $parser->readSeparator;
last unless $sep;
my $msg = $msgs[$count];
like($sep, qr/^From /, "3 From $count");
$head = Mail::Message::Head->new->read($parser);
ok(defined $head, "3 Head $count");
$body = Mail::Message::Body::Lines->new;
$body->read($parser, $head, undef, $msg->{size}-15, $msg->{lines}-3);
ok(defined $body, "3 Body $count");
my $su = $head->get('Subject');
my $size = $body->size;
my $lines = $body->nrLines;
# two messages contain one trailing blank, which is removed because
# of the wrong number of lines. The will have an extra OK.
my $wrong = $count==14 || $count==18;
cmp_ok($size, '==', $msg->{size}, "3 size $count")
unless $wrong;
cmp_ok($lines, '==', $msg->{lines}, "3 lines $count")
unless $wrong;
is($su, $msg->{subject}, "3 subject $count")
if defined $su && defined $msg->{subject};
cmp_ok($head->names, '==', $msg->{fields}, "3 name $count");
is($sep, $msg->{sep}, "3 sep $count");
$count++;
}
Mail-Box-2.118/tests/20pparser/34bodymp.t 0000644 0001750 0000144 00000011747 12473603434 020501 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
#
# Test the reading from file of message bodies which are multiparts
#
use strict;
use warnings;
use lib qw(. .. tests);
use Tools;
use Test::More tests => 313;
use Mail::Box::Parser::Perl;
use Mail::Message::Body::Lines;
use Mail::Message::Body::Multipart;
use Mail::Message::Head;
my $getbodytype = sub {'Mail::Message::Body::Lines'};
###
### First pass through all messages, with correct data, if available
###
my $parser = Mail::Box::Parser::Perl->new(filename => $src);
ok(defined $parser, "creation of parser");
$parser->pushSeparator('From ');
my (@msgs, $msgnr);
while(1)
{ my (undef, $sep) = $parser->readSeparator;
last unless $sep;
$msgnr++;
my $count = @msgs;
like($sep, qr/^From /, "1 from $count");
my $head = Mail::Message::Head->new;
ok(defined $head, "1 head count");
$head->read($parser);
my $cl = int $head->get('Content-Length');
my $li = int $head->get('Lines');
unless($head->isMultipart)
{ # Skip non-multipart
Mail::Message::Body::Lines->new->read($parser, $head, undef, $cl, $li);
next;
}
my $message;
my $body = Mail::Message::Body::Multipart->new(message => \$message);
my $mp = $head->get('Content-Type')->comment;
if($mp =~ m/['"](.*?)["']/)
{ $body->boundary($1);
}
$body->read($parser, $head, $getbodytype, $cl, $li);
ok(defined $body, "1 body $count");
my $size = $body->size;
my $lines = $body->nrLines;
my $su = $head->get('Subject');
cmp_ok($lines, "==", $li, "1 lines $count")
if defined $li;
$cl -= $li if $crlf_platform;
cmp_ok($size , "==", $cl, "1 size $count")
if defined $cl;
my $msg =
{ size => $size
, lines => $lines
, fields => scalar $head->names
, sep => $sep
, subject=> $su
};
push @msgs, $msg;
}
cmp_ok(@msgs, "==", 3);
$parser->stop;
###
### Now read the whole folder again, but without help of content-length
### and nor lines.
###
undef $parser;
$parser = Mail::Box::Parser::Perl->new(filename => $src);
$parser->pushSeparator('From ');
my $count = 0;
while(1)
{ my (undef, $sep) = $parser->readSeparator;
last unless $sep;
like($sep, qr/^From /, "2 from $count");
my $head = Mail::Message::Head->new->read($parser);
ok(defined $head, "2 head $count");
unless($head->isMultipart)
{ # Skip non-multipart
Mail::Message::Body::Lines->new->read($parser, $head, undef);
next;
}
my $msg = $msgs[$count];
my $message;
my $body = Mail::Message::Body::Multipart->new(message => \$message);
ok(defined $body, "2 body $count");
my $mp = $head->get('Content-Type')->comment;
if($mp =~ m/['"](.*?)["']/)
{ $body->boundary($1);
}
$body->read($parser, $head, $getbodytype);
my $su = $head->get('Subject');
my $size = $body->size;
my $lines = $body->nrLines;
cmp_ok($size, "==", $msg->{size}, "2 size $count");
cmp_ok($lines, "==", $msg->{lines}, "2 lines $count");
is($su, $msg->{subject}, "2 subject $count")
if defined $su && defined $msg->{subject};
cmp_ok($head->names , "==", $msg->{fields}, "2 names $count");
is($sep, $msg->{sep}, "2 sep $count");
$count++;
}
$parser->stop;
###
### Now read the whole folder again, but with deceiving values for
### content-length and lines
###
undef $parser;
$parser = Mail::Box::Parser::Perl->new(filename => $src);
$parser->pushSeparator('From ');
$count = 0;
while(1)
{ my (undef, $sep) = $parser->readSeparator;
last unless $sep;
like($sep, qr/^From /, "3 From $count");
my $head = Mail::Message::Head->new->read($parser);
ok(defined $head, "3 Head $count");
unless($head->isMultipart)
{ # Skip non-multipart
Mail::Message::Body::Lines->new->read($parser, $head, undef);
next;
}
my $msg = $msgs[$count];
my $message;
my $body = Mail::Message::Body::Multipart->new(message => \$message);
ok(defined $body, "3 Body $count");
my $mp = $head->get('Content-Type')->comment;
if($mp =~ m/['"](.*?)["']/)
{ $body->boundary($1);
}
$body->read($parser, $head, $getbodytype, $msg->{size}-15, $msg->{lines}-3);
my $su = $head->get('Subject');
my $size = $body->size;
my $lines = $body->nrLines;
cmp_ok($size, '==', $msg->{size}, "3 size $count");
cmp_ok($lines, '==', $msg->{lines}, "3 lines $count");
is($su, $msg->{subject}, "3 subject $count")
if defined $su && defined $msg->{subject};
cmp_ok($head->names, '==', $msg->{fields}, "3 name $count");
is($sep, $msg->{sep}, "3 sep $count");
$count++;
}
Mail-Box-2.118/tests/20pparser/10field.t 0000644 0001750 0000144 00000003114 12473603434 020251 0 ustar 00markov users 0000000 0000000 #!/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 lib qw(. .. tests);
use Tools;
use Test::More tests => 15;
use Mail::Message::Field;
use Mail::Box::Parser::Perl;
# 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-Box-2.118/tests/20pparser/30bodys.t 0000644 0001750 0000144 00000013015 12473603434 020311 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
#
# Test the reading from file of message bodies which have their content
# stored in a single string.
use strict;
use warnings;
use lib qw(. .. tests);
use Tools;
use Test::More tests => 945;
use Mail::Box::Parser::Perl;
use Mail::Message::Body::String;
use Mail::Message::Head;
###
### First carefully read the first message
###
my $parser = Mail::Box::Parser::Perl->new(filename => $src);
ok(defined $parser, "creation of parser");
exit 1 unless defined $parser;
$parser->pushSeparator('From ');
my ($where, $sep) = $parser->readSeparator;
cmp_ok($where, "==", 0, "begin at file-start");
ok(defined $sep, "reading first separator");
like($sep, qr/^From /, "correctness first separator")
if defined $sep;
my $head = Mail::Message::Head->new;
ok(defined $head);
$head->read($parser);
ok(defined $head);
ok($head, "overloaded boolean");
my $hard_coded_lines_msg0 = 33;
my $hard_coded_length_msg0 = 1280;
my $binary_size = $hard_coded_length_msg0
+ ($crlf_platform ? $hard_coded_lines_msg0 : 0);
my $length = int $head->get('Content-Length');
cmp_ok($length, "==", $binary_size, "first message size");
my $lines = int $head->get('Lines');
cmp_ok($lines, "==", $hard_coded_lines_msg0, "first message lines");
my $body = Mail::Message::Body::String->new;
$body->read($parser, $head, undef, $length, $lines);
ok(defined $body, "reading of first body");
my @lines = $body->lines;
$length -= @lines if $crlf_platform;
cmp_ok($body->size, "==", $length, "size of body");
cmp_ok(@lines, "==", $lines, "lines of body");
#
# Try to read the rest of the folder, with specified content-length
# and lines if available.
#
my @msgs;
push @msgs, # first message already read.
{ fields => scalar $head->names
, lines => $hard_coded_lines_msg0
, size => $hard_coded_length_msg0
, sep => $sep
, subject=> $head->get('subject')
};
while(1)
{ my ($where, $sep) = $parser->readSeparator;
last unless $sep;
my $count = @msgs;
like($sep, qr/^From /, "1 from $count");
$head = Mail::Message::Head->new;
ok(defined $head, "1 head $count");
$head->read($parser);
my $cl = int $head->get('Content-Length');
my $li = int $head->get('Lines');
my $su = $head->get('Subject');
$body = Mail::Message::Body::String->new
->read($parser, $head, undef, $cl, $li);
ok(defined $body, "1 body $count");
my $size = $body->size;
my $lines = $body->nrLines;
cmp_ok($li , "==", $lines, "1 lines $count")
if defined $li;
$cl -= $li if $crlf_platform;
cmp_ok($cl , "==", $size, "1 size $count")
if defined $cl;
my $msg =
{ size => $size
, lines => $lines
, fields => scalar $head->names
, sep => $sep
, subject=> $su
};
push @msgs, $msg;
}
cmp_ok(@msgs, "==", 45);
$parser->stop;
###
### Now read the whole folder again, but without help of content-length
### and nor lines.
###
undef $parser;
$parser = Mail::Box::Parser::Perl->new(filename => $src);
$parser->pushSeparator('From ');
my $count = 0;
while($sep = $parser->readSeparator)
{ my $msg = $msgs[$count];
like($sep, qr/^From /, "2 from $count");
$head = Mail::Message::Head->new->read($parser);
ok(defined $head, "2 head $count");
$body = Mail::Message::Body::String->new->read($parser, $head, undef);
ok(defined $body, "2 body $count");
my $su = $head->get('Subject');
my $size = $body->size;
my $lines = $body->nrLines;
cmp_ok($size, "==", $msg->{size}, "2 size $count");
cmp_ok($lines, "==", $msg->{lines}, "2 lines $count");
is($su, $msg->{subject}, "2 subject $count")
if defined $su && defined $msg->{subject};
cmp_ok($head->names , "==", $msg->{fields}, "2 names $count");
is($sep, $msg->{sep}, "2 sep $count");
$count++;
}
$parser->stop;
###
### Now read the whole folder again, but with deceiving values for
### content-length and lines
###
undef $parser;
$parser = Mail::Box::Parser::Perl->new(filename => $src);
$parser->pushSeparator('From ');
$count = 0;
while(1)
{ my ($where, $sep) = $parser->readSeparator;
last unless $sep;
my $msg = $msgs[$count];
like($sep, qr/^From /, "3 From $count");
$head = Mail::Message::Head->new->read($parser);
ok(defined $head, "3 Head $count");
$body = Mail::Message::Body::String->new;
$body->read($parser, $head, undef, $msg->{size}-15, $msg->{lines}-3);
ok(defined $body, "3 Body $count");
my $su = $head->get('Subject');
my $size = $body->size;
my $lines = $body->nrLines;
# two messages contain one trailing blank, which is removed because
# of the wrong number of lines. The will have an extra OK.
my $wrong = $count==14 || $count==18;
cmp_ok($size, '==', $msg->{size}, "3 size $count")
unless $wrong;
cmp_ok($lines, '==', $msg->{lines}, "3 lines $count")
unless $wrong;
is($su, $msg->{subject}, "3 subject $count")
if defined $su && defined $msg->{subject};
cmp_ok($head->names, '==', $msg->{fields}, "3 name $count");
is($sep, $msg->{sep}, "3 sep $count");
$count++;
}
Mail-Box-2.118/tests/20pparser/32bodyd.t 0000644 0001750 0000144 00000012775 12473603434 020310 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
#
# Test the reading from file of message bodies which have their content
# stored in a single string.
use strict;
use warnings;
use lib qw(. .. tests);
use Tools;
use Test::More tests => 855;
use Mail::Box::Parser::Perl;
use Mail::Message::Body::Delayed;
use Mail::Message::Head;
###
### First carefully read the first message
###
my $parser = Mail::Box::Parser::Perl->new(filename => $src);
ok(defined $parser, "creation of parser");
$parser->pushSeparator('From ');
my ($where, $sep) = $parser->readSeparator;
cmp_ok($where, "==", 0, "begin at file-start");
ok(defined $sep, "reading first separator");
like($sep, qr/^From /, "correctness first separator")
if defined $sep;
my $head = Mail::Message::Head->new;
ok(defined $head);
$head->read($parser);
ok(defined $head);
ok($head, "overloaded boolean");
my $hard_coded_lines_msg0 = 33;
my $hard_coded_length_msg0 = 1280;
my $binary_size = $hard_coded_length_msg0
+ ($crlf_platform ? $hard_coded_lines_msg0 : 0);
my $length = int $head->get('Content-Length');
cmp_ok($length, "==", $binary_size, "first message size");
my $lines = int $head->get('Lines');
cmp_ok($lines, "==", $hard_coded_lines_msg0, "first message lines");
my $message; # dummy message, because all delayed objects must have one.
my $body = Mail::Message::Body::Delayed->new(message => \$message);
$body->read($parser, $head, undef, $length, $lines);
ok(defined $body, "reading of first body");
cmp_ok($body->guessSize, "==", $length, "guessed size of body");
#
# Try to read the rest of the folder, with specified content-length
# and lines if available.
#
my @msgs;
push @msgs, # first message already read.
{ fields => scalar $head->names
, lines => $hard_coded_lines_msg0
, size => $hard_coded_length_msg0
, sep => $sep
, subject=> $head->get('subject')
};
while(1)
{ my ($where, $sep) = $parser->readSeparator;
last unless $sep;
my $count = @msgs;
like($sep, qr/^From /, "1 from $count");
$head = Mail::Message::Head->new;
ok(defined $head, "1 head count");
$head->read($parser);
my $cl = int $head->get('Content-Length');
my $li = int $head->get('Lines');
my $su = $head->get('Subject');
$body = Mail::Message::Body::Delayed->new(message => \$message)
->read($parser, $head, undef, $cl, $li);
ok(defined $body, "1 body $count");
my $size = $body->guessSize;
cmp_ok($cl , "==", $size, "1 size $count")
if defined $cl;
my $msg =
{ size => $size
, fields => scalar $head->names
, sep => $sep
, subject=> $su
};
push @msgs, $msg;
}
cmp_ok(@msgs, "==", 45);
$parser->stop;
###
### Now read the whole folder again, but without help of content-length
### and nor lines.
###
undef $parser;
$parser = Mail::Box::Parser::Perl->new(filename => $src);
$parser->pushSeparator('From ');
my $count = 0;
while($sep = $parser->readSeparator)
{ my $msg = $msgs[$count];
like($sep, qr/^From /, "2 from $count");
$head = Mail::Message::Head->new->read($parser);
ok(defined $head, "2 head $count");
$body = Mail::Message::Body::Delayed->new(message => \$message)
->read($parser, $head, undef);
ok(defined $body, "2 body $count");
my $su = $head->get('Subject');
my $size = $body->guessSize;
my $lines = $msg->{lines} = $body->nrLines;
if($crlf_platform)
{ ok(1); # too complicated to test
}
else
{ cmp_ok($size, "==", $msg->{size}, "2 size $count");
}
is($su, $msg->{subject}, "2 subject $count")
if defined $su && defined $msg->{subject};
cmp_ok($head->names , "==", $msg->{fields}, "2 names $count");
is($sep, $msg->{sep}, "2 sep $count");
$count++;
}
$parser->stop;
###
### Now read the whole folder again, but with deceiving values for
### content-length and lines
###
undef $parser;
$parser = Mail::Box::Parser::Perl->new(filename => $src);
$parser->pushSeparator('From ');
$count = 0;
while(1)
{ my ($where, $sep) = $parser->readSeparator;
last unless $sep;
my $msg = $msgs[$count];
like($sep, qr/^From /, "3 From $count");
$head = Mail::Message::Head->new->read($parser);
ok(defined $head, "3 Head $count");
$body = Mail::Message::Body::Delayed->new(message => \$message);
$body->read($parser, $head, undef, $msg->{size}-15, $msg->{lines}-3);
ok(defined $body, "3 Body $count");
my $su = $head->get('Subject');
my $size = $body->guessSize;
my $lines = $body->nrLines;
# two messages contain one trailing blank, which is removed because
# of the wrong number of lines. The will have an extra OK.
my $wrong = $count==14 || $count==18;
if($wrong) { ; }
elsif($crlf_platform) { ok(1) } # too hard to test
else { cmp_ok($size, '==', $msg->{size}, "3 size $count") }
cmp_ok($lines, '==', $msg->{lines}, "3 lines $count")
unless $wrong;
is($su, $msg->{subject}, "3 subject $count")
if defined $su && defined $msg->{subject};
cmp_ok($head->names, '==', $msg->{fields}, "3 name $count");
is($sep, $msg->{sep}, "3 sep $count");
$count++;
}
Mail-Box-2.118/tests/20pparser/20head.t 0000644 0001750 0000144 00000003176 12473603434 020100 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
#
# Test the processing of a message header, in this case purely the reading
# from a file.
#
use strict;
use warnings;
use lib qw(. .. tests);
use Tools;
use Test::More tests => 16;
use Mail::Message;
use Mail::Message::Head;
use Mail::Box::Parser::Perl;
my $h = Mail::Message::Head->new;
ok(defined $h);
my $parser = Mail::Box::Parser::Perl->new(filename => $src);
ok($parser);
my $head = Mail::Message::Head->new;
ok(defined $head);
ok(! $head); # no lines yet
$parser->pushSeparator('From ');
my ($where, $sep) = $parser->readSeparator;
ok($sep);
cmp_ok($where, "==", 0);
like($sep , qr/^From mag.*2000$/);
$head->read($parser);
ok($head); # now has lines
cmp_ok($head->names, "==", 20);
is($head->get('subject'), 'Re: File Conversion From HTML to PS and TIFF');
my @received = $head->get('received');
cmp_ok(@received, "==", 5);
my $received = $head->get('received'); #last
ok(defined $received);
is($received->name, 'received');
my $recb = "(from majordomo\@localhost)\tby unca-don.wizards.dupont.com (8.9.3/8.9.3) id PAA29389\tfor magick-outgoing";
is($received->body, $recb);
is($received->comment, 'Wed, 9 Feb 2000 15:38:42 -0500 (EST)');
# Check parsing empty fields
# Contributed by Marty Pauley
my $message = <<'EOT';
Date: Mon, 24 Feb 2003 11:07:36 +0000
From: marty@kasei.com
To: marty@kasei.com
Subject: Test Message
Message-ID: <20030224010736.GA32736@phobos.kasei.com>
Mime-Version: 1.0
X-foo:
Content-Type: text/plain
Content-Disposition: inline
This is a test message.
EOT
my $mm = Mail::Message->read($message);
my $foo = $mm->head->get("x-foo")->string;
is($foo, "X-foo: \n", "X-foo ok");
Mail-Box-2.118/tests/01platform/ 0000755 0001750 0000144 00000000000 12473604501 017004 5 ustar 00markov users 0000000 0000000 Mail-Box-2.118/tests/01platform/Definition.pm 0000644 0001750 0000144 00000000561 12473604425 021441 0 ustar 00markov users 0000000 0000000 # Copyrights 2001-2015 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.01.
package MailBox::Test::01platform::Definition;
use vars '$VERSION';
$VERSION = '2.118';
sub name {"platform specific preparations"}
sub critical {1}
sub skip { undef }
1;
Mail-Box-2.118/tests/01platform/10crlf.t 0000644 0001750 0000144 00000002646 12473603434 020274 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
# On Windows, the test mailbox must be have lines which are
# separated by CRLFs. The mbox.src which is supplied is UNIX-style,
# so only has LF line-terminations. In this script, this is
# translated. The Content-Length of the messages is updated too.
use strict;
use warnings;
use lib qw(. .. tests);
use Tools;
use Test::More tests => 1;
use FileHandle;
my $crlf = "\015\012";
open SRC, '<', $unixsrc or die "Cannot open $unixsrc to read: $!\n";
binmode SRC;
open DEST, '>', $winsrc or die "Cannot open $winsrc for writing: $!\n";
select DEST;
binmode DEST;
until(eof SRC)
{
my ($lines, $bytes);
HEADER:
while()
{ s/[\012\015]*$/$crlf/;
if( m/^Content-Length\: / ) {$bytes = $' +0}
elsif( m/^Lines\: / ) {$lines = $' +0}
elsif( m/^\s*$/ )
{ # End of header
if(defined $bytes && defined $lines)
{ $bytes += $lines;
print "Content-Length: $bytes\015\012";
}
print "Lines: $lines$crlf"
if defined $lines;
print $crlf;
last HEADER;
}
else {print}
}
BODY:
while()
{ s/[\012\015]*$/$crlf/;
print;
last BODY if m/^From /;
}
}
die "Errors in reading $unixsrc" unless close SRC;
die "Errors in writing $winsrc" unless close DEST;
pass("Folder conversion complete");
Mail-Box-2.118/tests/14fieldu/ 0000755 0001750 0000144 00000000000 12473604501 016434 5 ustar 00markov users 0000000 0000000 Mail-Box-2.118/tests/14fieldu/Definition.pm 0000644 0001750 0000144 00000001071 12473604425 021066 0 ustar 00markov users 0000000 0000000 # Copyrights 2001-2015 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.01.
package MailBox::Test::14fieldu::Definition;
use vars '$VERSION';
$VERSION = '2.118';
sub name {"Mail::Message::Field::Full; unicode fields"}
sub critical {0}
sub skip
{
return "Requires module Encode, which requires at least Perl 5.7.3"
if $] < 5.007003;
eval "require Encode";
return "Module Encode is not installed or has errors." if $@;
undef;
}
1;
Mail-Box-2.118/tests/14fieldu/40parse.t 0000644 0001750 0000144 00000004227 12473603434 020110 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
#
# Test processing of general parsing of fields
#
use strict;
use warnings;
package Mail::Message::Field::Full; # define package name
package main;
use lib qw(. .. tests);
use Tools;
use Test::More;
BEGIN {
if($] < 5.007003)
{ plan skip_all => "Requires module Encode which requires Perl 5.7.3";
exit 0;
}
eval 'require Mail::Message::Field::Full';
if($@)
{
warn $@;
plan skip_all => 'Extended attributes not available (install Encode?)';
exit 0;
}
else
{ plan 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-Box-2.118/tests/14fieldu/20attr.t 0000644 0001750 0000144 00000014670 12473603434 017751 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
#
# Test processing of field attributes in their most expensive implementation!
#
use strict;
use warnings;
# define package name when loading fails
package Mail::Message::Field::Attribute;
package Mail::Message::Field::Full;
package main;
use lib qw(. .. tests);
use Tools;
use Test::More;
BEGIN {
if($] < 5.007003)
{ plan skip_all => "Requires module Encode which requires Perl 5.7.3";
exit 0;
}
eval 'require Mail::Message::Field::Attribute';
if($@)
{ plan skip_all => 'Extended attributes not available (install Encode?)';
exit 0;
}
else
{ plan tests => 100;
eval 'require Mail::Message::Field::Full';
plan skip_all => $@ if $@;
}
}
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 $h = 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 $h;
isa_ok($h, 'Mail::Message::Field::Structured');
is($h->attribute('filename'), 'Selling #1 (signed) - 11-13.pdf');
Mail-Box-2.118/tests/14fieldu/52uri.t 0000644 0001750 0000144 00000004377 12473603434 017606 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
#
# Test processing of URIs
#
use strict;
use warnings;
package Mail::Message::Field::URIs; # define package name
package main;
use lib qw(. .. tests);
use Tools;
use Test::More;
BEGIN {
if($] < 5.007003)
{ plan skip_all => "Requires module Encode which requires Perl 5.7.3";
exit 0;
}
eval 'require Mail::Message::Field::URIs';
if($@)
{ plan skip_all => 'Extended attributes not available (install Encode?)';
exit 0;
}
else
{ plan tests => 33;
}
}
require Mail::Message::Field::Full;
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-Box-2.118/tests/14fieldu/10full.t 0000644 0001750 0000144 00000015007 12473603434 017733 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
#
# Test processing of full fields, the most complex (and slowest) kind of fields.
#
use strict;
use warnings;
package Mail::Message::Field::Structured; # define package name
package main;
use lib qw(. .. tests);
use Tools;
use utf8;
use Test::More;
BEGIN {
if($] < 5.007003)
{ plan skip_all => "Requires module Encode which requires Perl 5.7.3";
exit 0;
}
eval 'require Mail::Message::Field::Structured';
if($@)
{ plan skip_all => 'Extended attributes not available (install Encode?)';
exit 0;
}
else
{ plan tests => 74;
Encode->import('encode', '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-Box-2.118/tests/14fieldu/50userid.t 0000644 0001750 0000144 00000006237 12473603434 020275 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
#
# Test processing in combination with User::Identity as documented in
# Mail::Message::Field.
#
use strict;
use warnings;
use lib qw(. .. tests);
use Tools;
use Test::More;
use Mail::Message::Field::Fast;
my $mmf = 'Mail::Message::Field::Fast';
BEGIN {
if($] < 5.007003)
{ plan skip_all => "Requires module Encode which requires Perl 5.7.3";
exit 0;
}
eval 'require User::Identity';
if($@)
{
plan skip_all => 'User::Identity failed';
exit 0;
}
else
{ plan tests => 22;
}
}
# 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-Box-2.118/tests/14fieldu/51addr.t 0000644 0001750 0000144 00000020371 12473603434 017710 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
# Test processing of addresses
use strict;
use warnings;
package Mail::Message::Field::Addresses; # define package name
package main;
use lib qw(. .. tests);
use Tools;
use Mail::Message;
use Test::More;
BEGIN {
if($] < 5.007003)
{ plan skip_all => "Requires module Encode which requires Perl 5.7.3";
exit 0;
}
eval "use Encode";
plan skip_all => 'Extended attributes not available (install Encode?)'
if $@;
Encode->import('is_utf8');
eval 'use Mail::Message::Field::Addresses';
plan skip_all => "Mail::Message::Field::Addresses broken: $@"
if $@;
plan tests => 104;
}
# 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-Box-2.118/tests/14fieldu/31struct.t 0000644 0001750 0000144 00000011204 12473603434 020313 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
#
# Test processing of general structured fields
#
use strict;
use warnings;
package Mail::Message::Field::Structured;
package main;
use lib qw(. .. tests);
use Tools;
use Test::More;
BEGIN {
if($] < 5.007003)
{ plan skip_all => "Requires module Encode which requires Perl 5.7.3";
exit 0;
}
eval 'require Mail::Message::Field::Structured';
if($@)
{ plan skip_all => 'Extended attributes not available (install Encode?)';
exit 0;
}
else
{ plan 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-Box-2.118/tests/14fieldu/30unstr.t 0000644 0001750 0000144 00000005004 12473603434 020142 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
#
# Test processing of unstructured fields
#
use strict;
use warnings;
package Mail::Message::Field::Unstructured; # define package name
package main;
use lib qw(. .. tests);
use Tools;
use Test::More;
BEGIN {
if($] < 5.007003)
{ plan skip_all => "Requires module Encode which requires Perl 5.7.3";
exit 0;
}
eval 'require Mail::Message::Field::Unstructured';
if($@)
{ plan skip_all => 'Extended attributes not available (install Encode?)';
exit 0;
}
else
{ plan tests => 30;
}
}
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");
Mail-Box-2.118/tests/14fieldu/12full_ru.t 0000644 0001750 0000144 00000002115 12473603434 020437 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
#
# Test processing of full fields with russian chars in utf-8.
#
use strict;
use warnings;
package Mail::Message::Field::Structured; # define package name
package main;
use lib qw(. .. tests);
use Tools;
use utf8;
use Test::More;
BEGIN {
if($] < 5.007003)
{ plan skip_all => "Requires module Encode which requires Perl 5.7.3";
exit 0;
}
eval 'require Mail::Message::Field::Structured';
if($@)
{ plan skip_all => 'Extended attributes not available (install Encode?)';
exit 0;
}
else { plan 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-Box-2.118/tests/45dbx/ 0000755 0001750 0000144 00000000000 12473604501 015745 5 ustar 00markov users 0000000 0000000 Mail-Box-2.118/tests/45dbx/Definition.pm 0000644 0001750 0000144 00000000754 12473604424 020405 0 ustar 00markov users 0000000 0000000 # Copyrights 2001-2015 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.01.
package MailBox::Test::45dbx::Definition;
use vars '$VERSION';
$VERSION = '2.118';
sub name {"Mail::Box::Dbx; Outlook Express folders"}
sub critical {0}
sub skip
{
eval "require Mail::Transport::Dbx";
return "Mail::Transport::Dbx is not installed or gives errors." if $@;
undef;
}
1;
Mail-Box-2.118/tests/45dbx/10read.t 0000644 0001750 0000144 00000005414 12473603434 017216 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
#
# Test reading of dbx folders.
#
use strict;
use warnings;
use lib qw(. .. tests);
use Tools;
use Test::More;
use File::Compare;
use File::Temp qw(tempdir tempfile);
BEGIN
{
eval { require Mail::Box::Dbx };
if($@ || Mail::Box::Dbx->type ne 'dbx')
{ plan(skip_all => 'Mail::Box::Dbx is not installed');
exit 0;
}
elsif(not (-d '45dbx/testfolders' || -d 'tests/45dbx/testfolders'))
{ plan(skip_all => 'dbx test folders are not distributed');
exit 0;
}
plan tests => 22;
}
my $test = 'MBOX'; # folder to copy to
#my $test = 'MH';
my $temp = 'dbxtest';
sub be_sure_its_clean()
{
if($test eq 'MH') { clean_dir $temp }
else
{ unlink $temp;
clean_dir "$temp.d";
}
}
be_sure_its_clean;
my @src = (folderdir => '45dbx/testfolders');
ok(Mail::Box::Dbx->foundIn('Folder.dbx'), 'check foundIn');
ok(!Mail::Box::Dbx->foundIn('Folder.mbox'), 'check foundIn');
#
# The folder is read.
#
my $folder = Mail::Box::Dbx->new
( @src
, lock_type => 'NONE'
, extract => 'ALWAYS'
);
ok(defined $folder, 'check success open folder');
exit 1 unless defined $folder;
ok(! $folder->isModified);
is($folder->organization, 'FILE', 'folder organization FILE');
cmp_ok($folder->messages , "==", 0, 'found no messages');
my @subf = $folder->listSubFolders;
cmp_ok(@subf, '==', 9493, 'many subfolders');
@subf = $folder->listSubFolders(check => 1);
cmp_ok(@subf, '==', 6, 'few real subfolders');
@subf = $folder->listSubFolders(skip_empty => 1);
cmp_ok(@subf, '==', 5, 'few filled subfolders');
# get a subfolder
my $comp = $folder->openSubFolder('comp.lang.perl.misc');
ok(defined $comp, 'open large subfolder');
cmp_ok($comp->messages, '==', 300, '300 messages!');
my $message = $comp->message(10);
ok($message->head->isDelayed, 'delayed head');
ok($message->body->isDelayed, 'delayed body');
is($message->subject, 'search and replace problem', 'subject');
ok(! $message->head->isDelayed, 'realized head');
ok(! $message->body->isDelayed, 'realized body');
ok(! $folder->isModified);
#$message->print;
my $out;
if($test eq 'MH')
{ require Mail::Box::MH;
$out = Mail::Box::MH->new(folder => $temp, create => 1,
access => 'w');
}
else
{ require Mail::Box::Mbox;
$out = Mail::Box::Mbox->new(folder => $temp, create => 1,
access => 'w', log => 'DEBUG');
}
die "Cannot create temporary folder $temp: $!\n" unless defined $out;
ok($folder->copyTo($out), "Copy succesful");
cmp_ok(scalar $out->messages, '==', scalar $folder->messages);
cmp_ok(scalar $out->messages, '==', 0);
ok(!$folder->isModified);
ok(!$comp->isModified);
$comp->close;
$out->close;
$folder->close;
be_sure_its_clean;
exit 0;
Mail-Box-2.118/tests/13body/ 0000755 0001750 0000144 00000000000 12473604501 016120 5 ustar 00markov users 0000000 0000000 Mail-Box-2.118/tests/13body/Definition.pm 0000644 0001750 0000144 00000000562 12473604424 020555 0 ustar 00markov users 0000000 0000000 # Copyrights 2001-2015 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.01.
package MailBox::Test::13body::Definition;
use vars '$VERSION';
$VERSION = '2.118';
sub name {"Mail::Message::Body; message bodies"}
sub critical {1}
sub skip { undef }
1;
Mail-Box-2.118/tests/13body/30file.t 0000644 0001750 0000144 00000005376 12473603434 017406 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
#
# Test processing of message bodies which have their content stored
# in a file.
#
use strict;
use warnings;
use lib qw(. .. tests);
use Tools;
use Test::More tests => 33;
use IO::Scalar;
use Mail::Message::Body::File;
# 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 $Mail::Message::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 $Mail::Message::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-Box-2.118/tests/13body/10string.t 0000644 0001750 0000144 00000003005 12473603434 017756 0 ustar 00markov users 0000000 0000000 #!/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 lib qw(. .. tests);
use Tools;
use IO::Scalar;
use Test::More tests => 30;
use Mail::Message::Body::String;
# 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-Box-2.118/tests/13body/20lines.t 0000644 0001750 0000144 00000004352 12473603434 017571 0 ustar 00markov users 0000000 0000000 #!/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 lib qw(. .. tests);
use Tools;
use Test::More tests => 30;
use IO::Scalar;
use Mail::Message::Body::Lines;
# 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-Box-2.118/tests/13body/40multip.t 0000644 0001750 0000144 00000012436 12473603434 017775 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
#
# Test processing of multipart message bodies.
#
use strict;
use warnings;
use lib qw(. .. tests);
use Tools;
use Test::More tests => 33;
use IO::Scalar;
use Mail::Message::Body::Lines;
use Mail::Message::Body::Multipart;
use Mail::Message::Head::Complete;
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-Box-2.118/tests/43pop3/ 0000755 0001750 0000144 00000000000 12473604501 016047 5 ustar 00markov users 0000000 0000000 Mail-Box-2.118/tests/43pop3/Definition.pm 0000644 0001750 0000144 00000000554 12473604424 020505 0 ustar 00markov users 0000000 0000000 # Copyrights 2001-2015 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.01.
package MailBox::Test::43pop3::Definition;
use vars '$VERSION';
$VERSION = '2.118';
sub name {"Mail::Box::POP3; pop3 folders"}
sub critical {0}
sub skip { undef }
1;
Mail-Box-2.118/tests/43pop3/server 0000644 0001750 0000144 00000050004 12473603434 017303 0 ustar 00markov users 0000000 0000000 =head1 NAME
t/server/start - simple POP3 server for testing Mail::Transport::POP3
=head1 SYNOPSIS
open( $pop3,"$^X t/server/start t/messages | " );
open( $pop3,"$^X t/server/start t/messages minimal | " );
open( $pop3,"$^X t/server/start t/messages apoponly | " );
open( $pop3,"$^X t/server/start t/messages autodelete | " );
open( $pop3,"$^X t/server/start t/messages noextra | " );
open( $pop3,"$^X t/server/start t/messages standardport | " );
=head1 DESCRIPTION
This POP3 server is created for testing the Mail::Transport::POP3 only. It
B as real POP3 server (yet).
The server takes on a randomly selected, free port to prevent interference
with existing applications. Start the server by running this script from
another script while capturing the output to STDOUT, e.g. like:
open( my $pop3,"$^X t/server/start t/messages |" )
or die "Could not start POP3 server: $!\n";
my $port = <$pop3>;
The returned $pop3 file handle produces informational texts: it will tell
you the port which is occupied by the server, and when the server shuts down.
It will also report some statistics on the performance of the server.
The server will be bound to localhost (127.0.0.1) at the port number of the
first line that is printed to STDOUT by this script.
The first parameter to the script indicates the directory in which the actual
messages (each message as a seperate file) are located. In the example, this
is "t/messages".
Any other parameters to the script are optional: they consist of keywords to
indicate any settings or peculiarities of certain POP3 server implementations.
The following keywords are recognised:
=over 2
=item minimal
If the keyword "minimal" is specified, only the minimal set of POP3 commands
will be allowed (i.e. USER, PASS, STAT, LIST, RETR, DELE, RSET, NOOP and QUIT).
The optional POP3 commands (APOP, TOP and UIDL) are also supported if this
keyword is B specified.
=item apoponly
If the keyword "apoponly" is specified, then authorization will only be
allowed with the APOP command (i.e. authorization with USER will yield a
negative response). Please note that you cannot use this together with the
"minimal" keyword, as APOP is one of the optional POP3 commands (which is
excluded if you use the "minimal" keyword).
=item autodelete
If the keyword "autodelete" is specified, any messages that are completely
retrieved with RETR or TOP (without specification of number of lines in the
body to return) will be automatically marked for deletion. This will cause
those messages to be deleted if the session is finished with a QUIT command.
This coincides with system resource restrictions imposed by some providers.
=item noextra
If the keyword "noextra" is specified, then all messages will be served with
a check for a CRLF pair at the end of the original messasge: if a CRLF is
found, then only ".\r\n" will be added to indicate the end of a message that
are retrieved with RETR or TOP.
=item standardport
If the keyword "standardport" is specified, then an attempt will be made to
start the POP3 server on port 110, the standard POP3 port. Please note that
this will only be successful if the current user has sufficient privileges
(usually only the root user will be allowed to listen on ports < 1024).
=back
User name is always "user" and the correct password is always "password".
Any other combination will always fail. APOP authorization can be used if
the "minimal" keyword is B specified. The following script will help
you in debugging APOP authorization:
use Digest::MD5 qw(md5_hex);
while (<>) {
s#\r?\n?$##s;
print md5_hex( $_.'password' )."\n";
}
Copy the string that was sent by the initial greeting of the server (including
the <> brackets), paste this into the running script, press ENTER. The script
will respond with a 32 character hexadecimal string. Copy that and the enter
the authorization thus:
APOP user 0123456789abcdef0123456789abcdef
Note that the above hex string is only an example of course.
The following commands do B exist in the POP3 protocol, but are intended
to simulate certain events.
The BREAK command can be used to simulate the breaking of a connection.
After a BREAK is received, the connection is broken by the server (without
sending a response to the client). No messages will be deleted even if any
messages were marked for deletion. This can also be used to simulate a
timeout, of course.
The EXIT command can be used for test-suites: when sent from the client, it
will cause the server to shut down (as if an EXIT was sent) whenever the
client does a QUIT command. When the servers shuts down, its prints its
statistics on STDOUT. Statistics returned are:
- number of succesful logins
- each command + frequency in alphabetical order
so a statistics list for one successful session could be:
1
DELE 102
EXIT 1
LIST 1
PASS 1
QUIT 1
RETR 102
STAT 1
UIDL 1
USER 1
=cut
# Make sure we do everything by the book
# Make sure we can do sockets
# Make sure we can do digests
use strict;
use IO::Socket;
use Digest::MD5 qw(md5_hex);
# Obtain the directory to work on
# Remove trailing slash if any
# Die now if there is no directory
# Die now if we can't work with it
my $directory = shift;
$directory =~ s#/$##;
die qq(Must specify directory to work with\n) unless $directory;
die qq(Trouble using directory "$directory": $!\n)
unless -d $directory and -w _;
# Initialize the flag settings
my $minimal = 0;
my $apoponly = 0;
my $autodelete = 0;
my $noextra = 0;
my $exitonquit = 0;
my $exitnow = 0;
my @port;
# While there are keywords specified
# Set appropriate flags if so specified
while (my $keyword = shift) {
$minimal = ($keyword eq 'minimal');
$apoponly = ($keyword eq 'apoponly');
$autodelete = ($keyword eq 'autodelete');
$noextra = ($keyword eq 'noextra');
@port = qw(LocalPort 110) if $keyword eq 'standardport';
}
# Make sure no buffering takes place
# Create a server that can only take one connection at a time
$| = 1;
my $server = IO::Socket::INET->new(
Type => SOCK_STREAM,
Listen => 1,
@port,
) or die "Couldn't start a POP3 server:\n $@\n";
# Find out the port we're running on
# Let the caller know which port we're running on
my $port = $server->sockport;
print "$port\n";
# Initialize the connected flag
# Initialize the list of available messages
# Initialize the hash of message ordinal numbers to delete
# Initialize the hash of message ordinal numbers to delete automatically
my $connected = 0;
my @message;
my %delete;
my %autodelete;
# Initialize user
# Initialize digest password field (used by APOP only)
# Initialize the line ending on output
my $user = '';
my $digest;
my $lf = "\x0D\x0A"; # always CRLF
# Number of successful logins performed
# Hash with frequency of each command
my $logins = 0;
my %command;
# While the server is running and we got a new client
# Initialize the APOP initialization string
# If this is a minimal POP3 server
# Don't make it appear we can do POP3
# Else
# Create the APOP authentication string
# Let the client know we're there and we can do APOP
SERVER: while (my $client = $server->accept()) {
my $apop = '';
if ($minimal) {
print $client qq(+OK Welcome to the test-suite POP3 server$lf);
} else {
$apop = "<$$.".time().'@localhost>';
print $client qq(+OK $apop$lf);
}
# Obtain list of files in message directory
# Reset the messages to be (automatically) deleted hashes
@message = <$directory/*>;
%autodelete = %delete = ();
# While the client is asking us stuff to do
# Lose the line ending (whatever it is)
# Split into a command and parameters
# Make sure the command is always uppercase (easier checks later)
# Make sure the parameters are defined (if empty)
while (<$client>) {
s#\r?\n$##s;
my ($command,$parameters) = split( /\s+/,$_,2 );
$command = uc($command);
$parameters = '' unless defined($parameters);
# Count this command for the statistics
# Outloop if quitting this client
$command{$command}++;
last if $command eq 'BREAK';
# If we're connected
# Allow for variable references
# If there is a subroutine for this command
# Execute it with the given parameters and return result
# Send result to client if there is something to connect
# Stop server is so requested
# Outloop if we're no longer connected
# Else
# Indicate it's not implemented
if ($connected) {
no strict 'refs';
if (exists( &$command )) {
my @return = &{$command}( split( /\s+/,$parameters ) );
print $client @return if @return;
last SERVER if $exitnow;
last unless $connected;
} else {
print $client "-ERR unimplemented$lf";
}
# Elseif we're quitting without a connection
# Show that we agree
# And outloop
} elsif ($command eq 'QUIT') {
print $client "+OK$lf";
last;
# Elseif we're trying APOP authentication
# If we have a minimal POP3 server
# Show that this isn't implemented
# And reloop
} elsif ($command eq 'APOP') {
if ($minimal) {
print $client "-ERR unimplemented$lf";
next;
}
# Obtain the user name and the digest
# Log the user in if client gives the right credentials
# Send the result to the client
($user,$digest) = split( /\s+/,$parameters );
my @return = login(
$user eq 'user' and
$digest eq md5_hex( $apop.'password')
);
print $client @return;
# Elseif we have a user name (and we're not connected yet)
# Log the user in if client gives the right credentials now and before
# Send the result to the client
} elsif ($user) {
my @return = login(
$command eq 'PASS' and
$user eq 'user' and
$parameters eq 'password'
);
print $client @return;
# Elseif the user name is passed (and none given before)
# If we only allow APOP
# Let the client know it's not ok
# Else
# Save the user name (for later checking with PASS)
# Let the client know it's ok so far
} elsif ($command eq 'USER') {
if ($apoponly) {
print $client "-ERR APOP authorization allowed only$lf";
} else {
$user = $parameters;
print $client "+OK$lf";
}
# Elseif the password is given (but no user name before)
# Let the client know it's wrong
# Else (attempting to do anything else without authorization)
# Let the client know it's wrong
} elsif ($command eq 'PASS') {
print $client "-ERR user first$lf";
} else {
print $client "-ERR authorization first$lf";
}
}
# Reset user name
# Reset connected flag
# Shut down the client connection
$user = '';
$connected = 0;
close( $client );
}
# Show number of successful logins
# For all the commands that were issued
# Return name and frequency of it
# And shut down the server
print "$logins\n";
foreach (sort keys %command) {
print "$_ $command{$_}\n";
}
close($server);
#------------------------------------------------------------------------
# OUT: 1 whatever needs to be sent to client
sub STAT {
# Initialize number of messages
# Initialize number of bytes they have
# Initialize ordinal number
my $messages = 0;
my $octets = 0;
my $ordinal = 0;
# For all of the messages
# Reloop if message marked as delete, incrementing ordina on the fly
# Increment number of messages
# Add number of bytes
# Return the result
foreach (@message) {
next if exists( $delete{$ordinal++} );
$messages++;
$octets += -s;
}
return "+OK $messages $octets$lf";
} #STAT
#------------------------------------------------------------------------
# OUT: 1 whatever needs to be sent to client
sub UIDL {
# Return now if running a minimal POP3 server
return "-ERR unimplemented$lf" if $minimal;
# Initialize message number
# If a number was specified
# Obtain ordinal number and possible error message
# Return error message if there is one
# Return the message number and the identifier of the message otherwise
my $number = shift;
if (defined($number)) {
my ($ordinal,$error) = ordinal( $number,1 );
return $error if $error;
return "+OK $number $message[$ordinal]$lf";
}
# Initialize ordinal number
# Initialize text to be returned
# For all of the messages
# Reloop if message marked as deleted, incrementing ordinal on the fly
# Add the ordinal number and the identifier (just use filename for that)
# Return the result with an extra . at the end to indicate end of list
my $ordinal = 0;
my $text = "+OK$lf";
foreach (@message) {
next if exists( $delete{$ordinal++} );
$text .= "$ordinal $_$lf"; # external numbers 1-based, internal 0-based
}
return "$text.$lf";
} #UIDL
#------------------------------------------------------------------------
# IN: 1 message to obtain (optionally)
# OUT: 1 whatever needs to be sent to client
sub LIST {
# Initialize message number
# If a number was specified
# Obtain ordinal number and possible error message
# Return error message if there is one
# Return the message number and size of message otherwise
my $number = shift;
if (defined($number)) {
my ($ordinal,$error) = ordinal( $number,1 );
return $error if $error;
return "+OK $number ".(-s $message[$ordinal]).$lf;
}
# Initialize ordinal number
# Initialize text to be returned
# For all of the messages
# Reloop if message marked as deleted, incrementing ordinal on the fly
# Add the ordinal number and the identifier (just use filename for that)
# Return the result with an extra . at the end to indicate end of list
my $ordinal = 0;
my $text = "+OK$lf";
foreach (@message) {
next if exists( $delete{$ordinal++} );
$text .= "$ordinal ".(-s).$lf; # external numbers 1-based, internal 0-based
}
return "$text.$lf";
} #LIST
#------------------------------------------------------------------------
# IN: 1 ordinal number of message to retrieve
# OUT: 1 whatever needs to be sent to client
sub RETR {
# Obtain ordinal number and possible error message
# Return now if there was an error message
my ($ordinal,$error) = ordinal( shift,1 );
return $error if $error;
# Open file for reading or return with empty message
# Initialize text to be returned
# While there are lines to be returned
# Make sure any period at the start of the line becomes a double period
# Add the line to the text to be returned
open( my $handle,'<',$message[$ordinal] ) or return "+OK$lf.$lf";
my $text = "+OK$lf";
while (<$handle>) {
s#^\.#..#;
$text .= $_;
}
# Mark this message to be deleted automatically if flag set
# Add the right marker to the text
# Return the finished text
$autodelete{$ordinal} = undef if $autodelete;
addmarker( \$text );
$text;
} #RETR
#------------------------------------------------------------------------
# IN: 1 ordinal number of message to retrieve
# 2 number of lines of the message to retrieve
# OUT: 1 whatever needs to be sent to client
sub TOP {
# Return now if running a minimal POP3 server
# Obtain ordinal number and possible error message
# Return now if there was an error message
return "-ERR unimplemented$lf" if $minimal;
my ($ordinal,$error) = ordinal( shift,1 );
return $error if $error;
# Open file for reading or return with empty message
# Initialize text to be returned
open( my $handle,'<',$message[$ordinal] ) or return "+OK$lf.$lf";
my $text = "+OK$lf";
# Obtain the number of lines
# If a number of lines was specified
# While there are lines to be returned
# Make sure any period at the start of the line becomes a double period
# Add the line to the text to be returned
# Outloop if we're reached the end of the headers
my $lines = shift;
if (defined($lines)) {
while (<$handle>) {
s#^\.#..#;
$text .= $_;
last if m#^\s+$#s;
}
# While there are lines to be fetched
# Outloop if no line left to be fetched
# Make sure any period at the start of the line becomes a double period
# Add the line to the text to be returned
while ($lines--) {
last unless defined($_ = <$handle>);
s#^\.#..#;
$text .= $_;
}
# Else (no limit)
# While there are lines to be returned
# Make sure any period at the start of the line becomes a double period
# Add the line to the text to be returned
# Mark this message to be deleted automatically if flag set
} else {
while (<$handle>) {
s#^\.#..#;
$text .= $_;
}
$autodelete{$ordinal} = undef if $autodelete;
}
# Add the right marker to the text
# Return the result with an extra . at the end to indicate end of list
addmarker( \$text );
$text;
} #TOP
#------------------------------------------------------------------------
# IN: 1 ordinal number of message to delete
# OUT: 1 whatever needs to be sent to client
sub DELE {
# Obtain ordinal number and possible error message
# Return now if there was an error message
# Mark this message as deletable
# Return the result with an extra . at the end to indicate end of list
my ($ordinal,$error) = ordinal( shift,1 );
return $error if $error;
$delete{$ordinal} = undef;
return "+OK$lf";
} #DELE
#------------------------------------------------------------------------
# IN: 1 ordinal number of message to undelete
# OUT: 1 whatever needs to be sent to client
sub RSET {
# Obtain ordinal number and possible error message
# Return now if there was an error message
# Unmark this message as deletable
# Return the result with an extra . at the end to indicate end of list
my ($ordinal,$error) = ordinal( shift );
return $error if $error;
delete( $delete{$ordinal} );
return "+OK$lf";
} #RSET
#------------------------------------------------------------------------
# OUT: 1 whatever needs to be sent to client
sub NOOP { "+OK$lf" } #NOOP
#------------------------------------------------------------------------
sub EXIT { $exitonquit = 1; return } #EXIT
#------------------------------------------------------------------------
# OUT: 1 whatever needs to be sent to client
sub QUIT {
# Remove all of the files that were supposed to be deleted
# Remove all of the files that were supposed to be deleted automatically
# Set exit now flag if QUIT is to operate as EXIT
# Mark the connection as ended
# Let the client now it was fun while it lasted
unlink( map {$message[$_]} keys %delete );
unlink( map {$message[$_]} keys %autodelete );
$exitnow = $exitonquit;
$connected = 0;
return "+OK$lf";
} #QUIT
#------------------------------------------------------------------------
# IN: 1 flag whether login successful
# OUT: 1 what needs to be returned to the client
sub login {
# If successful
# Increment number of successful logins
# Set connected flag
# Let the client know it's ok
if (shift) {
$logins++;
$connected = 1;
return "+OK$lf";
}
# Reset the user that was entered before
# Let the client know authorization has failed
$user = '';
return "-ERR authorization failed$lf";
} #login
#------------------------------------------------------------------------
# IN: 1 ordinal number of message
# 2 flag: check whether message deleted already
# OUT: 1 normalize message number
# 2 error message (if any)
sub ordinal {
# Obtain the message number
# Initialize error message
# Set error if too low
# Set error if zero
# Set error if too high
my $ordinal = shift;
my $error = '';
$error ||= "-ERR syntax error$lf" if $ordinal < 0;
$error ||= "-ERR messages are counted from 1$lf" if $ordinal == 0;
$error ||= "-ERR not that many messages$lf" if $ordinal > @message;
# Normalize for arrays
# Set error if checking for deletion and already deleted
# Return the result
$ordinal--;
$error ||= "-ERR already deleted$lf" if shift and exists( $delete{$ordinal} );
return ($ordinal,$error);
} #ordinal
#------------------------------------------------------------------------
# IN: 1 reference to text (to add the right end-of-data marker to)
sub addmarker {
# Obtain the reference to the text
# If we should check for extra newlines at the end
# Add the right stuff depending on the end of the text so far
# Else
# Add it as most POP3 servers do
my $textref = shift;
if ($noextra) {
$$textref .= ($$textref =~ m#\r\n$#so ? ".$lf" : "$lf.$lf");
} else {
$$textref .= "$lf.$lf";
}
}
Mail-Box-2.118/tests/43pop3/01basic.t 0000644 0001750 0000144 00000004255 12473603434 017470 0 ustar 00markov users 0000000 0000000 #!/usr/bin/env perl
use warnings;
use strict;
use lib qw(. .. tests);
use Tools;
use Test::More;
BEGIN
{ if($windows)
{ plan skip_all => "not available on MicroSoft Windows.";
exit 0;
}
plan tests => 14;
}
BEGIN { use_ok('Mail::Transport::POP3') }
# Check if all methods are there OK
can_ok('Mail::Transport::POP3', qw(
deleted
deleteFetched
DESTROY
disconnect
fetched
folderSize
header
ids
id2n
init
message
messages
messageSize
send
sendList
socket
url
));
my $original = File::Spec->catdir ('43pop3', 'original');
my $popbox = File::Spec->catdir ('43pop3', 'popbox');
copy_dir($original, $popbox);
my ($server, $port) = start_pop3_server($popbox);
my $receiver = start_pop3_client($port);
isa_ok($receiver, 'Mail::Transport::POP3');
my $socket = $receiver->socket;
ok($socket, "Could not get socket of POP3 server");
print $socket "EXIT\n";
my @message = <$popbox/????>;
my $total = 0;
$total += -s foreach @message;
my $messages = @message;
cmp_ok($receiver->messages, '==', $messages, "Wrong number of messages");
cmp_ok($receiver->folderSize, '==', $total, "Wrong number of bytes");
my @id = $receiver->ids;
cmp_ok(scalar(@id), '==', scalar(@message), "Number of messages doesn't match");
is(join('',@id), join('',@message), "ID's don't match filenames");
my $error = '';
foreach(@id)
{ my ($reported, $real) = ($receiver->messageSize($_),-s);
$error .= "size $_ is not right: expected $real, got $reported\n"
if $reported != $real;
}
ok(!$error, ($error || 'No errors with sizes'));
$error = '';
foreach(@id)
{ my $message = $receiver->message($_);
open(my $handle, '<', $_);
$error .= "content of $_ is not right\n"
if join('', @$message) ne join('', <$handle>);
}
ok(!$error, $error || 'No errors with contents');
$receiver->deleted(1,@id);
ok($receiver->disconnect, 'Failed to properly disconnect from server');
@message = <$popbox/????>;
cmp_ok(scalar(@message) ,'==', 0, 'Did not remove messages at QUIT');
ok(rmdir($popbox), "Failed to remove $popbox directory: $!");
is(join('', <$server>), <