File Coverage

File:lib/Yukki.pm
Coverage:95.2%

linestmtbrancondsubpodtimecode
1package Yukki;
2
3
4
4
252
13
use v5.24;
4
4
4
4
16
5
21
use utf8;
5
4
4
4
1370
15616
14
use Moo;
6
7
4
4
4
5445
14007
97
use Class::Load;
8
9
4
4
4
799
11
70
use Yukki::Settings;
10
4
4
4
999
9
15
use Yukki::TextUtil qw( load_file );
11
4
4
4
656
5
35
use Yukki::Types qw( AccessLevel YukkiSettings );
12
4
4
4
2629
9
19
use Yukki::Error qw( http_throw );
13
14
4
4
4
3393
4929
90
use Crypt::SaltedHash;
15
4
4
4
18
4
158
use List::Util qw( any );
16
4
4
4
12
5
19
use Type::Params qw( validate );
17
4
4
4
731
5
16
use Type::Utils;
18
4
4
4
3663
6
20
use Types::Standard qw( Dict HashRef Str Maybe slurpy Optional );
19
4
4
4
2941
4
109
use Path::Tiny;
20
4
4
4
11
5
25
use Types::Path::Tiny qw( Path );
21
22
4
4
4
951
6
19
use namespace::clean;
23
24# ABSTRACT: Yet Uh-nother wiki
25
26 - 48
=head1 DESCRIPTION

This is intended to be the simplest, stupidest wiki on the planet. It uses git for versioning and it is perfectly safe to clone this repository and push and pull and all that jazz to maintain this wiki in multiple places.

For information on getting started see L<Yukki::Manual::Installation>.

=head1 WITH ROLES

=over

=item *

L<Yukki::Role::App>

=back

=head1 ATTRIBUTES

=head2 config_file

This is the name of the configuraiton file. The application will try to find it in F<etc> within the current working directory first. If not there, it will check the C<YUKKI_CONFIG> environment variable.

=cut
49
50has config_file => (
51    is          => 'ro',
52    isa         => Path,
53    required    => 1,
54    coerce      => 1,
55    lazy        => 1,
56    builder     => '_build_config_file',
57);
58
59sub _build_config_file {
60
7
102
    my $self = shift;
61
62
7
30
    my $cwd_conf = path('.', 'etc', 'yukki.conf');
63
7
333
    if (not $ENV{YUKKI_CONFIG} and -f "$cwd_conf") {
64
1
13
        return $cwd_conf;
65    }
66
67    die("Please make YUKKI_CONFIG point to your configuration file.\n")
68
6
59
        unless defined $ENV{YUKKI_CONFIG};
69
70    die("No configuration found at $ENV{YUKKI_CONFIG}. Please set YUKKI_CONFIG to the correct location.\n")
71
5
157
        unless -f $ENV{YUKKI_CONFIG};
72
73
4
38
    return $ENV{YUKKI_CONFIG};
74}
75
76 - 80
=head2 settings

This is the configuration loaded from the L</config_file>.

=cut
81
82has settings => (
83    is          => 'ro',
84    isa         => YukkiSettings,
85    required    => 1,
86    coerce      => 1,
87    lazy        => 1,
88    builder     => '_build_settings',
89);
90
91sub _build_settings {
92
4
86
    my $self = shift;
93
4
74
    load_file($self->config_file)
94}
95
96 - 104
=head1 METHODS

=head2 view

  my $view = $app->view('Page');

Not implemented in this class. See L<Yukki::Web>.

=cut
105
106
1
1
6
sub view { ... }
107
108 - 114
=head2 controller

  my $controller = $app->controller('Page');

Not implemented in this class. See L<Yukki::Web>.

=cut
115
116
1
1
5
sub controller { ... }
117
118 - 125
=head2 model

  my $model = $app->model('Repository', { repository => 'main' });

Returns an instance of the requested model class. The parameters are passed to
the instance constructor.

=cut
126
127sub model {
128
4
1
52
    my ($self, $name, $params) = @_;
129
4
13
    my $class_name = join '::', 'Yukki::Model', $name;
130
4
21
    Class::Load::load_class($class_name);
131
4
4
115
36
    return $class_name->new(app => $self, %{ $params // {} });
132}
133
134 - 143
=head2 locate

  my $file = $app->locate('user_path', 'test_user');

The first argument is the name of the configuration directive naming the path.
It may be followed by one or more path components to be tacked on to the end.

Returns a L<Path::Tiny> for the file.

=cut
144
145sub _locate {
146
14
35
    my ($self, $type, $base, @extra_path) = @_;
147
148
14
256
    my $base_path = $self->settings->$base;
149
14
898
    my $root_path;
150
151
14
52
    if ($base_path !~ m{^/}) {
152
12
182
        $root_path = path($self->settings->root, $base_path);
153    }
154    else {
155
2
12
        $root_path = path($base_path);
156    }
157
158
14
553
    my $located_path = $root_path->child(@extra_path);
159
160    # Small safety mechanism
161
14
430
    die "attempted to lookup an illegal $base path: ", join('/', @extra_path)
162        unless $root_path->subsumes($located_path);
163
164
14
1299
    return $located_path;
165}
166
167sub locate {
168
2
1
29
    my ($self, $base, @extra_path) = @_;
169
2
6
    $self->_locate(file => $base, @extra_path);
170}
171
172 - 179
=head2 locate_dir

  my $dir = $app->locate_dir('repository_path', 'main.git');

The arguments are identical to L</locate>, but returns a L<Path::Tiny> for
the given file.

=cut
180
181sub locate_dir {
182
12
1
84
    my ($self, $base, @extra_path) = @_;
183
12
38
    $self->_locate(dir => $base, @extra_path);
184}
185
186 - 201
=head2 check_access

  my $access_is_ok = $app->check_access({
      user       => $user,
      repository => 'main',
      needs      => 'read',
  });

The C<user> is optional. It should be an object returned from
L<Yukki::Model::User>. The C<repository> is required and should be the name of
the repository the user is trying to gain access to. The C<needs> is the access
level the user needs. It must be an L<Yukki::Types/AccessLevel>.

The method returns a true value if access should be granted or false otherwise.

=cut
202
203sub check_access {
204
60
1
1572
    my ($self, $opt)
205        = validate(\@_, class_type(__PACKAGE__),
206            slurpy Dict[
207                user       => Maybe[class_type('Yukki::User')],
208                special    => Optional[Str],
209                repository => Optional[Str],
210                needs      => AccessLevel,
211            ]
212        );
213    my ($user, $repository, $special, $needs)
214
60
60
494268
12181
        = @{$opt}{qw( user repository special needs )};
215
216
60
132
    $repository //= '-';
217
60
168
    $special //= '-';
218
219    # Always grant none
220
60
171
    return 1 if $needs eq 'none';
221
222    my $config = $self->settings->repositories->{$repository}
223
43
908
              // $self->settings->special_privileges->{$special};
224
225
43
378
    return '' unless $config;
226
227
43
115
    my $read_groups  = $config->read_groups;
228
43
78
    my $write_groups = $config->write_groups;
229
230
43
109
    my %access_level = (none => 0, read => 1, write => 2);
231    my $has_access = sub {
232
63
302
        $access_level{$_[0] // 'none'} >= $access_level{$needs}
233
43
105
    };
234
235    # Deal with anonymous users first.
236
43
100
    return 1 if $has_access->($config->anonymous_access_level);
237
28
151
    return '' unless $user;
238
239    # Only logged users considered here forward.
240
11
11
14
31
    my @user_groups = @{ $user->{groups} // [] };
241
242
11
20
    for my $level (qw( read write )) {
243
20
27
        if ($has_access->($level)) {
244
245
14
22
            my $groups = "${level}_groups";
246
247
14
52
            return 1 if $config->$groups eq 'ANY';
248
249
11
34
            if (ref $config->$groups eq 'ARRAY') {
250
5
5
7
12
                my @level_groups = @{ $config->$groups };
251
252
5
8
                for my $level_group (@level_groups) {
253
9
9
20
45
                    return 1 if any { $_ eq $level_group } @user_groups;
254                }
255            }
256            elsif ($config->$groups ne 'NONE') {
257
0
0
                warn "weird value ", $config->$groups,
258                    " in $groups config for $repository settings";
259            }
260        }
261    }
262
263
5
31
    return '';
264}
265
266 - 270
=head2 hasher

Returns a message digest object that can be used to create a cryptographic hash.

=cut
271
272sub hasher {
273
4
1
6
    my $self = shift;
274
275
4
72
    return Crypt::SaltedHash->new(algorithm => $self->settings->digest);
276}
277
278with qw( Yukki::Role::App );
279
280 - 286
=head1 WHY?

I wanted a Perl-based, MultiMarkdown-supporting wiki that I could take sermon notes and personal study notes for church and Bible study and such. However, I'm offline at church, so I want to do this from my laptop and sync it up to the master wiki when I get home. That's it.

Does it suit your needs? I don't really care, but if I've shared this on the CPAN or the GitHub, then I'm offering it to you in case you might find it useful WITHOUT WARRANTY. If you want it to suit your needs, bug me by email at C<< hanenkamp@cpan.org >> and send me patches.

=cut
287
2881;