File Coverage

blib/lib/Yukki.pm
Criterion Covered Total %
statement 99 101 98.0
branch 23 26 88.4
condition 6 9 66.6
subroutine 28 28 100.0
pod 7 7 100.0
total 163 171 95.3


line stmt bran cond sub pod time code
1             package Yukki;
2             $Yukki::VERSION = '0.991_001'; # TRIAL
3              
4 3     3   903805 $Yukki::VERSION = '0.991001';use v5.24;
  3         20  
5 3     3   28 use utf8;
  3         9  
  3         38  
6 3     3   2112 use Moo;
  3         29089  
  3         23  
7              
8 3     3   6492 use Class::Load;
  3         19807  
  3         155  
9              
10 3     3   1505 use Yukki::Settings;
  3         16  
  3         190  
11 3     3   1456 use Yukki::TextUtil qw( load_file );
  3         14  
  3         17  
12 3     3   779 use Yukki::Types qw( AccessLevel YukkiSettings );
  3         8  
  3         35  
13 3     3   4224 use Yukki::Error qw( http_throw );
  3         13  
  3         16  
14              
15 3     3   2021 use Crypt::SaltedHash;
  3         5534  
  3         97  
16 3     3   19 use List::Util qw( any );
  3         6  
  3         231  
17 3     3   19 use Type::Params qw( validate );
  3         5  
  3         51  
18 3     3   904 use Type::Utils;
  3         7  
  3         22  
19 3     3   3855 use Types::Standard qw( Dict HashRef Str Undef slurpy );
  3         8  
  3         23  
20 3     3   3195 use Path::Tiny;
  3         8  
  3         171  
21 3     3   23 use Types::Path::Tiny qw( Path );
  3         7  
  3         30  
22              
23 3     3   1290 use namespace::clean;
  3         8  
  3         35  
24              
25             # ABSTRACT: Yet Uh-nother wiki
26              
27              
28             has config_file => (
29             is => 'ro',
30             isa => Path,
31             required => 1,
32             coerce => 1,
33             lazy => 1,
34             builder => '_build_config_file',
35             );
36              
37             sub _build_config_file {
38 5     5   9973 my $self = shift;
39              
40 5         33 my $cwd_conf = path('.', 'etc', 'yukki.conf');
41 5 100 100     364 if (not $ENV{YUKKI_CONFIG} and -f "$cwd_conf") {
42 1         34 return $cwd_conf;
43             }
44              
45             die("Please make YUKKI_CONFIG point to your configuration file.\n")
46 4 100       110 unless defined $ENV{YUKKI_CONFIG};
47              
48             die("No configuration found at $ENV{YUKKI_CONFIG}. Please set YUKKI_CONFIG to the correct location.\n")
49 3 100       126 unless -f $ENV{YUKKI_CONFIG};
50              
51 2         33 return $ENV{YUKKI_CONFIG};
52             }
53              
54              
55             has settings => (
56             is => 'ro',
57             isa => YukkiSettings,
58             required => 1,
59             coerce => 1,
60             lazy => 1,
61             builder => '_build_settings',
62             );
63              
64             sub _build_settings {
65 2     2   65 my $self = shift;
66 2         52 load_file($self->config_file)
67             }
68              
69              
70 1     1 1 1608 sub view { ... }
71              
72              
73 1     1 1 708 sub controller { ... }
74              
75              
76             sub model {
77 1     1 1 561 my ($self, $name, $params) = @_;
78 1         7 my $class_name = join '::', 'Yukki::Model', $name;
79 1         10 Class::Load::load_class($class_name);
80 1   50     61 return $class_name->new(app => $self, %{ $params // {} });
  1         20  
81             }
82              
83              
84             sub _locate {
85 2     2   9 my ($self, $type, $base, @extra_path) = @_;
86              
87 2         61 my $base_path = $self->settings->$base;
88 2 50       1279 if ($base_path !~ m{^/}) {
89 0         0 return path($self->settings->root, $base_path, @extra_path);
90             }
91             else {
92 2         18 return path($base_path, @extra_path);
93             }
94             }
95              
96             sub locate {
97 1     1 1 1785 my ($self, $base, @extra_path) = @_;
98 1         6 $self->_locate(file => $base, @extra_path);
99             }
100              
101              
102             sub locate_dir {
103 1     1 1 6629 my ($self, $base, @extra_path) = @_;
104 1         7 $self->_locate(dir => $base, @extra_path);
105             }
106              
107              
108             sub check_access {
109 42     42 1 1503 my ($self, $opt)
110             = validate(\@_, class_type(__PACKAGE__),
111             slurpy Dict[
112             user => Undef|HashRef,
113             repository => Str,
114             needs => AccessLevel,
115             ]);
116 42         621439 my ($user, $repository, $needs) = @{$opt}{qw( user repository needs )};
  42         13814  
117              
118             # Always grant none
119 42 100       390 return 1 if $needs eq 'none';
120              
121 28         1320 my $config = $self->settings->repositories->{$repository};
122              
123 28 50       626 return '' unless $config;
124              
125 28         159 my $read_groups = $config->read_groups;
126 28         138 my $write_groups = $config->write_groups;
127              
128 28         194 my %access_level = (none => 0, read => 1, write => 2);
129             my $has_access = sub {
130 48   50 48   412 $access_level{$_[0] // 'none'} >= $access_level{$needs}
131 28         271 };
132              
133             # Deal with anonymous users first.
134 28 100       192 return 1 if $has_access->($config->anonymous_access_level);
135 22 100       250 return '' unless $user;
136              
137             # Only logged users considered here forward.
138 11   50     33 my @user_groups = @{ $user->{groups} // [] };
  11         74  
139              
140 11         48 for my $level (qw( read write )) {
141 20 100       64 if ($has_access->($level)) {
142              
143 14         84 my $groups = "${level}_groups";
144              
145 14 100       127 return 1 if $config->$groups eq 'ANY';
146              
147 11 100       77 if (ref $config->$groups eq 'ARRAY') {
    50          
148 5         9 my @level_groups = @{ $config->$groups };
  5         23  
149              
150 5         13 for my $level_group (@level_groups) {
151 9 100   9   49 return 1 if any { $_ eq $level_group } @user_groups;
  9         81  
152             }
153             }
154             elsif ($config->$groups ne 'NONE') {
155 0         0 warn "weird value ", $config->$groups,
156             " in $groups config for $repository settings";
157             }
158             }
159             }
160              
161 5         81 return '';
162             }
163              
164              
165             sub hasher {
166 3     3 1 3361949 my $self = shift;
167              
168 3         71 return Crypt::SaltedHash->new(algorithm => $self->settings->digest);
169             }
170              
171             with qw( Yukki::Role::App );
172              
173              
174             1;
175              
176             __END__
177              
178             =pod
179              
180             =encoding UTF-8
181              
182             =head1 NAME
183              
184             Yukki - Yet Uh-nother wiki
185              
186             =head1 VERSION
187              
188             version 0.991_001
189              
190             =head1 DESCRIPTION
191              
192             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.
193              
194             For information on getting started see L<Yukki::Manual::Installation>.
195              
196             =head1 WITH ROLES
197              
198             =over
199              
200             =item *
201              
202             L<Yukki::Role::App>
203              
204             =back
205              
206             =head1 ATTRIBUTES
207              
208             =head2 config_file
209              
210             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.
211              
212             =head2 settings
213              
214             This is the configuration loaded from the L</config_file>.
215              
216             =head1 METHODS
217              
218             =head2 view
219              
220             my $view = $app->view('Page');
221              
222             Not implemented in this class. See L<Yukki::Web>.
223              
224             =head2 controller
225              
226             my $controller = $app->controller('Page');
227              
228             Not implemented in this class. See L<Yukki::Web>.
229              
230             =head2 model
231              
232             my $model = $app->model('Repository', { repository => 'main' });
233              
234             Returns an instance of the requested model class. The parameters are passed to
235             the instance constructor.
236              
237             =head2 locate
238              
239             my $file = $app->locate('user_path', 'test_user');
240              
241             The first argument is the name of the configuration directive naming the path.
242             It may be followed by one or more path components to be tacked on to the end.
243              
244             Returns a L<Path::Tiny> for the file.
245              
246             =head2 locate_dir
247              
248             my $dir = $app->locate_dir('repository_path', 'main.git');
249              
250             The arguments are identical to L</locate>, but returns a L<Path::Tiny> for
251             the given file.
252              
253             =head2 check_access
254              
255             my $access_is_ok = $app->check_access({
256             user => $user,
257             repository => 'main',
258             needs => 'read',
259             });
260              
261             The C<user> is optional. It should be an object returned from
262             L<Yukki::Model::User>. The C<repository> is required and should be the name of
263             the repository the user is trying to gain access to. The C<needs> is the access
264             level the user needs. It must be an L<Yukki::Types/AccessLevel>.
265              
266             The method returns a true value if access should be granted or false otherwise.
267              
268             =head2 hasher
269              
270             Returns a message digest object that can be used to create a cryptographic hash.
271              
272             =head1 WHY?
273              
274             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.
275              
276             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.
277              
278             =head1 AUTHOR
279              
280             Andrew Sterling Hanenkamp <hanenkamp@cpan.org>
281              
282             =head1 COPYRIGHT AND LICENSE
283              
284             This software is copyright (c) 2017 by Qubling Software LLC.
285              
286             This is free software; you can redistribute it and/or modify it under
287             the same terms as the Perl 5 programming language system itself.
288              
289             =cut