mirror of
https://github.com/imapsync/imapsync.git
synced 2024-11-17 00:02:29 +01:00
282 lines
8.2 KiB
Perl
282 lines
8.2 KiB
Perl
#!/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 => 20;
|
|
|
|
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 ENVELOPE 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"},
|
|
q{foo "bar\\" (baz\\)},
|
|
q{ (("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\\\\)" (("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>"}
|
|
},
|
|
},
|
|
],
|
|
[
|
|
"non-escaped BODY[HEADER.FIELDS (...)]",
|
|
[
|
|
q{* 1 FETCH (UID 1 FLAGS () BODY[HEADER.FIELDS (TO FROM SUBJECT DATE)]},
|
|
'From: Phil Pearl (Lobbes) <phil+from@perkpartners.com>
|
|
To: phil+to@perkpartners.com
|
|
Subject: foo "bar\" (baz\)
|
|
Date: Sat, 22 Jan 2011 20:43:58 -0500
|
|
|
|
'
|
|
],
|
|
[ [1], ( qw(FLAGS), 'BODY[HEADER.FIELDS (TO FROM SUBJECT DATE)]' ) ],
|
|
{
|
|
'1' => {
|
|
'BODY[HEADER.FIELDS (TO FROM SUBJECT DATE)]' =>
|
|
'From: Phil Pearl (Lobbes) <phil+from@perkpartners.com>
|
|
To: phil+to@perkpartners.com
|
|
Subject: foo "bar\" (baz\)
|
|
Date: Sat, 22 Jan 2011 20:43:58 -0500
|
|
|
|
',
|
|
'FLAGS' => '',
|
|
},
|
|
},
|
|
],
|
|
[
|
|
"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 );
|