X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FApp%2FEzPz%2FWeb.pm;fp=lib%2FApp%2FEzPz%2FWeb.pm;h=3b0f4a21f994e832f915164625cbdb815489f30e;hb=e191c67dedfa1ef6ef4278a4a088535bc880fc06;hp=0000000000000000000000000000000000000000;hpb=6a99a8c7e0ba1b91f2197dce11bf72aa88f8cda8;p=scpubgit%2FApp-EzPz.git

diff --git a/lib/App/EzPz/Web.pm b/lib/App/EzPz/Web.pm
new file mode 100644
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;