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