mirror of
https://github.com/imapsync/imapsync.git
synced 2025-06-11 07:04:36 +02:00
1.267
This commit is contained in:
Nick Bebout
parent
c09ef20a65
commit
36bfe4238a
46 changed files with 30656 additions and 73 deletions
303
Mail-IMAPClient-3.10/t/basic.t
Executable file
303
Mail-IMAPClient-3.10/t/basic.t
Executable file
|
|
@ -0,0 +1,303 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
use Test::More;
|
||||
use File::Temp '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';
|
||||
|
||||
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;
|
||||
|
||||
foreach my $p ( qw/server user passed/ )
|
||||
{ $parms{$p}
|
||||
or plan skip_all => "missing value for $p"
|
||||
}
|
||||
|
||||
plan tests => 49;
|
||||
}
|
||||
|
||||
use_ok('Mail::IMAPClient');
|
||||
|
||||
my $imap = Mail::IMAPClient->new
|
||||
( Server => $parms{server}
|
||||
, Port => $parms{port}
|
||||
, User => $parms{user}
|
||||
, Password => $parms{passed}
|
||||
, Authmechanism => $parms{authmech}
|
||||
, Clear => 0
|
||||
, Fast_IO => $fast
|
||||
, Uid => $uidplus
|
||||
, Range => $range
|
||||
|
||||
, Debug => $debug
|
||||
, 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 that nifty Mail::IMAPClient module from CPAN. Like
|
||||
all things perl, it's way cool.
|
||||
__TEST_MSG
|
||||
|
||||
my $sep = $imap->separator;
|
||||
ok(defined $sep, "separator is '$sep'");
|
||||
|
||||
my $isparent = $imap->is_parent('INBOX');
|
||||
my ($target, $target2) = $isparent
|
||||
? ("INBOX${sep}IMAPClient_$$", "INBOX${sep}IMAPClient_2_$$")
|
||||
: ("IMAPClient_$$", "IMAPClient_2_$$");
|
||||
|
||||
ok(1, "parent $isparent, target $target");
|
||||
|
||||
ok($imap->select('inbox'), "select inbox");
|
||||
ok($imap->create($target), "create target");
|
||||
|
||||
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( eval {$imap->create( qq[ $target${sep}has "quotes" ] )} )
|
||||
{ ok(1, "supports quotes, create");
|
||||
ok($imap->select( qq[$target${sep}has "quotes"] ), 'select');
|
||||
$imap->close;
|
||||
$imap->select('inbox');
|
||||
ok($imap->delete(qq($target${sep}has "quotes")), 'delete');
|
||||
}
|
||||
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 = ref $uid ? ($imap->search("ALL"))[0] : $uid;
|
||||
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");
|
||||
ok(!defined $fields, '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 $h = $imap->parse_headers(1, "Subject");
|
||||
ok($h, "got subject");
|
||||
like($h->{Subject}[0], qr/^Testing from pid/);
|
||||
|
||||
ok($imap->select($target), "select $target");
|
||||
my @hits = $imap->search(SUBJECT => 'Testing');
|
||||
cmp_ok(scalar @hits, '==', 1, 'hit subject Testing');
|
||||
ok(defined $hits[0]);
|
||||
|
||||
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);
|
||||
|
||||
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);
|
||||
|
||||
$imap->select($target2);
|
||||
ok( $imap->delete_message(scalar($imap->search("ALL")))
|
||||
&& $imap->close
|
||||
&& $imap->delete($target2) , "delete $target2");
|
||||
|
||||
$imap->select("INBOX");
|
||||
$@ = "";
|
||||
@hits = $imap->search
|
||||
(BEFORE => Mail::IMAPClient::Rfc2060_date(time), "UNDELETED");
|
||||
ok(!$@, "search undeleted: $@");
|
||||
|
||||
#
|
||||
# Test migrate method
|
||||
#
|
||||
|
||||
my $im2 = Mail::IMAPClient->new
|
||||
( Server => $parms{server}
|
||||
, Port => $parms{port}
|
||||
, User => $parms{user}
|
||||
, Password=> $parms{passed}
|
||||
, Authmechanism => $parms{authmechanism}
|
||||
, Clear => 0,
|
||||
, Timeout => 30,
|
||||
, Debug => $debug
|
||||
, Debug_fh => ($debug ? IO::File->new(">./imap2.debug") : undef)
|
||||
, Fast_IO => $fast
|
||||
, Uid => $uidplus
|
||||
);
|
||||
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: $@";
|
||||
|
||||
cmp_ok($@, 'eq', '');
|
||||
|
||||
#
|
||||
#
|
||||
#
|
||||
|
||||
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
|
||||
}
|
||||
|
||||
cmp_ok($@, 'eq', '');
|
||||
cmp_ok($total_bytes1, '==', $total_bytes2, 'size source==target');
|
||||
|
||||
# cleanup
|
||||
$im2->select($migtarget);
|
||||
$im2->delete_message(@{$im2->messages})
|
||||
if $im2->message_count;
|
||||
$im2->close;
|
||||
$im2->delete($migtarget);
|
||||
$im2->logout;
|
||||
|
||||
#
|
||||
# Test IDLE
|
||||
#
|
||||
|
||||
if($imap->has_capability("IDLE") )
|
||||
{ eval { my $idle = $imap->idle; sleep 1; $imap->done($idle) };
|
||||
cmp_ok($@, 'eq', '');
|
||||
}
|
||||
else
|
||||
{ ok(1, "idle not supported");
|
||||
}
|
||||
|
||||
$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) ;
|
||||
}
|
||||
Loading…
Add table
Add a link
Reference in a new issue