error handling and tests therefore

[scpubgit/App-EzPz.git] / t / lists.t

use if (!-d 'test-setup'), 'Test::More', skip_all => 'List testing skipped';
use Test::More;
use IO::All;
use App::EzPz::TestSetup;
use App::EzPz::UserStore;
use App::EzPz::Web;
use strictures 1;

unless (-d 'test-setup/ezmlm') {
  create_install(
    'src/ezmlm-idx-7.1.1.tar.gz',
    'test-setup/build',
    'test-setup/ezmlm'
  );
}

my $lists_base = io->dir('test-setup/lists');

$lists_base->rmtree;
$lists_base->mkpath;

create_list('test-setup/ezmlm/bin', 'test-setup/lists', $_)
  for qw(list1 list2 list3);

pass('Setup completed successfully');

my $us = App::EzPz::UserStore->new(
  htpasswd_file => 'test-setup/lists/htpasswd',
  ezmlm_config => {
    bindir => 'test-setup/ezmlm/bin',
    list_base_dir => 'test-setup/lists'
  }
);

for my $user ($us->add({ username => 'mst', password => 'boromir' })) {
  $user->add_list_name($_) for qw(list1 list2 list3);
  for my $list ($user->get_list('list1')) {
    $list->add_member('joe@example.com');
    $list->add_member('bob@example.com');
    $list->deny->add_member('evil@monkey.com');
    $list->deny->add_member('evil@gibbon.com');
  }
}

my $app = App::EzPz::Web->new(users => $us);

is($app->run_test_request(GET => '/')->code, 401, 'Auth fail without pw');

is(
  $app->run_test_request(GET => 'bob:boromir@/')->code, 401,
  'Auth fail with wrong user'
);

is(
  $app->run_test_request(GET => 'mst:spoon@/')->code, 401,
  'Auth fail with wrong pw'
);

my $res = $app->run_test_request(GET => 'mst:boromir@/');

is($res->code, 200, 'Auth ok with user+pass');

like($res->content, qr/Welcome user .*mst/, 'Welcome mst');

like($res->content, qr{/list/$_/}, "List $_ on /")
  for qw(list1 list2 list3);

$res = $app->run_test_request(GET => 'mst:boromir@/list/list1/');

like($res->content, qr{name="remove" value="$_"}, "Member $_ ok")
  for qw(bob@example.com joe@example.com);

$res = $app->run_test_request(GET => 'mst:boromir@/list/list1/deny/');

like($res->content, qr{name="remove" value="$_"}, "Member $_ ok")
  for qw(evil@monkey.com evil@gibbon.com);

$res = $app->run_test_request(
  POST => 'mst:boromir@/list/list1/deny/', add => 'hamster'
);

like(
  $res->content, qr{address does not contain \@},
  'And your father smells of elderberries'
);

$res = $app->run_test_request(
  POST => 'mst:boromir@/list/list1/deny/', add => 'evil@marmoset.com'
);

like($res->content, qr{name="remove" value="$_"}, "Member $_ ok")
  for qw(evil@monkey.com evil@gibbon.com evil@marmoset.com);

$res = $app->run_test_request(
  POST => 'mst:boromir@/list/list1/deny/', remove => 'evil@monkey.com'
);

like($res->content, qr{name="remove" value="$_"}, "Member $_ ok")
  for qw(evil@gibbon.com evil@marmoset.com);

unlike($res->content, qr{name="remove" value="$_"}, "Member $_ gone")
  for qw(evil@monkey.com);

done_testing;