lib/App/EzPz/Web.pm

   1 package App::EzPz::Web;
   2
   3 use Module::Runtime qw(use_module);
   4 use App::EzPz::UserStore;
   5 use HTML::Zoom;
   6 use Web::Simple;
   7
   8 has users => (is => 'lazy');
   9
  10 sub _build_users {
  11   my ($self) = @_;
  12   my $config = $self->config;
  13   return App::EzPz::UserStore->new(
  14     htpasswd_file => $config->{htpasswd_file},
  15     ($config->{ezmlm_bindir}
  16       ? (ezmlm_config => {
  17            bindir => $config->{ezmlm_bindir},
  18            list_base_dir => $config->{list_base_dir},
  19         })
  20       : ())
  21   );
  22 }
  23
  24 sub default_config {
  25   (
  26     htpasswd_file => 'test-setup/lists/htpasswd',
  27     ezmlm_bindir => 'test-setup/ezmlm/bin',
  28     list_base_dir => 'test-setup/lists',
  29   )
  30 }
  31
  32 sub dispatch_request {
  33   my ($self) = @_;
  34   my $users = $self->users;
  35   my $current_user;
  36   sub () {
  37     return if $_[PSGI_ENV]->{REMOTE_USER};
  38     return use_module('Plack::Middleware::Auth::Basic')->new(
  39       authenticator => sub { $users->check_password(@_) }
  40     )
  41   },
  42   sub () {
  43     $current_user = $users->get(my $name = $_[PSGI_ENV]->{REMOTE_USER});
  44     return [
  45       401, [ 'Content-type' => 'text/plain' ], [ "No such user $name" ]
  46     ] unless $current_user;
  47     return;
  48   },
  49   sub (/) {
  50     $self->_render_front_page($current_user);
  51   },
  52   sub (/list/*/...) {
  53     my $list = $current_user->get_list($_[1]);
  54     return unless $list;
  55     my $error;
  56     sub (/) {
  57       $self->_list_dispatchers($list, \$error),
  58       sub () { $self->_render_list_page($list, $error) };
  59     },
  60     sub (/deny/|/allow/|/mod/|/digest/) {
  61       sub (/*/) {
  62         my $sublist = $list->${\$_[1]};
  63         $self->_list_dispatchers($sublist, \$error),
  64         sub () { $self->_render_sublist_page($sublist, $error) };
  65       },
  66     },
  67   }
  68 }
  69
  70 sub _list_dispatchers {
  71   my ($self, $list, $error_ref) = @_;
  72   sub (POST) {
  73     sub (%add=) {
  74       eval { $list->add_member($_[1]); 1 }
  75         or ${$error_ref} = $@;
  76       return;
  77     },
  78     sub (%remove=) {
  79       eval { $list->remove_member($_[1]); 1 }
  80         or ${$error_ref} = $@;
  81       return;
  82     },
  83   }
  84 }
  85
  86 sub _zoom_for {
  87   my ($self, $name) = @_;
  88   my $my_file = __FILE__;
  89   $my_file =~ s/\.pm//;
  90   return HTML::Zoom->from_file("${my_file}/_templates/${name}.html");
  91 }
  92
  93 sub _render_page {
  94   my ($self, $name, $code) = @_;
  95   return [
  96     200, [ 'Content-type' => 'text/html' ],
  97     [ $self->_zoom_for($name)->${\sub { local $_ = $_[0]; &$code }}->to_html ]
  98   ];
  99 }
 100
 101 sub _render_front_page {
 102   my ($self, $user) = @_;
 103   return $self->_render_page(index => sub {
 104     $_->replace_content('.user-name',$user->username)
 105       ->repeat('.list', [
 106           map {
 107             my $name = $_;
 108             sub {
 109               $_->select('.list-link')
 110                 ->replace_content($name)
 111                 ->then
 112                 ->set_attribute(href => "/list/${name}/");
 113             }
 114           } $user->list_names
 115         ]);
 116   });
 117 }
 118
 119 sub _render_list_page {
 120   shift->_render_listcore_page(
 121     @_, [
 122       map [ ucfirst($_)." list", "${_}/" ], qw(allow deny mod digest)
 123     ]
 124   );
 125 }
 126
 127 sub _render_sublist_page {
 128   shift->_render_listcore_page(
 129     @_, [ [ "Back to list", "../" ] ],
 130   );
 131 }
 132
 133 sub _render_listcore_page {
 134   my ($self, $list, $error, $links) = @_;
 135   $self->_render_page(list => sub {
 136     $_->replace_content('.list-name', $list->name)
 137       ->replace_content('.error', $error||'')
 138       ->repeat('.list-link', [
 139           map {
 140             my ($name, $href) = @$_;
 141             sub {
 142               $_->select('.list-link-anchor')
 143                 ->replace_content($name)
 144                 ->then
 145                 ->set_attribute(href => $href);
 146             }
 147           } @$links
 148         ])
 149       ->repeat('.list-member', [
 150           map {
 151             my $email = $_;
 152             sub {
 153               $_->replace_content('.list-member-name', $email)
 154                 ->set_attribute('.list-member-remove', value => $email);
 155             }
 156           } $list->members
 157         ]);
 158   });
 159 }
 160
 161 __PACKAGE__->run_if_script;