File Coverage

File:lib/Yukki/Web.pm
Coverage:81.3%

linestmtbrancondsubpodtimecode
1package 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
7extends 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
37has '+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
49has router => (
50    is          => 'ro',
51    isa         => class_type('Path::Router'),
52    required    => 1,
53    lazy        => 1,
54    builder     => '_build_router',
55);
56
57sub _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
72has plugins => (
73    is          => 'ro',
74    isa         => PluginList,
75    required    => 1,
76    lazy        => 1,
77    builder     => '_build_plugins',
78);
79
80sub all_plugins {
81
0
1
0
    my $self = shift;
82
0
0
    $self->plugins->@*;
83}
84
85sub 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
91sub 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
97sub _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
119sub 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
135sub 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
150sub 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
163sub 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
178sub 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
286sub 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
305sub 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
3411;