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 | ( |
3b638626 |
26 | htpasswd_file => 'test-setup/lists/htpasswd', |
27 | ezmlm_bindir => 'test-setup/ezmlm/bin', |
28 | list_base_dir => 'test-setup/lists', |
e191c67d |
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; |
0a0e9549 |
55 | my $error; |
e191c67d |
56 | sub (/) { |
0a0e9549 |
57 | $self->_list_dispatchers($list, \$error), |
58 | sub () { $self->_render_list_page($list, $error) }; |
e191c67d |
59 | }, |
60 | sub (/deny/|/allow/|/mod/|/digest/) { |
61 | sub (/*/) { |
62 | my $sublist = $list->${\$_[1]}; |
0a0e9549 |
63 | $self->_list_dispatchers($sublist, \$error), |
64 | sub () { $self->_render_sublist_page($sublist, $error) }; |
e191c67d |
65 | }, |
66 | }, |
67 | } |
68 | } |
69 | |
70 | sub _list_dispatchers { |
0a0e9549 |
71 | my ($self, $list, $error_ref) = @_; |
e191c67d |
72 | sub (POST) { |
73 | sub (%add=) { |
0a0e9549 |
74 | eval { $list->add_member($_[1]); 1 } |
75 | or ${$error_ref} = $@; |
e191c67d |
76 | return; |
77 | }, |
78 | sub (%remove=) { |
0a0e9549 |
79 | eval { $list->remove_member($_[1]); 1 } |
80 | or ${$error_ref} = $@; |
e191c67d |
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 { |
0a0e9549 |
120 | shift->_render_listcore_page( |
121 | @_, [ |
e191c67d |
122 | map [ ucfirst($_)." list", "${_}/" ], qw(allow deny mod digest) |
123 | ] |
124 | ); |
125 | } |
126 | |
127 | sub _render_sublist_page { |
0a0e9549 |
128 | shift->_render_listcore_page( |
129 | @_, [ [ "Back to list", "../" ] ], |
e191c67d |
130 | ); |
131 | } |
132 | |
133 | sub _render_listcore_page { |
0a0e9549 |
134 | my ($self, $list, $error, $links) = @_; |
e191c67d |
135 | $self->_render_page(list => sub { |
136 | $_->replace_content('.list-name', $list->name) |
0a0e9549 |
137 | ->replace_content('.error', $error||'') |
e191c67d |
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; |