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($current_user, $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($current_user, $sublist, \$error),
  64         sub () { $self->_render_sublist_page($sublist, $error) };
  65       },
  66     },
  67   }
  68 }
  69
  70 sub audit_action {
  71   my ($self, $user, $list, $action, $on) = @_;
  72   print STDERR "${user} called ${action} ${on} for ${list}\n";
  73 }
  74
  75 sub _list_dispatchers {
  76   my ($self, $current_user, $list, $error_ref) = @_;
  77   my $name = $current_user->username;
  78   sub (POST) {
  79     sub (%add=) {
  80       $self->audit_action($name, $list->name, 'add', $_[1]);
  81       eval { $list->add_member($_[1]); 1 }
  82         or ${$error_ref} = $@;
  83       return;
  84     },
  85     sub (%remove=) {
  86       $self->audit_action($name, $list->name, 'remove', $_[1]);
  87       eval { $list->remove_member($_[1]); 1 }
  88         or ${$error_ref} = $@;
  89       return;
  90     },
  91   }
  92 }
  93
  94 sub _zoom_for {
  95   my ($self, $name) = @_;
  96   my $my_file = __FILE__;
  97   $my_file =~ s/\.pm//;
  98   return HTML::Zoom->from_file("${my_file}/_templates/${name}.html");
  99 }
 100
 101 sub _render_page {
 102   my ($self, $name, $code) = @_;
 103   return [
 104     200, [ 'Content-type' => 'text/html' ],
 105     [ $self->_zoom_for($name)->${\sub { local $_ = $_[0]; &$code }}->to_html ]
 106   ];
 107 }
 108
 109 sub _render_front_page {
 110   my ($self, $user) = @_;
 111   return $self->_render_page(index => sub {
 112     $_->replace_content('.user-name',$user->username)
 113       ->repeat('.list', [
 114           map {
 115             my $name = $_;
 116             sub {
 117               $_->select('.list-link')
 118                 ->replace_content($name)
 119                 ->then
 120                 ->set_attribute(href => "/list/${name}/");
 121             }
 122           } $user->list_names
 123         ]);
 124   });
 125 }
 126
 127 sub _render_list_page {
 128   shift->_render_listcore_page(
 129     @_, [
 130       map [ ucfirst($_)." list", "${_}/" ], qw(allow deny mod digest)
 131     ]
 132   );
 133 }
 134
 135 sub _render_sublist_page {
 136   shift->_render_listcore_page(
 137     @_, [ [ "Back to list", "../" ] ],
 138   );
 139 }
 140
 141 sub _render_listcore_page {
 142   my ($self, $list, $error, $links) = @_;
 143   $self->_render_page(list => sub {
 144     $_->replace_content('.list-name', $list->name)
 145       ->replace_content('.error', $error||'')
 146       ->repeat('.list-link', [
 147           map {
 148             my ($name, $href) = @$_;
 149             sub {
 150               $_->select('.list-link-anchor')
 151                 ->replace_content($name)
 152                 ->then
 153                 ->set_attribute(href => $href);
 154             }
 155           } @$links
 156         ])
 157       ->repeat('.list-member', [
 158           map {
 159             my $email = $_;
 160             sub {
 161               $_->replace_content('.list-member-name', $email)
 162                 ->set_attribute('.list-member-remove', value => $email);
 163             }
 164           } $list->members
 165         ]);
 166   });
 167 }
 168
 169 __PACKAGE__->run_if_script;