From: Matt S Trout <mst@shadowcat.co.uk>
Date: Sun, 15 Jul 2012 22:55:26 +0000 (+0000)
Subject: error handling and tests therefore
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0a0e9549e16b04188b7763226208c69f53d78149;p=scpubgit%2FApp-EzPz.git

error handling and tests therefore
---

diff --git a/Makefile.PL b/Makefile.PL
index af94849..fdccdc6 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -21,6 +21,7 @@ WriteMakefile(
     'Eval::WithLexicals' => 0,
     'IPC::System::Simple' => 0,
     strictures => 0,
-    'File::Which' => 0
+    'File::Which' => 0,
+    'Capture::Tiny' => 0,
   }
 );
diff --git a/lib/App/EzPz/Web.pm b/lib/App/EzPz/Web.pm
index 3b0f4a2..2463657 100644
--- a/lib/App/EzPz/Web.pm
+++ b/lib/App/EzPz/Web.pm
@@ -52,29 +52,32 @@ sub dispatch_request {
   sub (/list/*/...) {
     my $list = $current_user->get_list($_[1]);
     return unless $list;
+    my $error;
     sub (/) {
-      $self->_list_dispatchers($list),
-      sub () { $self->_render_list_page($list) };
+      $self->_list_dispatchers($list, \$error),
+      sub () { $self->_render_list_page($list, $error) };
     },
     sub (/deny/|/allow/|/mod/|/digest/) {
       sub (/*/) {
         my $sublist = $list->${\$_[1]};
-        $self->_list_dispatchers($sublist),
-        sub () { $self->_render_sublist_page($sublist) };
+        $self->_list_dispatchers($sublist, \$error),
+        sub () { $self->_render_sublist_page($sublist, $error) };
       },
     },
   }
 }
 
 sub _list_dispatchers {
-  my ($self, $list) = @_;
+  my ($self, $list, $error_ref) = @_;
   sub (POST) {
     sub (%add=) {
-      $list->add_member($_[1]);
+      eval { $list->add_member($_[1]); 1 }
+        or ${$error_ref} = $@;
       return;
     },
     sub (%remove=) {
-      $list->remove_member($_[1]);
+      eval { $list->remove_member($_[1]); 1 }
+        or ${$error_ref} = $@;
       return;
     },
   }
@@ -114,25 +117,24 @@ sub _render_front_page {
 }
 
 sub _render_list_page {
-  my ($self, $list) = @_;
-  $self->_render_listcore_page(
-    $list, [
+  shift->_render_listcore_page(
+    @_, [
       map [ ucfirst($_)." list", "${_}/" ], qw(allow deny mod digest)
     ]
   );
 }
 
 sub _render_sublist_page {
-  my ($self, $list) = @_;
-  $self->_render_listcore_page(
-    $list, [ [ "Back to list", "../" ] ],
+  shift->_render_listcore_page(
+    @_, [ [ "Back to list", "../" ] ],
   );
 }
 
 sub _render_listcore_page {
-  my ($self, $list, $links) = @_;
+  my ($self, $list, $error, $links) = @_;
   $self->_render_page(list => sub {
     $_->replace_content('.list-name', $list->name)
+      ->replace_content('.error', $error||'')
       ->repeat('.list-link', [
           map {
             my ($name, $href) = @$_;
diff --git a/lib/App/EzPz/Web/_templates/list.html b/lib/App/EzPz/Web/_templates/list.html
index acff572..2a6ebd6 100644
--- a/lib/App/EzPz/Web/_templates/list.html
+++ b/lib/App/EzPz/Web/_templates/list.html
@@ -5,6 +5,7 @@
     <li class="list-link"><a class="list-link-anchor" /></li>
   </ul>
   <p>Members:</p>
+  <p><b class="error" /></p>
   <form method="POST">
     <p>Add member: <input name="add" /> <input value="Add" type="submit" /></p>
   </form>
diff --git a/lib/Email/EzPz/ListCore.pm b/lib/Email/EzPz/ListCore.pm
index b91517d..3cef09e 100644
--- a/lib/Email/EzPz/ListCore.pm
+++ b/lib/Email/EzPz/ListCore.pm
@@ -2,6 +2,7 @@ package Email::EzPz::ListCore;
 
 use Moo::Role;
 use IO::All;
+use Capture::Tiny qw(capture_merged);
 use IPC::System::Simple qw(run capture);
 
 has list_dir => (is => 'ro', required => 1);
@@ -31,7 +32,12 @@ sub _command_args {
 
 sub _call_command {
   my ($self, @cmd) = @_;
-  run $self->_command_args(@cmd);
+  my $ok;
+  my $out = capture_merged {
+    $ok = eval { run $self->_command_args(@cmd); 1 };
+  };
+  die "Command failed: $out\n" unless $ok;
+  return;
 }
 
 sub _capture_command {
diff --git a/t/lists.t b/t/lists.t
index a91e5b2..cd4181f 100644
--- a/t/lists.t
+++ b/t/lists.t
@@ -65,4 +65,40 @@ 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;