defaults use the test setup

[scpubgit/App-EzPz.git] / lib / App / EzPz / Web.pm

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-setup/lists/htpasswd',
    ezmlm_bindir => 'test-setup/ezmlm/bin',
    list_base_dir => 'test-setup/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;
    my $error;
    sub (/) {
      $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, \$error),
        sub () { $self->_render_sublist_page($sublist, $error) };
      },
    },
  }
}

sub _list_dispatchers {
  my ($self, $list, $error_ref) = @_;
  sub (POST) {
    sub (%add=) {
      eval { $list->add_member($_[1]); 1 }
        or ${$error_ref} = $@;
      return;
    },
    sub (%remove=) {
      eval { $list->remove_member($_[1]); 1 }
        or ${$error_ref} = $@;
      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 {
  shift->_render_listcore_page(
    @_, [
      map [ ucfirst($_)." list", "${_}/" ], qw(allow deny mod digest)
    ]
  );
}

sub _render_sublist_page {
  shift->_render_listcore_page(
    @_, [ [ "Back to list", "../" ] ],
  );
}

sub _render_listcore_page {
  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) = @$_;
            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;