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 (/) { |
2603aa88 |
57 | $self->_list_dispatchers($current_user, $list, \$error), |
0a0e9549 |
58 | sub () { $self->_render_list_page($list, $error) }; |
e191c67d |
59 | }, |
60 | sub (/deny/|/allow/|/mod/|/digest/) { |
61 | sub (/*/) { |
62 | my $sublist = $list->${\$_[1]}; |
2603aa88 |
63 | $self->_list_dispatchers($current_user, $sublist, \$error), |
0a0e9549 |
64 | sub () { $self->_render_sublist_page($sublist, $error) }; |
e191c67d |
65 | }, |
66 | }, |
67 | } |
68 | } |
69 | |
2603aa88 |
70 | sub audit_action { |
71 | my ($self, $user, $list, $action, $on) = @_; |
72 | print STDERR "${user} called ${action} ${on} for ${list}\n"; |
73 | } |
74 | |
e191c67d |
75 | sub _list_dispatchers { |
2603aa88 |
76 | my ($self, $current_user, $list, $error_ref) = @_; |
77 | my $name = $current_user->username; |
e191c67d |
78 | sub (POST) { |
79 | sub (%add=) { |
2603aa88 |
80 | $self->audit_action($name, $list->name, 'add', $_[1]); |
0a0e9549 |
81 | eval { $list->add_member($_[1]); 1 } |
82 | or ${$error_ref} = $@; |
e191c67d |
83 | return; |
84 | }, |
85 | sub (%remove=) { |
2603aa88 |
86 | $self->audit_action($name, $list->name, 'remove', $_[1]); |
0a0e9549 |
87 | eval { $list->remove_member($_[1]); 1 } |
88 | or ${$error_ref} = $@; |
e191c67d |
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 { |
0a0e9549 |
128 | shift->_render_listcore_page( |
129 | @_, [ |
e191c67d |
130 | map [ ucfirst($_)." list", "${_}/" ], qw(allow deny mod digest) |
131 | ] |
132 | ); |
133 | } |
134 | |
135 | sub _render_sublist_page { |
0a0e9549 |
136 | shift->_render_listcore_page( |
137 | @_, [ [ "Back to list", "../" ] ], |
e191c67d |
138 | ); |
139 | } |
140 | |
141 | sub _render_listcore_page { |
0a0e9549 |
142 | my ($self, $list, $error, $links) = @_; |
e191c67d |
143 | $self->_render_page(list => sub { |
144 | $_->replace_content('.list-name', $list->name) |
0a0e9549 |
145 | ->replace_content('.error', $error||'') |
e191c67d |
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; |