#!/usr/bin/perl my $uid; 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 = 0; BEGIN { open TST, 'test.txt' or plan skip_all => 'test parameters not provided'; while(my $l = ) { chomp $l; my($p,$v) = split /\=/, $l, 2; s/(?:^\s+)|(?:\s+$)//g 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 $_" } plan tests => 40; } use_ok('Mail::IMAPClient'); my $imap = Mail::IMAPClient->new ( Server => $parms{server} , Port => $parms{port} , User => $parms{user} , Password => $parms{passed} , Authmechanism => $parms{authmechanism} , Clear => 0 , Timeout => 30 , Fast_IO => $fast , Uid => $uidplus , Range => $range , Debug => 1 , Debug_fh => ($debug ? IO::File->new('imap1.debug', 'w') : undef) ); ok(defined $imap, 'created client'); 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") || 0; 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"); $uid = $imap->append($target, $testmsg); ok(defined $uid, "append test message to $target"); ok($imap->select($target), "select $target"); $target = ref $uid ? ($imap->search("ALL"))[0] : $uid; my $size = $imap->size($target); cmp_ok($size, '>', 0, "has size $size"); my $string = $imap->message_string($target); ok($string, "returned string"); cmp_ok($size, '==', length($string), "string has size"); { my ($fh, $fn) = tempfile UNLINK => 1; ok($imap->message_to_file($fn, $target), "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/); $imap->select($target); my @hits = $imap->search(SUBJECT => 'Testing'); cmp_ok(scalar @hits, '==', 1); 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); $flagflag = 0; foreach my $v (values(%$flaghash)){ $flagflag += grep /\\Deleted/, @$v; } cmp_ok($flagflag, '==', scalar @hits); $imap->select($target2); ok( $imap->delete_message(scalar($imap->search("ALL"))) && $imap->close && imap->delete($target2) , "delete $target2"); $imap->select("INBOX"); $@ = ""; # clear $@ @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($@, '==', ''); 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) ; }