File: | lib/Yukki/Web.pm |
Coverage: | 81.3% |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | package Yukki::Web; | ||||||
2 | |||||||
3 | 1 1 | 7 2 | use v5.24; | ||||
4 | 1 1 1 | 3 1 4 | use utf8; | ||||
5 | 1 1 1 | 217 2891 2 | use Moo; | ||||
6 | |||||||
7 | extends qw( Yukki ); | ||||||
8 | |||||||
9 | 1 1 1 | 789 1349 26 | use Class::Load; | ||||
10 | |||||||
11 | 1 1 1 | 176 2 3 | use Yukki::Error qw( http_throw http_exception ); | ||||
12 | 1 1 1 | 373 3 5 | use Yukki::Types qw( PluginList YukkiWebSettings ); | ||||
13 | 1 1 1 | 610 3 17 | use Yukki::Web::Context; | ||||
14 | 1 1 1 | 182 4 16 | use Yukki::Web::Router; | ||||
15 | 1 1 1 | 184 2 17 | use Yukki::Web::Settings; | ||||
16 | |||||||
17 | 1 1 1 | 2937 11730 19 | use CHI; | ||||
18 | 1 1 1 | 190 9001 33 | use LWP::MediaTypes qw( add_type ); | ||||
19 | 1 1 1 | 156 474 14 | use Plack::Session::Store::Cache; | ||||
20 | 1 1 1 | 3 1 24 | use Scalar::Util qw( blessed weaken ); | ||||
21 | 1 1 1 | 3 1 22 | use Try::Tiny; | ||||
22 | 1 1 1 | 3 1 6 | use Type::Utils; | ||||
23 | |||||||
24 | 1 1 1 | 904 1 5 | use namespace::clean; | ||||
25 | |||||||
26 | # ABSTRACT: the Yukki web server | ||||||
27 | |||||||
28 - 35 | =head1 DESCRIPTION This class handles the work of dispatching incoming requests to the various controllers. =head1 ATTRIBUTES =cut | ||||||
36 | |||||||
37 | has '+settings' => ( | ||||||
38 | isa => YukkiWebSettings, | ||||||
39 | coerce => 1, | ||||||
40 | ); | ||||||
41 | |||||||
42 - 47 | =head2 router This is the L<Path::Router> that will determine where incoming requests are sent. It is automatically set to a L<Yukki::Web::Router> instance. =cut | ||||||
48 | |||||||
49 | has router => ( | ||||||
50 | is => 'ro', | ||||||
51 | isa => class_type('Path::Router'), | ||||||
52 | required => 1, | ||||||
53 | lazy => 1, | ||||||
54 | builder => '_build_router', | ||||||
55 | ); | ||||||
56 | |||||||
57 | sub _build_router { | ||||||
58 | 1 | 9 | my $self = shift; | ||||
59 | 1 | 6 | Yukki::Web::Router->new( app => $self ); | ||||
60 | } | ||||||
61 | |||||||
62 - 70 | =head2 plugins my @plugins = $app->all_plugins; my @format_helpers = $app->format_helper_plugins; my @formatters = $app->format_plugins; This attribute stores all the loaded plugins. =cut | ||||||
71 | |||||||
72 | has plugins => ( | ||||||
73 | is => 'ro', | ||||||
74 | isa => PluginList, | ||||||
75 | required => 1, | ||||||
76 | lazy => 1, | ||||||
77 | builder => '_build_plugins', | ||||||
78 | ); | ||||||
79 | |||||||
80 | sub all_plugins { | ||||||
81 | 0 | 1 | 0 | my $self = shift; | |||
82 | 0 | 0 | $self->plugins->@*; | ||||
83 | } | ||||||
84 | |||||||
85 | sub format_helper_plugins { | ||||||
86 | 0 | 1 | 0 | my $self = shift; | |||
87 | 0 0 | 0 0 | grep { $_->does('Yukki::Web::Plugin::Role::FormatHelper') } | ||||
88 | $self->plugins->@*; | ||||||
89 | } | ||||||
90 | |||||||
91 | sub formatter_plugins { | ||||||
92 | 1 | 1 | 5 | my $self = shift; | |||
93 | 1 3 | 22 269 | grep { $_->does('Yukki::Web::Plugin::Role::Formatter') } | ||||
94 | $self->plugins->@*; | ||||||
95 | } | ||||||
96 | |||||||
97 | sub _build_plugins { | ||||||
98 | 1 | 11 | my $self = shift; | ||||
99 | |||||||
100 | 1 | 3 | my @plugins; | ||||
101 | 1 1 | 2 21 | for my $plugin_settings (@{ $self->settings->plugins }) { | ||||
102 | 3 | 68 | my $module = $plugin_settings->{module}; | ||||
103 | |||||||
104 | 3 | 6 | my $class = $module; | ||||
105 | 3 | 14 | $class = "Yukki::Web::Plugin::$class" unless $class =~ s/^\+//; | ||||
106 | |||||||
107 | 3 | 17 | Class::Load::load_class($class); | ||||
108 | |||||||
109 | 3 | 88 | push @plugins, $class->new(%$plugin_settings, app => $self); | ||||
110 | } | ||||||
111 | |||||||
112 | 1 | 36 | return \@plugins; | ||||
113 | } | ||||||
114 | |||||||
115 - 117 | =head1 METHODS =cut | ||||||
118 | |||||||
119 | sub BUILD { | ||||||
120 | 1 | 0 | 5889 | my $self = shift; | |||
121 | |||||||
122 | 1 | 29 | my $types = $self->settings->media_types; | ||||
123 | 1 | 1700 | while (my ($mime_type, $ext) = each %$types) { | ||||
124 | 1 | 3 | my @ext = ref $ext ? @$ext : ($ext); | ||||
125 | 1 | 4 | add_type($mime_type, @ext); | ||||
126 | } | ||||||
127 | }; | ||||||
128 | |||||||
129 - 133 | =head2 component Helper method used by L</controller> and L</view>. =cut | ||||||
134 | |||||||
135 | sub component { | ||||||
136 | 9 | 1 | 20 | my ($self, $type, $name) = @_; | |||
137 | 9 | 30 | my $class_name = join '::', 'Yukki::Web', $type, $name; | ||||
138 | 9 | 29 | Class::Load::load_class($class_name); | ||||
139 | 9 | 278 | return $class_name->new(app => $self); | ||||
140 | } | ||||||
141 | |||||||
142 - 148 | =head2 controller my $controller = $app->controller($name); Returns an instance of the named L<Yukki::Web::Controller>. =cut | ||||||
149 | |||||||
150 | sub controller { | ||||||
151 | 8 | 1 | 753 | my ($self, $name) = @_; | |||
152 | 8 | 24 | return $self->component(Controller => $name); | ||||
153 | } | ||||||
154 | |||||||
155 - 161 | =head2 view my $view = $app->view($name); Returns an instance of the named L<Yukki::Web::View>. =cut | ||||||
162 | |||||||
163 | sub view { | ||||||
164 | 1 | 1 | 442 | my ($self, $name) = @_; | |||
165 | 1 | 10 | return $self->component(View => $name); | ||||
166 | } | ||||||
167 | |||||||
168 - 176 | =head2 dispatch my $response = $app->dispatch($env); This is a PSGI application in a method call. Given a L<PSGI> environment, maps that to the appropriate controller and fires it. Whether successful or failure, it returns a PSGI response. =cut | ||||||
177 | |||||||
178 | sub dispatch { | ||||||
179 | 3 | 1 | 5 | my ($self, $env) = @_; | |||
180 | |||||||
181 | 3 | 66 | my $ctx = Yukki::Web::Context->new(env => $env); | ||||
182 | |||||||
183 | 3 | 64 | $env->{'yukki.app'} = $self; | ||||
184 | 3 | 45 | $env->{'yukki.settings'} = $self->settings; | ||||
185 | 3 | 22 | $env->{'yukki.ctx'} = $ctx; | ||||
186 | 3 | 11 | weaken $env->{'yukki.ctx'}; | ||||
187 | |||||||
188 | 3 | 6 | my $response; | ||||
189 | |||||||
190 | try { | ||||||
191 | 3 | 142 | my $match = $self->router->match($ctx->request->path); | ||||
192 | |||||||
193 | 3 | 45 | http_throw('No action found matching that URL.', { | ||||
194 | status => 'NotFound', | ||||||
195 | }) unless $match; | ||||||
196 | |||||||
197 | 3 | 42 | $ctx->request->path_parameters($match->mapping); | ||||
198 | |||||||
199 | 3 | 123 | my $access_level_needed = $match->access_level; | ||||
200 | http_throw('You are not authorized to run this action.', { | ||||||
201 | status => 'Forbidden', | ||||||
202 | }) unless $self->check_access( | ||||||
203 | user => $ctx->session->{user}, | ||||||
204 | repository => $match->mapping->{repository} // '-', | ||||||
205 | 3 | 60 | special => $match->mapping->{special} // '-', | ||||
206 | needs => $access_level_needed, | ||||||
207 | ); | ||||||
208 | |||||||
209 | 3 | 57 | if ($ctx->session->{user}) { | ||||
210 | $ctx->response->add_navigation_item(user => { | ||||||
211 | label => $ctx->session->{user}{name}, | ||||||
212 | 0 | 0 | href => 'profile', | ||||
213 | sort => 200, | ||||||
214 | }); | ||||||
215 | 0 | 0 | $ctx->response->add_navigation_item(user => { | ||||
216 | label => 'Sign out', | ||||||
217 | href => 'logout', | ||||||
218 | sort => 100, | ||||||
219 | }); | ||||||
220 | } | ||||||
221 | |||||||
222 | else { | ||||||
223 | 3 | 200 | $ctx->response->add_navigation_item(user => { | ||||
224 | label => 'Sign in', | ||||||
225 | href => 'login', | ||||||
226 | sort => 100, | ||||||
227 | }); | ||||||
228 | } | ||||||
229 | |||||||
230 | 3 3 | 16 39 | for my $repository (keys %{ $self->settings->repositories }) { | ||||
231 | 6 | 100 | my $config = $self->settings->repositories->{$repository}; | ||||
232 | |||||||
233 | 6 | 39 | my $name = $config->name; | ||||
234 | 6 | 66 | $ctx->response->add_navigation_item(repository => { | ||||
235 | label => $name, | ||||||
236 | href => join('/', 'page/view', $repository), | ||||||
237 | sort => $config->sort, | ||||||
238 | }); | ||||||
239 | } | ||||||
240 | |||||||
241 | 3 | 54 | my $controller = $match->target; | ||||
242 | |||||||
243 | 3 | 78 | $controller->fire($ctx); | ||||
244 | 2 | 227 | $response = $ctx->response->finalize; | ||||
245 | } | ||||||
246 | |||||||
247 | catch { | ||||||
248 | |||||||
249 | 1 | 214 | if (blessed $_ and $_->isa('Yukki::Error')) { | ||||
250 | |||||||
251 | 1 | 4 | if ($_->does('HTTP::Throwable::Role::Status::Forbidden') | ||||
252 | and not $ctx->session->{user}) { | ||||||
253 | |||||||
254 | 0 | 0 | $response = http_exception('Please login first.', { | ||||
255 | status => 'Found', | ||||||
256 | location => ''.$ctx->rebase_url('login'), | ||||||
257 | })->as_psgi($env); | ||||||
258 | } | ||||||
259 | |||||||
260 | else { | ||||||
261 | 1 | 48 | $response = $_->as_psgi($env); | ||||
262 | } | ||||||
263 | } | ||||||
264 | |||||||
265 | else { | ||||||
266 | 0 | 0 | warn "ISE: $_"; | ||||
267 | |||||||
268 | 0 | 0 | $response = http_exception("Oh darn. Something went wrong.", { | ||||
269 | status => 'InternalServerError', | ||||||
270 | show_stack_trace => 0, | ||||||
271 | })->as_psgi($env); | ||||||
272 | } | ||||||
273 | 3 | 23 | }; | ||||
274 | |||||||
275 | 3 | 414 | return $response; | ||||
276 | } | ||||||
277 | |||||||
278 - 284 | =head2 session_middleware enable $app->session_middleware; Returns the setup for the PSGI session middleware. =cut | ||||||
285 | |||||||
286 | sub session_middleware { | ||||||
287 | 1 | 1 | 2 | my $self = shift; | |||
288 | |||||||
289 | # TODO Make this configurable | ||||||
290 | 1 | 5 | return ('Session', | ||||
291 | store => Plack::Session::Store::Cache->new( | ||||||
292 | cache => CHI->new(driver => 'FastMmap'), | ||||||
293 | ), | ||||||
294 | ); | ||||||
295 | } | ||||||
296 | |||||||
297 - 303 | =head2 munge_label my $link = $app->munch_label("This is a label"); Turns some label into a link slug using the standard means for doing so. =cut | ||||||
304 | |||||||
305 | sub munge_label { | ||||||
306 | 0 | 1 | my ($self, $link) = @_; | ||||
307 | |||||||
308 | 0 | $link =~ m{([^/]+)$}; | |||||
309 | |||||||
310 | 0 | $link =~ s{([a-zA-Z])'([a-zA-Z])}{$1$2}g; # foo's -> foos, isn't -> isnt | |||||
311 | 0 | $link =~ s{[^a-zA-Z0-9-_./]+}{-}g; | |||||
312 | 0 | $link =~ s{-+}{-}g; | |||||
313 | 0 | $link =~ s{^-}{}; | |||||
314 | 0 | $link =~ s{-$}{}; | |||||
315 | |||||||
316 | 0 | $link .= '.yukki'; | |||||
317 | |||||||
318 | 0 | return $link; | |||||
319 | } | ||||||
320 | |||||||
321 - 339 | =head2 all_plugins A convenience accessor that returns C<plugins> as a list. =head2 format_helper_plugins Returns all the format helper plugins as a list. =head2 formatter_plugins Returns all the formatter plugins as a list. =begin Pod::Coverage BUILD =end Pod::Coverage =cut | ||||||
340 | |||||||
341 | 1; |