mirror of
https://github.com/imapsync/imapsync.git
synced 2025-06-12 15:34:52 +02:00
1.404
This commit is contained in:
Nick Bebout
parent
d88bf4b46a
commit
02322d6ed1
73 changed files with 19532 additions and 23747 deletions
431
Mail-IMAPClient-3.27/t/basic.t
Normal file
431
Mail-IMAPClient-3.27/t/basic.t
Normal file
|
|
@ -0,0 +1,431 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use IO::File qw();
|
||||
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 => 85;
|
||||
}
|
||||
|
||||
BEGIN { use_ok('Mail::IMAPClient') or exit; }
|
||||
|
||||
my %new_args = (
|
||||
Server => delete $parms{server},
|
||||
Port => delete $parms{port},
|
||||
User => delete $parms{user},
|
||||
Password => delete $parms{passed},
|
||||
Authmechanism => delete $parms{authmech},
|
||||
Clear => 0,
|
||||
Fast_IO => $fast,
|
||||
Uid => $uidplus,
|
||||
Debug => $debug,
|
||||
);
|
||||
|
||||
# allow other options to be placed in test.txt
|
||||
%new_args = ( %new_args, %parms );
|
||||
|
||||
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 $new_args{Server} as $new_args{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: <$new_args{User}\@$new_args{Server}>
|
||||
From: Perl <$new_args{User}\@$new_args{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" );
|
||||
ok( $imap->tag_and_run("NOOP\r\n"), "tag_and_run" );
|
||||
|
||||
my $sep = $imap->separator;
|
||||
ok( defined $sep, "separator is '$sep'" );
|
||||
|
||||
{
|
||||
my $list = $imap->list();
|
||||
is( ref($list), "ARRAY", "list" );
|
||||
|
||||
my $lsub = $imap->lsub();
|
||||
is( ref($lsub), "ARRAY", "lsub" );
|
||||
}
|
||||
|
||||
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" );
|
||||
|
||||
# test append_file
|
||||
my $append_file_size;
|
||||
{
|
||||
my ( $afh, $afn ) = tempfile UNLINK => 1;
|
||||
|
||||
# write message to autoflushed file handle since we keep $afh around
|
||||
my $oldfh = select($afh);
|
||||
$| = 1;
|
||||
select($oldfh);
|
||||
print( $afh $testmsg ) or die("print testmsg failed");
|
||||
cmp_ok( -s $afn, '>', 0, "tempfile has size" );
|
||||
|
||||
ok( $imap->create($target), "create target" );
|
||||
|
||||
my $uid = $imap->append_file( $target, $afn );
|
||||
ok( defined $uid, "append_file 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 matches server size" );
|
||||
ok( $imap->delete($target), "delete folder $target" );
|
||||
|
||||
$append_file_size = $size;
|
||||
}
|
||||
|
||||
ok( $imap->create($target), "create target" );
|
||||
ok( $imap->select($target), "select $target" );
|
||||
|
||||
# Test append / append_string if we also have UID capability
|
||||
SKIP: {
|
||||
skip "UIDPLUS not supported", 3 unless $imap->has_capability("UIDPLUS");
|
||||
|
||||
my $ouid = $imap->Uid();
|
||||
$imap->Uid(1);
|
||||
|
||||
# test with date that has a leading space
|
||||
my $d = " 1-Jan-2011 01:02:03 -0500";
|
||||
my $uid = $imap->append_string( $target, $testmsg, undef, $d );
|
||||
ok( defined $uid, "append test message to $target with date (uid=$uid)" );
|
||||
ok( $imap->delete_message($uid), "delete_message $uid" );
|
||||
ok( $imap->uidexpunge($uid), "uidexpunge $uid" );
|
||||
|
||||
# multiple args joined internally in append()
|
||||
$uid = $imap->append( $target, $testmsg, "Some extra text too" );
|
||||
ok( defined $uid, "append test message to $target with date (uid=$uid)" );
|
||||
ok( $imap->delete_message($uid), "delete_message $uid" );
|
||||
ok( $imap->uidexpunge($uid), "uidexpunge $uid" );
|
||||
|
||||
$imap->Uid($ouid);
|
||||
}
|
||||
|
||||
# test append
|
||||
{
|
||||
my $uid = $imap->append( $target, $testmsg );
|
||||
ok( defined $uid, "append test message to $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 == server size" );
|
||||
|
||||
{
|
||||
my $var;
|
||||
ok( $imap->message_to_file( \$var, $msg ), "to SCALAR ref" );
|
||||
cmp_ok( length($var), '==', $size, "correct size" );
|
||||
|
||||
my ( $fh, $fn ) = tempfile UNLINK => 1;
|
||||
ok( $imap->message_to_file( $fn, $msg ), "to file $fn" );
|
||||
|
||||
cmp_ok( -s $fn, '==', $size, "correct size" );
|
||||
}
|
||||
|
||||
cmp_ok( $size, '==', $append_file_size, "size matches string/file" );
|
||||
|
||||
# save first message/folder for use below...
|
||||
#OFF ok( $imap->delete($target), "delete folder $target" );
|
||||
}
|
||||
|
||||
#OFF ok( $imap->create($target), "create target" );
|
||||
ok( $imap->exists($target), "exists $target" );
|
||||
ok( $imap->create($target2), "create $target2" );
|
||||
ok( $imap->exists($target2), "exists $target2" );
|
||||
|
||||
{
|
||||
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->select($target), "select $target" );
|
||||
|
||||
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, "$new_args{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" );
|
||||
}
|
||||
|
||||
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_relaxed_logout($im2);
|
||||
|
||||
# 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" );
|
||||
|
||||
ok_relaxed_logout($imap);
|
||||
|
||||
# Test STARTTLS - an optional feature so tests always succeed
|
||||
{
|
||||
$imap->connect( Starttls => 1 );
|
||||
ok( 1, "OPTIONAL connect(Starttls=>1)" . ( $@ ? ": (error) $@ " : "" ) );
|
||||
}
|
||||
|
||||
# LOGOUT
|
||||
# - on successful LOGOUT $code is OK (not BYE!) see RFC 3501 sect 7.1.5
|
||||
# however some servers return BYE instead so we let that pass here...
|
||||
sub ok_relaxed_logout {
|
||||
my $imap = shift;
|
||||
local ($@);
|
||||
my $rc = $imap->logout;
|
||||
my $err = $imap->LastError || "";
|
||||
ok( ( $rc or $err =~ /^\* BYE/ ), "logout" . ( $err ? ": $err" : "" ) );
|
||||
}
|
||||
76
Mail-IMAPClient-3.27/t/body_string.t
Normal file
76
Mail-IMAPClient-3.27/t/body_string.t
Normal file
|
|
@ -0,0 +1,76 @@
|
|||
#!/usr/bin/perl
|
||||
#
|
||||
# tests for body_string()
|
||||
#
|
||||
# body_string() calls fetch() internally. rather than refactor
|
||||
# body_string() just for testing, we subclass M::IC and use the
|
||||
# overidden fetch() to feed it test data.
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use IO::Socket qw(:crlf);
|
||||
use Test::More tests => 3;
|
||||
|
||||
BEGIN { use_ok('Mail::IMAPClient') or exit; }
|
||||
|
||||
my @tests = (
|
||||
[
|
||||
"simple fetch",
|
||||
[
|
||||
'12 FETCH 1 BODY[TEXT]',
|
||||
'* 1 FETCH (FLAGS (\\Seen \\Recent) BODY[TEXT]',
|
||||
"This is a test message$CRLF" . "Line Z (last line)$CRLF",
|
||||
")$CRLF",
|
||||
"12 OK Fetch completed.$CRLF",
|
||||
],
|
||||
[ 1 ],
|
||||
"This is a test message$CRLF" . "Line Z (last line)$CRLF",
|
||||
],
|
||||
|
||||
# 2010-05-27: test for bug reported by Heiko Schlittermann
|
||||
[
|
||||
"uwimap IMAP4rev1 2007b.404 fetch unseen",
|
||||
[
|
||||
'4 FETCH 1 BODY[TEXT]',
|
||||
'* 1 FETCH (BODY[TEXT]',
|
||||
"This is a test message$CRLF" . "Line Z (last line)$CRLF",
|
||||
")$CRLF",
|
||||
"* 1 FETCH (FLAGS (\\Recent \\Seen)$CRLF",
|
||||
"4 OK Fetch completed$CRLF",
|
||||
],
|
||||
[ 1 ],
|
||||
"This is a test message$CRLF" . "Line Z (last line)$CRLF",
|
||||
],
|
||||
);
|
||||
|
||||
package Test::Mail::IMAPClient;
|
||||
|
||||
use base 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->body_string(@$request);
|
||||
is_deeply( $r, $response, $comment );
|
||||
}
|
||||
}
|
||||
|
||||
my $imap = Test::Mail::IMAPClient->new( Uid => 0, Debug => 0 );
|
||||
|
||||
run_tests( $imap, \@tests );
|
||||
117
Mail-IMAPClient-3.27/t/bodystructure.t
Normal file
117
Mail-IMAPClient-3.27/t/bodystructure.t
Normal file
File diff suppressed because one or more lines are too long
250
Mail-IMAPClient-3.27/t/fetch_hash.t
Normal file
250
Mail-IMAPClient-3.27/t/fetch_hash.t
Normal file
|
|
@ -0,0 +1,250 @@
|
|||
#!/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 => 19;
|
||||
|
||||
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}, }, },
|
||||
],
|
||||
[
|
||||
"escaped subject",
|
||||
[ q{* 1 FETCH (UID 1 X-SAVEDATE "28-Jan-2011 16:52:31 -0500" FLAGS (\Seen) ENVELOPE ("Fri, 28 Jan 2011 00:03:30 -0500" "foo \\"bar\\" baz\'s" (("Phil Pearl" NIL "phil" "dom.loc")) (("Phil Pearl" NIL "phil" "dom.loc")) (("Phil Pearl" NIL "phil" "dom.loc")) ((NIL NIL "phil" "dom.loc")) NIL NIL NIL "<msgid>")) } ],
|
||||
[ [1], qw(UID X-SAVEDATE FLAGS ENVELOPE) ],
|
||||
{
|
||||
"1" => {
|
||||
'X-SAVEDATE' => '28-Jan-2011 16:52:31 -0500',
|
||||
'UID' => '1',
|
||||
'FLAGS' => '\\Seen',
|
||||
'ENVELOPE' => q{"Fri, 28 Jan 2011 00:03:30 -0500" "foo \\"bar\\" baz\'s" (("Phil Pearl" NIL "phil" "dom.loc")) (("Phil Pearl" NIL "phil" "dom.loc")) (("Phil Pearl" NIL "phil" "dom.loc")) ((NIL NIL "phil" "dom.loc")) NIL NIL NIL "<msgid>"}
|
||||
},
|
||||
},
|
||||
],
|
||||
[
|
||||
"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} || [];
|
||||
}
|
||||
sub Escaped_results {
|
||||
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.27/t/messageset.t
Normal file
37
Mail-IMAPClient-3.27/t/messageset.t
Normal 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.27/t/pod.t
Normal file
10
Mail-IMAPClient-3.27/t/pod.t
Normal 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.27/t/simple.t
Normal file
36
Mail-IMAPClient-3.27/t/simple.t
Normal 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.27/t/thread.t
Normal file
30
Mail-IMAPClient-3.27/t/thread.t
Normal 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 );
|
||||
Loading…
Add table
Add a link
Reference in a new issue