#!perl -w # Copyright (C) 2020 all contributors # License: AGPL-3.0+ use strict; use Test::More; use PublicInbox::TestCommon; require_mods('Data::Dumper'); Data::Dumper->import('Dumper'); my $inboxdir = $ENV{GIANT_INBOX_DIR}; (defined($inboxdir) && -d $inboxdir) or plan skip_all => "GIANT_INBOX_DIR not defined for $0"; plan skip_all => "bad characters in $inboxdir" if $inboxdir =~ m![^\w\.\-/]!; my ($tmpdir, $for_destroy) = tmpdir(); my $cfg = "$tmpdir/cfg"; my $mailbox = 'inbox.test'; { open my $fh, '>', $cfg or BAIL_OUT "open: $!"; print $fh < $cfg }; my $td = start_script($cmd, $env, { 3 => $sock }) or BAIL_OUT "-imapd: $?"; my ($host, $port) = ($sock->sockhost, $sock->sockport); my $c = tcp_connect($sock); like(readline($c), qr/CAPABILITY /, 'got greeting'); undef $c; SKIP: { require_mods('Mail::IMAPClient', 3); unless ($ENV{RT_132720_FIXED}) { my $bug = 'https://rt.cpan.org/Ticket/Display.html?id=132720'; skip "<$bug>, RT_132720_FIXED not defined", 3; } my %opt = (Server => $host, Port => $port, User => 'u', Password => 'p', Clear => 1); my $uc = Mail::IMAPClient->new(%opt); my $c = Mail::IMAPClient->new(%opt); ok($c->compress, 'enabled compression'); ok $c->examine($mailbox), 'compressed EXAMINE-ed'; ok $uc->examine($mailbox), 'uncompress EXAMINE-ed'; my $range = $uc->search('all'); for my $uid (@$range) { my $A = $uc->fetch_hash($uid, 'BODY[]'); my $B = $c->fetch_hash($uid, 'BODY[]'); if (!is_deeply($A, $B, "$uid identical")) { diag Dumper([$A, $B]); diag Dumper([$uc, $c]); last; } } $uc->logout; $c->logout; } SKIP: { require_mods('Mail::IMAPTalk', 3); my %opt = (Server => $host, Port => $port, UseSSL => 0, Username => 'u', Password => 'p', Uid => 1); my $uc = Mail::IMAPTalk->new(%opt) or BAIL_OUT 'IMAPTalk->new'; my $c = Mail::IMAPTalk->new(%opt, UseCompress => 1) or BAIL_OUT 'IMAPTalk->new(UseCompress => 1)'; ok $c->examine($mailbox), 'compressed EXAMINE-ed'; ok $uc->examine($mailbox), 'uncompress EXAMINE-ed'; my $range = $uc->search('all'); for my $uid (@$range) { my $A = $uc->fetch($uid, 'rfc822'); my $B = $c->fetch($uid, 'rfc822'); if (!is_deeply($A, $B, "$uid identical")) { diag Dumper([$A, $B]); diag Dumper([$uc, $c]); last; } } } done_testing;