web UI

diff --git a/lib/App/EzPz/Web.pm b/lib/App/EzPz/Web.pm
new file mode 100644 (file)
index 0000000..3b0f4a2
--- /dev/null
+++ b/lib/App/EzPz/Web.pm
@@ -0,0 +1,159 @@
+package App::EzPz::Web;
+
+use Module::Runtime qw(use_module);
+use App::EzPz::UserStore;
+use HTML::Zoom;
+use Web::Simple;
+
+has users => (is => 'lazy');
+
+sub _build_users {
+  my ($self) = @_;
+  my $config = $self->config;
+  return App::EzPz::UserStore->new(
+    htpasswd_file => $config->{htpasswd_file},
+    ($config->{ezmlm_bindir}
+      ? (ezmlm_config => {
+           bindir => $config->{ezmlm_bindir},
+           list_base_dir => $config->{list_base_dir},
+        })
+      : ())
+  );
+}
+
+sub default_config {
+  (
+    htpasswd_file => 'test-config/htpasswd',
+    ezmlm_bindir => 'test-ezmlm/bin',
+    list_base_dir => 'test-lists',
+  )
+}
+
+sub dispatch_request {
+  my ($self) = @_;
+  my $users = $self->users;
+  my $current_user;
+  sub () {
+    return if $_[PSGI_ENV]->{REMOTE_USER};
+    return use_module('Plack::Middleware::Auth::Basic')->new(
+      authenticator => sub { $users->check_password(@_) }
+    )
+  },
+  sub () {
+    $current_user = $users->get(my $name = $_[PSGI_ENV]->{REMOTE_USER});
+    return [
+      401, [ 'Content-type' => 'text/plain' ], [ "No such user $name" ]
+    ] unless $current_user;
+    return;
+  },
+  sub (/) {
+    $self->_render_front_page($current_user);
+  },
+  sub (/list/*/...) {
+    my $list = $current_user->get_list($_[1]);
+    return unless $list;
+    sub (/) {
+      $self->_list_dispatchers($list),
+      sub () { $self->_render_list_page($list) };
+    },
+    sub (/deny/|/allow/|/mod/|/digest/) {
+      sub (/*/) {
+        my $sublist = $list->${\$_[1]};
+        $self->_list_dispatchers($sublist),
+        sub () { $self->_render_sublist_page($sublist) };
+      },
+    },
+  }
+}
+
+sub _list_dispatchers {
+  my ($self, $list) = @_;
+  sub (POST) {
+    sub (%add=) {
+      $list->add_member($_[1]);
+      return;
+    },
+    sub (%remove=) {
+      $list->remove_member($_[1]);
+      return;
+    },
+  }
+}
+
+sub _zoom_for {
+  my ($self, $name) = @_;
+  my $my_file = __FILE__;
+  $my_file =~ s/\.pm//;
+  return HTML::Zoom->from_file("${my_file}/_templates/${name}.html");
+}
+
+sub _render_page {
+  my ($self, $name, $code) = @_;
+  return [
+    200, [ 'Content-type' => 'text/html' ],
+    [ $self->_zoom_for($name)->${\sub { local $_ = $_[0]; &$code }}->to_html ]
+  ];
+}
+
+sub _render_front_page {
+  my ($self, $user) = @_;
+  return $self->_render_page(index => sub {
+    $_->replace_content('.user-name',$user->username)
+      ->repeat('.list', [
+          map {
+            my $name = $_;
+            sub {
+              $_->select('.list-link')
+                ->replace_content($name)
+                ->then
+                ->set_attribute(href => "/list/${name}/");
+            }
+          } $user->list_names
+        ]);
+  });
+}
+
+sub _render_list_page {
+  my ($self, $list) = @_;
+  $self->_render_listcore_page(
+    $list, [
+      map [ ucfirst($_)." list", "${_}/" ], qw(allow deny mod digest)
+    ]
+  );
+}
+
+sub _render_sublist_page {
+  my ($self, $list) = @_;
+  $self->_render_listcore_page(
+    $list, [ [ "Back to list", "../" ] ],
+  );
+}
+
+sub _render_listcore_page {
+  my ($self, $list, $links) = @_;
+  $self->_render_page(list => sub {
+    $_->replace_content('.list-name', $list->name)
+      ->repeat('.list-link', [
+          map {
+            my ($name, $href) = @$_;
+            sub {
+              $_->select('.list-link-anchor')
+                ->replace_content($name)
+                ->then
+                ->set_attribute(href => $href);
+            }
+          } @$links
+        ])
+      ->repeat('.list-member', [
+          map {
+            my $email = $_;
+            sub {
+              $_->replace_content('.list-member-name', $email)
+                ->set_attribute('.list-member-remove', value => $email);
+            }
+          } $list->members
+        ]);
+  });
+}
+
+__PACKAGE__->run_if_script;

diff --git a/lib/App/EzPz/Web/_templates/index.html b/lib/App/EzPz/Web/_templates/index.html
new file mode 100644 (file)
index 0000000..95da92a
--- /dev/null
+++ b/lib/App/EzPz/Web/_templates/index.html
@@ -0,0 +1,11 @@
+<html>
+<body>
+  <h1>Welcome user <span class="user-name" /></h1>
+  <p>
+    Your mailing lists:
+  </p>
+  <ul>
+    <li class="list"><a class="list-link" /></li>
+  </ul>
+</body>
+</html>

diff --git a/lib/App/EzPz/Web/_templates/list.html b/lib/App/EzPz/Web/_templates/list.html
new file mode 100644 (file)
index 0000000..acff572
--- /dev/null
+++ b/lib/App/EzPz/Web/_templates/list.html
@@ -0,0 +1,21 @@
+<html>
+<body>
+  <h1>List <span class="list-name" /></h1>
+  <ul>
+    <li class="list-link"><a class="list-link-anchor" /></li>
+  </ul>
+  <p>Members:</p>
+  <form method="POST">
+    <p>Add member: <input name="add" /> <input value="Add" type="submit" /></p>
+  </form>
+  <ul>
+    <li class="list-member">
+      <form method="POST">
+        <span class="list-member-name" />
+        <input class="list-member-remove" type="hidden" name="remove" />
+        <input value="Remove" type="submit" />
+      </form>
+    </li>
+  </ul>
+</body>
+</html>

diff --git a/lib/Email/EzPz/List.pm b/lib/Email/EzPz/List.pm
index 1b60894..d8b81e9 100644 (file)
--- a/lib/Email/EzPz/List.pm
+++ b/lib/Email/EzPz/List.pm
@@ -5,6 +5,10 @@ use Moo;
 
 with 'Email::EzPz::ListCore';
 
+has name => (is => 'lazy');
+
+sub _build_name { (shift->list_dir =~ m{/([^/]+)$})[0] }
+
 sub sublist_type { () }
 
 foreach my $type (qw(allow deny mod digest)) {
@@ -19,7 +23,8 @@ sub _build_sublist {
   my ($self, $type) = @_;
   return use_module('Email::EzPz::SubList')->new(
     (map +($_ => $self->$_), qw(list_dir ezmlm_bindir)),
-    sublist_type => $type
+    sublist_type => $type,
+    name => $self->name." ${type} list"
   );
 }
 

diff --git a/lib/Email/EzPz/SubList.pm b/lib/Email/EzPz/SubList.pm
index 8f80726..00acfce 100644 (file)
--- a/lib/Email/EzPz/SubList.pm
+++ b/lib/Email/EzPz/SubList.pm
@@ -2,6 +2,8 @@ package Email::EzPz::SubList;
 
 use Moo;
 
+has name => (is => 'ro', required => 1);
+
 has sublist_type => (is => 'ro', required => 1);
 
 with 'Email::EzPz::ListCore';