| 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; | ||||||