zydronium/imapsync
1
0
Fork 0
mirror of https://github.com/imapsync/imapsync.git synced 2025-08-04 07:51:52 +02:00
Code Issues Projects Releases Packages Wiki Activity

1.310

Browse source
This commit is contained in:
Nick Bebout 2011-03-12 02:44:51 +00:00
parent 95aab825e8
commit 5f67654c6f
53 changed files with 32864 additions and 289 deletions
Download patch file Download diff file Expand all files Collapse all files

343
Mail-IMAPClient-3.23/t/basic.t Normal file
View file

@ -0,0 +1,343 @@
#!/usr/bin/perl
use strict;
use warnings;
use Test::More;
use File::Temp qw(tempfile);
my $debug = $ARGV[0];
my %parms;
my $range = 0;
my $uidplus = 0;
my $fast = 1;
BEGIN {
open TST, 'test.txt'
or plan skip_all => 'test parameters not provided in test.txt';
while ( my $l = <TST> ) {
chomp $l;
my ( $p, $v ) = split /\=/, $l, 2;
s/^\s+//, s/\s+$// for $p, $v;
$parms{$p} = $v if $v;
}
close TST;
my @missing;
foreach my $p (qw/server user passed/) {
push( @missing, $p ) unless defined $parms{$p};
}
@missing
? plan skip_all => "missing value for: @missing"
: plan tests => 67;
}
BEGIN { use_ok('Mail::IMAPClient') or exit; }
my @new_args = (
Server => $parms{server},
Port => $parms{port},
User => $parms{user},
Password => $parms{passed},
Authmechanism => $parms{authmech},
Clear => 0,
Fast_IO => $fast,
Uid => $uidplus,
Debug => $debug,
);
my $imap = Mail::IMAPClient->new(
@new_args,
Range => $range,
Debug_fh => ( $debug ? IO::File->new( 'imap1.debug', 'w' ) : undef )
);
ok( defined $imap, 'created client' );
$imap
or die "Cannot log into $parms{server} as $parms{user}.\n"
. "Are server/user/password correct?\n";
isa_ok( $imap, 'Mail::IMAPClient' );
$imap->Debug_fh->autoflush() if $imap->Debug_fh;
my $testmsg = <<__TEST_MSG;
Date: @{[$imap->Rfc822_date(time)]}
To: <$parms{user}\@$parms{server}>
From: Perl <$parms{user}\@$parms{server}>
Subject: Testing from pid $$
This is a test message generated by $0 during a 'make test' as part of
the installation of the Mail::IMAPClient module from CPAN.
__TEST_MSG
ok( $imap->noop, "noop" );
my $sep = $imap->separator;
ok( defined $sep, "separator is '$sep'" );
my $ispar = $imap->is_parent('INBOX');
my ( $target, $target2 ) =
$ispar
? ( "INBOX${sep}IMAPClient_$$", "INBOX${sep}IMAPClient_2_$$" )
: ( "IMAPClient_$$", "IMAPClient_2_$$" );
ok( defined $ispar, "INBOX is_parent '$ispar' (note: target '$target')" );
ok( $imap->select('inbox'), "select inbox" );
ok( $imap->create($target), "create target" );
{
my $list = $imap->list();
is( ref($list), "ARRAY", "list" );
my $lsub = $imap->lsub();
is( ref($lsub), "ARRAY", "lsub" );
ok( $imap->subscribe($target), "subscribe target" );
my $sub1 = $imap->subscribed();
is( ( grep( /^\Q$target\E$/, @$sub1 ) )[0], "$target", "subscribed" );
ok( $imap->unsubscribe($target), "unsubscribe target" );
my $sub2 = $imap->subscribed();
is( ( grep( /^\Q$target\E$/, @$sub2 ) )[0], undef, "unsubscribed" );
ok( $imap->tag_and_run("NOOP\r\n"), "tag_and_run" );
}
my $fwquotes = qq($target${sep}has "quotes");
if ( !$imap->is_parent($target) ) {
ok( 1, "not parent, skipping quote test 1/3" );
ok( 1, "not parent, skipping quote test 2/3" );
ok( 1, "not parent, skipping quote test 3/3" );
}
elsif ( $imap->create($fwquotes) ) {
ok( 1, "create $fwquotes" );
ok( $imap->select($fwquotes), 'select $fwquotes' );
ok( $imap->close, 'close $fwquotes' );
$imap->select('inbox');
ok( $imap->delete($fwquotes), 'delete $fwquotes' );
}
else {
if ( $imap->LastError =~ /NO Invalid.*name/ ) {
ok( 1, "$parms{server} doesn't support quotes in folder names" );
}
else { ok( 0, "failed creation with quotes" ) }
ok( 1, "skipping 1/2 tests" );
ok( 1, "skipping 2/2 tests" );
}
ok( $imap->exists($target), "exists $target" );
ok( $imap->create($target2), "create $target2" );
ok( $imap->exists($target2), "exists $target2" );
my $uid = $imap->append( $target, $testmsg );
ok( defined $uid, "append test message to $target" );
ok( $imap->select($target), "select $target" );
my $msg = ( $uidplus and $uid ) ? $uid : ( $imap->messages )[0];
my $size = $imap->size($msg);
cmp_ok( $size, '>', 0, "has size $size" );
my $string = $imap->message_string($msg);
ok( defined $string, "returned string" );
cmp_ok( length($string), '==', $size, "string has size" );
{
my ( $fh, $fn ) = tempfile UNLINK => 1;
ok( $imap->message_to_file( $fn, $msg ), "to file $fn" );
cmp_ok( -s $fn, '==', $size, "correct size" );
}
my $fields = $imap->search( "HEADER", "Message-id", "NOT_A_MESSAGE_ID" );
is( scalar @$fields, 0, 'bogus message id does not exist' );
my @seen = $imap->seen;
cmp_ok( scalar @seen, '==', 1, 'have seen 1' );
ok( $imap->deny_seeing( \@seen ), 'deny seeing' );
my @unseen = $imap->unseen;
cmp_ok( scalar @unseen, '==', 1, 'have unseen 1' );
ok( $imap->see( \@seen ), "let's see one" );
cmp_ok( scalar @seen, '==', 1, 'have seen 1' );
$imap->deny_seeing(@seen); # reset
$imap->Peek(1);
my $subject = $imap->parse_headers( $seen[0], "Subject" )->{Subject}[0];
unlike( join( "", $imap->flags( $seen[0] ) ), qr/\\Seen/i, 'Peek==1' );
$imap->deny_seeing(@seen);
$imap->Peek(0);
$subject = $imap->parse_headers( $seen[0], "Subject" )->{Subject}[0];
like( join( "", $imap->flags( $seen[0] ) ), qr/\\Seen/i, 'Peek==0' );
$imap->deny_seeing(@seen);
$imap->Peek(undef);
$subject = $imap->parse_headers( $seen[0], "Subject" )->{Subject}[0];
unlike( join( "", $imap->flags( $seen[0] ) ), qr/\\Seen/i, 'Peek==undef' );
my $uid2 = $imap->copy( $target2, 1 );
ok( $uid2, "copy $target2" );
my @res = $imap->fetch( 1, "RFC822.TEXT" );
ok( scalar @res, "fetch rfc822" );
my $res1 = $imap->fetch_hash("RFC822.SIZE");
is( ref($res1), "HASH", "fetch_hash(RFC822.SIZE)" );
my $res2 = $imap->fetch_hash( 1, "RFC822.SIZE" );
is( ref($res2), "HASH", "fetch_hash(1,RFC822.SIZE)" );
my $h = $imap->parse_headers( 1, "Subject" );
ok( $h, "got subject" );
like( $h->{Subject}[0], qr/^Testing from pid/, "subject matched" );
ok( $imap->select($target), "select $target" );
my @hits = $imap->search( SUBJECT => 'Testing' );
cmp_ok( scalar @hits, '==', 1, 'hit subject Testing' );
ok( defined $hits[0], "subject is defined" );
ok( $imap->delete_message(@hits), 'delete hits' );
my $flaghash = $imap->flags( \@hits );
my $flagflag = 0;
foreach my $v ( values %$flaghash ) {
$flagflag += grep /\\Deleted/, @$v;
}
cmp_ok( $flagflag, '==', scalar @hits, "delete verified" );
my @nohits = $imap->search( \qq(SUBJECT "Productioning") );
cmp_ok( scalar @nohits, '==', 0, 'no hits expected' );
ok( $imap->restore_message(@hits), 'restore messages' );
$flaghash = $imap->flags( \@hits );
foreach my $v ( values %$flaghash ) {
$flagflag-- unless grep /\\Deleted/, @$v;
}
cmp_ok( $flagflag, '==', 0, "restore verified" );
$imap->select($target2);
ok(
$imap->delete_message( scalar( $imap->search("ALL") ) )
&& $imap->close
&& $imap->delete($target2),
"delete $target2"
);
$imap->select("INBOX");
$@ = undef;
@hits =
$imap->search( BEFORE => Mail::IMAPClient::Rfc2060_date(time), "UNDELETED" );
ok( !$@, "search undeleted" ) or diag( '$@:' . $@ );
#
# Test migrate method
#
my $im2 = Mail::IMAPClient->new(
@new_args,
Timeout => 30,
Debug_fh => ( $debug ? IO::File->new(">./imap2.debug") : undef ),
);
ok( defined $im2, 'started second imap client' );
my $source = $target;
$imap->select($source)
or die "cannot select source $source: $@";
$imap->append( $source, $testmsg ) for 1 .. 5;
$imap->close;
$imap->select($source);
my $migtarget = $target . '_mirror';
$im2->create($migtarget)
or die "can't create $migtarget: $@";
$im2->select($migtarget)
or die "can't select $migtarget: $@";
$imap->migrate( $im2, scalar( $imap->search("ALL") ), $migtarget )
or die "couldn't migrate: $@";
$im2->close;
$im2->select($migtarget)
or die "can't select $migtarget: $@";
ok( !$@, "LastError not set" ) or diag( '$@:' . $@ );
#
my $total_bytes1 = 0;
for ( $imap->search("ALL") ) {
my $s = $imap->size($_);
$total_bytes1 += $s;
print "Size of msg $_ is $s\n" if $debug;
}
my $total_bytes2 = 0;
for ( $im2->search("ALL") ) {
my $s = $im2->size($_);
$total_bytes2 += $s;
print "Size of msg $_ is $s\n" if $debug;
}
ok( !$@, "LastError not set" ) or diag( '$@:' . $@ );
cmp_ok( $total_bytes1, '==', $total_bytes2, 'size source==target' );
# cleanup
$im2->select($migtarget);
$im2->delete_message( @{ $im2->messages } )
if $im2->message_count;
ok( $im2->close, "close" );
$im2->delete($migtarget);
ok( $im2->logout, "logout" ) or diag("logout error: $@");
# Test IDLE
SKIP: {
skip "IDLE not supported", 4 unless $imap->has_capability("IDLE");
ok( my $idle = $imap->idle, "idle" );
sleep 1;
ok( $imap->idle_data, "idle_data" );
ok( $imap->done($idle), "done" );
ok( !$@, "LastError not set" ) or diag( '$@:' . $@ );
}
$imap->select('inbox');
if ( $imap->rename( $target, "${target}NEW" ) ) {
ok( 1, 'rename' );
$imap->close;
$imap->select("${target}NEW");
$imap->delete_message( @{ $imap->messages } ) if $imap->message_count;
$imap->close;
$imap->delete("${target}NEW");
}
else {
ok( 0, 'rename failed' );
$imap->delete_message( @{ $imap->messages } )
if $imap->message_count;
$imap->close;
$imap->delete($target);
}
$imap->_disconnect;
ok( $imap->reconnect, "reconnect" );
# Test STARTTLS - an optional feature so tests always succeed
{
ok( $imap->logout, "logout" ) or diag("logout error: $@");
$imap->connect( Starttls => 1 );
ok( 1, "OPTIONAL connect(Starttls=>1)" . ( $@ ? ": (error) $@ " : "" ) );
}

58
Mail-IMAPClient-3.23/t/bodystructure.t Normal file
View file

@ -0,0 +1,58 @@
#!/usr/bin/perl
use strict;
use warnings;
use Test::More tests => 11;
BEGIN { use_ok('Mail::IMAPClient::BodyStructure') or exit; }
my $bs = <<'END_OF_BS';
(BODYSTRUCTURE ("TEXT" "PLAIN" ("CHARSET" "us-ascii") NIL NIL "7BIT" 511 20 NIL NIL NIL))^M
END_OF_BS
my $bsobj = Mail::IMAPClient::BodyStructure->new($bs);
ok( defined $bsobj, 'parsed first' );
is( $bsobj->bodytype, 'TEXT', 'bodytype' );
is( $bsobj->bodysubtype, 'PLAIN', 'bodysubtype' );
my $bs2 = <<'END_OF_BS2';
(BODYSTRUCTURE (("TEXT" "PLAIN" ("CHARSET" 'us-ascii') NIL NIL "7BIT" 2 1 NIL NIL NIL)("MESSAGE" "RFC822" NIL NIL NIL "7BIT" 3930 ("Tue, 16 Jul 2002 15:29:17 -0400" "Re: [Fwd: Here is the the list of uids]" (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("David J Kavid" NIL "david.kavid" "generic.com")) NIL NIL "<72f9a217.a21772f9@generic.com>") (("TEXT" "PLAIN" ("CHARSET" "us-ascii") NIL NIL "7BIT" 369 11 NIL NIL NIL)("MESSAGE" "RFC822" NIL NIL NIL "7BIT" 2599 ("Tue, 9 Jul 2002 13:42:04 -0400" "Here is the the list of uids" (("Nicholas Kringle" NIL "nicholas.kringle" "generic.com")) (("Nicholas Kringle" NIL "nicholas.kringle" "generic.com")) (("Nicholas Kringle" NIL "nicholas.kringle" "generic.com")) (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("Richard W Continued" NIL "richard.continued" "generic.com")) NIL NIL "<015401c2276f$f09b7c10$59cab08c@one.two.generic.com>") ((("TEXT" "PLAIN" ("CHARSET" "iso-8859-1") NIL NIL "QUOTED-PRINTABLE" 256 10 NIL NIL NIL)("TEXT" "HTML" ("CHARSET" "iso-8859-1") NIL NIL "QUOTED-PRINTABLE" 791 22 NIL NIL NIL) "ALTERNATIVE" ("BOUNDARY" "----=_NextPart_001_0151_01C2274E.6969D0F0") NIL NIL) "MIXED" ("BOUNDARY" "----=_NextPart_000_0150_01C2274E.6969D0F0") NIL NIL) 75 NIL NIL NIL) "MIXED" ("BOUNDARY" "--1f34eac2082b02") NIL ("EN")) 118 NIL NIL NIL) "MIXED" ("BOUNDARY" "------------F600BD8FDDD648ABA72A09E0") NIL NIL))
END_OF_BS2
$bsobj = Mail::IMAPClient::BodyStructure->new($bs2);
ok( defined $bsobj, 'parsed second' );
is( $bsobj->bodytype, 'MULTIPART', 'bodytype' );
is( $bsobj->bodysubtype, 'MIXED', 'bodysubtype' );
is(
join( "#", $bsobj->parts ),
# Better parsing in version 3.03, changed this outcome
# "1#2#2.HEAD#2.1#2.2#2.2.HEAD#2.2.1#2.2.1.1#2.2.1.2"
"1#2#2.HEAD#2.1#2.1.1#2.1.2#2.1.2.HEAD#2.1.2.1#2.1.2.1.1#2.1.2.1.1.1#2.1.2.1.1.2",
'parts'
);
my $bs3 = <<'END_OF_BS3';
FETCH (UID 1 BODYSTRUCTURE (("TEXT" "PLAIN" ("charset" "ISO-8859-1")
NIL NIL "quoted-printable" 1744 0)("TEXT" "HTML" ("charset"
"ISO-8859-1") NIL NIL "quoted-printable" 1967 0) "ALTERNATIVE"))
END_OF_BS3
$bsobj = Mail::IMAPClient::BodyStructure->new($bs3);
ok( defined $bsobj, 'parsed third' );
my $bs4 = <<'END_OF_BS4';
* 9 FETCH (UID 9 BODYSTRUCTURE (("TEXT" "PLAIN" ("charset" "us-ascii") NIL "Notification" "7BIT" 588 0)("MESSAGE" "DELIVERY-STATUS" NIL NIL "Delivery report" "7BIT" 459)("MESSAGE" "RFC822" NIL NIL "Undelivered Message" "8bit" 10286 ("Thu, 31 May 2007 11:25:56 +0200 (CEST)" "*****SPAM***** RE: Daily News" (("admin@activtrades.com" NIL "polettld" "ensma.fr")) (("admin@activtrades.com" NIL "polettld" "ensma.fr")) (("admin@activtrades.com" NIL "polettld" "ensma.fr")) ((NIL NIL "polettld" "ensma.fr")) NIL NIL "NIL" "<20070531133257.92825.qmail@cc299962-a.haaks1.ov.home.nl>") (("TEXT" "PLAIN" ("charset" "iso-8859-1") NIL NIL "7bit" 1510 0)("MESSAGE" "RFC822" ("name" "message" "x-spam-type" "original") NIL "Original message" "8bit" 5718) "MIXED")) "REPORT"))
END_OF_BS4
$bsobj = Mail::IMAPClient::BodyStructure->new($bs4);
ok( defined $bsobj, 'parsed fourth' );
# test bodyMD5, contributed by Micheal Stok
my $bs5 = <<'END_OF_BS5';
* 6 FETCH (UID 17280 BODYSTRUCTURE ((("text" "plain" ("charset" "utf-8") NIL NIL "quoted-printable" 1143 37 NIL NIL NIL)("text" "html" ("charset" "utf-8") NIL NIL "quoted-printable" 4618 106 NIL NIL NIL) "alternative" ("boundary" "Boundary-00=_Z7P340MWKGMMYJ0CCJD0") NIL NIL)("image" "tiff" ("name" "8dd0e430.tif") NIL NIL "base64" 204134 "pmZp5QOBa9BIqFNmvxUiyQ==" ("attachment" ("filename" "8dd0e430.tif")) NIL) "mixed" ("boundary" "Boundary-00=_T7P340MWKGMMYJ0CCJD0") NIL NIL))
END_OF_BS5
$bsobj = Mail::IMAPClient::BodyStructure->new($bs5);
ok( defined $bsobj, 'parsed fifth' );

233
Mail-IMAPClient-3.23/t/fetch_hash.t Normal file
View file

@ -0,0 +1,233 @@
#!/usr/bin/perl
#
#
# tests for fetch_hash()
#
# fetch_hash() calls fetch() internally. rather than refactor
# fetch_hash() just for testing, we instead subclass M::IC and use the
# overidden fetch() to feed it test data.
use strict;
use warnings;
use Test::More tests => 18;
BEGIN { use_ok('Mail::IMAPClient') or exit; }
my @tests = (
[
"unquoted value",
[ q{* 1 FETCH (UNQUOTED foobar)}, ],
[ [1], qw(UNQUOTED) ],
{ "1" => { "UNQUOTED" => q{foobar}, } },
],
[
"quoted value",
[ q{* 1 FETCH (QUOTED "foo bar baz")}, ],
[ [1], qw(QUOTED) ],
{ "1" => { "QUOTED" => q{foo bar baz}, }, },
],
[
"parenthesized value",
[ q{* 1 FETCH (PARENS (foo bar))}, ],
[ [1], qw(PARENS) ],
{ "1" => { "PARENS" => q{foo bar}, }, },
],
[
"parenthesized value with quotes",
[ q{* 1 FETCH (PARENS (foo "bar" baz))}, ],
[ [1], qw(PARENS) ],
{ "1" => { "PARENS" => q{foo "bar" baz}, }, },
],
[
"parenthesized value with parens at start",
[ q{* 1 FETCH (PARENS ((foo) bar baz))}, ],
[ [1], qw(PARENS) ],
{ "1" => { "PARENS" => q{(foo) bar baz}, }, },
],
[
"parenthesized value with parens in middle",
[ q{* 1 FETCH (PARENS (foo (bar) baz))}, ],
[ [1], qw(PARENS) ],
{ "1" => { "PARENS" => q{foo (bar) baz}, }, },
],
[
"parenthesized value with parens at end",
[ q{* 1 FETCH (PARENS (foo bar (baz)))}, ],
[ [1], qw(PARENS) ],
{ "1" => { "PARENS" => q{foo bar (baz)}, }, },
],
[
"complex parens",
[ q{* 1 FETCH (PARENS ((((foo) "bar") baz (quux))))}, ],
[ [1], qw(PARENS) ],
{ "1" => { "PARENS" => q{(((foo) "bar") baz (quux))}, }, },
],
[
"basic literal value",
[ q{* 1 FETCH (LITERAL}, q{foo}, q{)}, ],
[ [1], qw(LITERAL) ],
{ "1" => { "LITERAL" => q{foo}, }, },
],
[
"multiline literal value",
[ q{* 1 FETCH (LITERAL}, q{foo\r\nbar\r\nbaz\r\n}, q{)}, ],
[ [1], qw(LITERAL) ],
{ "1" => { "LITERAL" => q{foo\r\nbar\r\nbaz\r\n}, }, },
],
[
"multiple attributes",
[ q{* 1 FETCH (FOO foo BAR bar BAZ baz)}, ],
[ [1], qw(FOO BAR BAZ) ],
{
"1" => {
"FOO" => q{foo},
"BAR" => q{bar},
"BAZ" => q{baz},
},
},
],
[
"dotted attribute",
[ q{* 1 FETCH (FOO.BAR foobar)}, ],
[ [1], qw(FOO.BAR) ],
{ "1" => { "FOO.BAR" => q{foobar}, }, },
],
[
"complex attribute",
[ q{* 1 FETCH (FOO.BAR[BAZ (QUUX)] quuz)}, ],
[ [1], q{FOO.BAR[BAZ (QUUX)]} ],
{ "1" => { q{FOO.BAR[BAZ (QUUX)]} => q{quuz}, }, },
],
[
"BODY.PEEK[] requests match BODY[] responses",
[ q{* 1 FETCH (BODY[] foo)} ],
[ [1], qw(BODY.PEEK[]) ],
{ "1" => { "BODY[]" => q{foo}, }, },
],
[
"BODY.PEEK[] requests match BODY.PEEK[] responses also",
[ q{* 1 FETCH (BODY.PEEK[] foo)} ],
[ [1], qw(BODY.PEEK[]) ],
{ "1" => { "BODY.PEEK[]" => q{foo}, }, },
],
[
"real life example",
[
'* 1 FETCH (UID 541 FLAGS (\\Seen) INTERNALDATE "15-Sep-2009 20:05:45 +1000" RFC822.SIZE 771 BODY[HEADER.FIELDS (TO FROM DATE SUBJECT)]',
'Date: Tue, 15 Sep 2009 20:05:45 +1000
To: rob@pyro
From: rob@pyro
Subject: test Tue, 15 Sep 2009 20:05:45 +1000
',
' BODY[]',
'Return-Path: <rob@pyro>
X-Spam-Checker-Version: SpamAssassin 3.2.5 (2008-06-10) on pyro.home
X-Spam-Level:
X-Spam-Status: No, score=-0.5 required=5.0 tests=ALL_TRUSTED,BAYES_00,
FH_FROMEML_NOTLD,TO_MALFORMED autolearn=no version=3.2.5
X-Original-To: rob@pyro
Delivered-To: rob@pyro
Received: from pyro (pyro [127.0.0.1])
by pyro.home (Postfix) with ESMTP id A5C8115A066
for <rob@pyro>; Tue, 15 Sep 2009 20:05:45 +1000 (EST)
Date: Tue, 15 Sep 2009 20:05:45 +1000
To: rob@pyro
From: rob@pyro
Subject: test Tue, 15 Sep 2009 20:05:45 +1000
X-Mailer: swaks v20061116.0 jetmore.org/john/code/#swaks
Message-Id: <20090915100545.A5C8115A066@pyro.home>
X-Bogosity: Spam, tests=bogofilter, spamicity=0.999693, version=1.2.1
Lines: 1
This is a test mailing
',
')
',
],
[
[1],
q{BODY.PEEK[HEADER.FIELDS (To From Date Subject)]},
qw(FLAGS INTERNALDATE RFC822.SIZE BODY[])
],
{
"1" => {
'BODY[]' => 'Return-Path: <rob@pyro>
X-Spam-Checker-Version: SpamAssassin 3.2.5 (2008-06-10) on pyro.home
X-Spam-Level:
X-Spam-Status: No, score=-0.5 required=5.0 tests=ALL_TRUSTED,BAYES_00,
FH_FROMEML_NOTLD,TO_MALFORMED autolearn=no version=3.2.5
X-Original-To: rob@pyro
Delivered-To: rob@pyro
Received: from pyro (pyro [127.0.0.1])
by pyro.home (Postfix) with ESMTP id A5C8115A066
for <rob@pyro>; Tue, 15 Sep 2009 20:05:45 +1000 (EST)
Date: Tue, 15 Sep 2009 20:05:45 +1000
To: rob@pyro
From: rob@pyro
Subject: test Tue, 15 Sep 2009 20:05:45 +1000
X-Mailer: swaks v20061116.0 jetmore.org/john/code/#swaks
Message-Id: <20090915100545.A5C8115A066@pyro.home>
X-Bogosity: Spam, tests=bogofilter, spamicity=0.999693, version=1.2.1
Lines: 1
This is a test mailing
',
'INTERNALDATE' => '15-Sep-2009 20:05:45 +1000',
'FLAGS' => '\\Seen',
'BODY[HEADER.FIELDS (TO FROM DATE SUBJECT)]' =>
'Date: Tue, 15 Sep 2009 20:05:45 +1000
To: rob@pyro
From: rob@pyro
Subject: test Tue, 15 Sep 2009 20:05:45 +1000
',
'RFC822.SIZE' => '771'
},
},
],
);
my @uid_tests = (
[
"uid enabled",
[ q{* 1 FETCH (UID 123 UNQUOTED foobar)}, ],
[ [123], qw(UNQUOTED) ],
{ "123" => { "UNQUOTED" => q{foobar}, } },
],
);
package Test::Mail::IMAPClient;
use vars qw(@ISA);
@ISA = qw(Mail::IMAPClient);
sub new {
my ( $class, %args ) = @_;
my %me = %args;
return bless \%me, $class;
}
sub fetch {
my ( $self, @args ) = @_;
return $self->{_next_fetch_response} || [];
}
package main;
sub run_tests {
my ( $imap, $tests ) = @_;
for my $test (@$tests) {
my ( $comment, $fetch, $request, $response ) = @$test;
$imap->{_next_fetch_response} = $fetch;
my $r = $imap->fetch_hash(@$request);
is_deeply( $r, $response, $comment );
}
}
my $imap = Test::Mail::IMAPClient->new( Uid => 0 );
run_tests( $imap, \@tests );
$imap->Uid(1);
run_tests( $imap, \@uid_tests );

37
Mail-IMAPClient-3.23/t/messageset.t Normal file
View file

@ -0,0 +1,37 @@
#!/usr/bin/perl
use strict;
use warnings;
use Test::More tests => 7;
BEGIN { use_ok('Mail::IMAPClient::MessageSet') or exit; }
my $one = q/1:4,3:6,10:15,20:25,2:8/;
my $range = Mail::IMAPClient::MessageSet->new($one);
is( $range, "1:8,10:15,20:25", 'range simplify' );
is(
join( ",", $range->unfold ),
"1,2,3,4,5,6,7,8,10,11,12,13,14,15,20,21,22,23,24,25",
'range unfold'
);
$range .= "30,31,32,31:34,40:44";
is( $range, "1:8,10:15,20:25,30:34,40:44", 'overload concat' );
is(
join( ",", $range->unfold ),
"1,2,3,4,5,6,7,8,10,11,12,13,14,15,20,21,22,23,24,25,"
. "30,31,32,33,34,40,41,42,43,44",
'unfold extended'
);
$range -= "1:2";
is( $range, "3:8,10:15,20:25,30:34,40:44", 'overload subtract' );
is(
join( ",", $range->unfold ),
"3,4,5,6,7,8,10,11,12,13,14,15,20,21,22,23,24,25,"
. "30,31,32,33,34,40,41,42,43,44",
'subtract unfold'
);

10
Mail-IMAPClient-3.23/t/pod.t Normal file
View file

@ -0,0 +1,10 @@
#!/usr/bin/perl
use strict;
use warnings;
use Test::More;
eval "use Test::Pod 1.00";
plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
all_pod_files_ok();

36
Mail-IMAPClient-3.23/t/simple.t Normal file
View file

@ -0,0 +1,36 @@
#!/usr/bin/perl
use strict;
use warnings;
use Test::More tests => 13;
BEGIN { use_ok('Mail::IMAPClient') or exit; }
{
my $obj = Mail::IMAPClient->new();
my %t = ( 0 => "01-Jan-1970" );
foreach my $k ( sort keys %t ) {
my $v = $t{$k};
my $s = $v . ' 00:00:00 +0000';
is( Mail::IMAPClient::Rfc2060_date($k), $v, "Rfc2060_date($k)=$v" );
is( Mail::IMAPClient::Rfc3501_date($k), $v, "Rfc3501_date($k)=$v" );
is( Mail::IMAPClient::Rfc3501_datetime($k),
$s, "Rfc3501_datetime($k)=$s" );
is( Mail::IMAPClient::Rfc2060_datetime($k),
$s, "Rfc3501_datetime($k)=$s" );
is( $obj->Rfc3501_date($k), $v, "->Rfc3501_date($k)=$v" );
is( $obj->Rfc2060_date($k), $v, "->Rfc2060_date($k)=$v" );
is( $obj->Rfc3501_datetime($k), $s, "->Rfc3501_datetime($k)=$s" );
is( $obj->Rfc2060_datetime($k), $s, "->Rfc2060_datetime($k)=$s" );
foreach my $z (qw(+0000 -0500)) {
my $vz = $v . ' 00:00:00 ' . $z;
is( Mail::IMAPClient::Rfc2060_datetime( $k, $z ),
$vz, "Rfc2060_datetime($k)=$vz" );
is( Mail::IMAPClient::Rfc3501_datetime( $k, $z ),
$vz, "Rfc3501_datetime($k)=$vz" );
}
}
}

30
Mail-IMAPClient-3.23/t/thread.t Normal file
View file

@ -0,0 +1,30 @@
#!/usr/bin/perl
use strict;
use warnings;
use Test::More tests => 7;
BEGIN { use_ok('Mail::IMAPClient::Thread') or exit; }
my $t1 = <<'e1';
* THREAD (166)(167)(168)(169)(172)(170)(171)(173)(174 175 176 178 181 180)(179)(177 183 182 188 184 185 186 187 189)(190)(191)(192)(193)(194 195)(196 197 198)(199)(200 202)(201)(203)(204)(205)(206 207)(208)
e1
my $t2 = <<'e2';
* THREAD (166)(167)(168)(169)(172)((170)(179))(171)(173)((174)(175)(176)(178)(181)(180))((177)(183)(182)(188 (184)(189))(185 186)(187))(190)(191)(192)(193)((194)(195 196))(197 198)(199)(200 202)(201)(203)(204)(205 206 207)(208)
e2
my $parser = Mail::IMAPClient::Thread->new;
ok( defined $parser, 'created parser' );
isa_ok( $parser, 'Parse::RecDescent' ); # !!!
my $thr1 = $parser->start($t1);
ok( defined $thr1, 'thread1 start' );
cmp_ok( scalar(@$thr1), '==', 25 );
my $thr2 = $parser->start($t2);
ok( defined $thr2, 'thread2 start' );
cmp_ok( scalar(@$thr2), '==', 23 );