The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
use lib 't/lib';
use strict;
use warnings;

use Net::IMAP::Server::Test;
my $t = "Net::IMAP::Server::Test";

$t->start_server_ok;
$t->connect_ok;

$t->cmd_like("CREATE foo" => "tag BAD Log in first" );

$t->cmd_ok("LOGIN username password");

$t->cmd_like("CREATE" => "tag BAD Not enough options" );
$t->cmd_like("CREATE foo bar" => "tag BAD Too many options" );

# We assume a "/" separator here
my $res = $t->cmd_ok( 'LIST "" ""');
ok($res =~ m{^\* LIST \(\\Noselect\) "/" ""\r\n}m, "Separator is /");

# Check starting state
my %mailboxes = $t->mailbox_list;
is(delete $mailboxes{"INBOX"}, "\\HasChildren",
   "INBOX exists");
is(delete $mailboxes{"INBOX/username"}, "\\HasNoChildren",
   "INBOX/username exists");
is(keys %mailboxes, 0, "No other mailboxes");

# Create a new top-level mailbox
$t->cmd_ok("CREATE moose");
%mailboxes = $t->mailbox_list;
is(delete $mailboxes{"moose"}, "\\HasNoChildren",
   "moose now exists");
is(keys %mailboxes, 2, "No other mailboxes created");

# Creating a subfolder marks the parent as \HasChildren
$t->cmd_ok("CREATE moose/thingy");
%mailboxes = $t->mailbox_list;
is($mailboxes{"moose"}, "\\HasChildren",
   "moose now has children");
is($mailboxes{"moose/thingy"}, "\\HasNoChildren",
   "moose/thingy now exists");

# Creating a folder with a trailing separator strips it off
$t->cmd_ok("CREATE trailing/");
%mailboxes = $t->mailbox_list;
is(delete $mailboxes{"trailing"}, "\\HasNoChildren",
   "Trailing slash is removed");
is(keys %mailboxes, 4, "No other mailboxes created");

# Creating a deep mailbox creates all of its parents
$t->cmd_ok("CREATE deeply/nested/folder");
%mailboxes = $t->mailbox_list;
is(delete $mailboxes{"deeply"}, "\\HasChildren",
   "First level created");
is(delete $mailboxes{"deeply/nested"}, "\\HasChildren",
   "Second level created");
is(delete $mailboxes{"deeply/nested/folder"}, "\\HasNoChildren",
   "Third level created");

# Invalid IMAP-UTF-7 fails
$t->cmd_like('CREATE "INBOX/&Jjo!"', qr/BAD Invalid UTF-7/ );
$t->cmd_like('CREATE "INBOX/&U,BTFw-&ZeVnLIqe-"', qr/BAD Invalid UTF-7/ );

# UTF-8 mailbox names fail
$t->cmd_like(qq{CREATE "INBOX/\x{2668}"}, qr/BAD Mailbox name contains 8-bit data/);

# Creating over an existing mailbox fails
$t->cmd_like("CREATE moose" => qr/NO Mailbox already exists/);

# This is true even for the magic case-insensitive INBOX
$t->cmd_like("CREATE INBOX" => qr/NO Mailbox already exists/);
$t->cmd_like("CREATE InBoX" => qr/NO Mailbox already exists/);

done_testing;