View | Details | Raw Unified | Return to bug 28999
Collapse All | Expand All

(-)a/Koha/AllowList.pm (-20 / +58 lines)
Lines 1-10 Link Here
1
package Koha::Allowlist;
1
package Koha::AllowList;
2
3
# This file is part of Koha.
4
#
5
# Koha is free software; you can redistribute it and/or modify it
6
# under the terms of the GNU General Public License as published by
7
# the Free Software Foundation; either version 3 of the License, or
8
# (at your option) any later version.
9
#
10
# Koha is distributed in the hope that it will be useful, but
11
# WITHOUT ANY WARRANTY; without even the implied warranty of
12
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13
# GNU General Public License for more details.
14
#
15
# You should have received a copy of the GNU General Public License
16
# along with Koha; if not, see <http://www.gnu.org/licenses>.
2
17
3
use Modern::Perl;
18
use Modern::Perl;
4
19
5
=head1 NAME
20
=head1 NAME
6
21
7
Koha::Allowlist - Allowlist implementation base class
22
Koha::AllowList - Allow list implementation base class
8
23
9
=head1 API
24
=head1 API
10
25
Lines 12-33 Koha::Allowlist - Allowlist implementation base class Link Here
12
27
13
=head3 new
28
=head3 new
14
29
15
    my $allow_list = Koha::Allowlist->new({ interface => 'staff' });
30
    my $allow_list = Koha::AllowList->new;
16
31
17
    Constructor.
32
    Constructor.
18
33
19
    Interface must be 'staff' or 'opac' - defaults to 'opac'
20
21
=cut
34
=cut
22
35
36
our $defaults = [];
37
23
sub new {
38
sub new {
24
    my ($class, $args) = @_;
39
    my ($class, $args) = @_;
25
    $args = {} unless defined $args;
40
    $args //= {};
26
    my $self = bless ($args, $class);
41
    my $self = bless( $args, $class );
27
    $self->{interface} =
28
      ( $args->{interface} && $args->{interface} eq 'staff' )
29
      ? 'staff'
30
      : 'opac';
31
    $self->{_entries} = {};
42
    $self->{_entries} = {};
32
    return $self;
43
    return $self;
33
}
44
}
Lines 61-89 sub remove { Link Here
61
72
62
=head3 apply
73
=head3 apply
63
74
64
    my $blocked = $allowlist->apply({ input => $hashref, verbose => 1 });
75
    my $blocked = $allowlist->apply({
76
        input => $hashref | $arrayref, verbose => 1, dry_run => 0,
77
    });
65
78
66
    Apply an allowlist to input data. Note that we modify the $hashref argument!
79
    Apply an allowlist to input data. Note that we modify the passed
80
    reference unless the dry_run flag is true.
67
    The verbose flag controls the warn statement.
81
    The verbose flag controls the warn statement.
68
82
69
    Returns a hash of blocked entries. Might be useful for logging purposes?
83
    Returns a hash of blocked entries. Might be useful for logging purposes.
84
    When you pass an arrayref, the return looks like: { blocked1 => 1, blocked2 => 1, .. }
70
85
71
=cut
86
=cut
72
87
73
sub apply {
88
sub apply {
74
    my ( $self, $params ) = @_;
89
    my ( $self, $params ) = @_;
75
    my $input = $params->{input} or return;
90
    my $input = $params->{input} or return;
91
    return if ref($input) ne 'HASH' && ref($input) ne 'ARRAY';
92
    my $dry = $params->{dry_run};
76
93
77
    my $blocked = {};
94
    my $blocked = {};
78
    foreach my $key ( keys %$input ){
95
    if( ref($input) eq 'ARRAY' ) {
79
        unless ( $self->{_entries}->{$key} ) {
96
        my ( @ok, @nok );
80
            $blocked->{$key} = delete $input->{ $key };
97
        map { $self->{_entries}->{$_} ? push @ok, $_ : push @nok, $_;  } @$input;
98
        @$input = @ok if !$dry;
99
        $blocked = { map { ( $_ => 1 ) } @nok };
100
    } else { # Handle hashref
101
        foreach my $key ( keys %$input ) {
102
            unless ( $self->{_entries}->{$key} ) {
103
                if( ref($input) eq 'HASH' ) {
104
                    $blocked->{$key} = $dry ? $input->{$key} : delete $input->{$key};
105
                }
106
            }
81
        }
107
        }
82
    }
108
    }
83
    warn 'Koha::Allowlist: apply blocked one or more keys' if keys %$blocked && $params->{verbose};
109
    warn 'Koha::AllowList: apply blocked one or more keys' if keys %$blocked && $params->{verbose};
84
    return $blocked;
110
    return $blocked;
85
}
111
}
86
112
113
=head3 check
114
115
    my $blocked = $allowlist->check({ input => $a, verbose => 0 });
116
117
    This is just a shortcut for ->apply({ dry_run => 1 })
118
119
=cut
120
121
sub check {
122
    my ( $self, $params ) = @_;
123
    return $self->apply({ %$params, dry_run => 1 });
124
}
125
87
=head3 load
126
=head3 load
88
127
89
    my $fields = $self->load;
128
    my $fields = $self->load;
Lines 96-103 sub apply { Link Here
96
135
97
sub load {
136
sub load {
98
    my ( $self ) = @_;
137
    my ( $self ) = @_;
99
    # You could do something here like:
138
    $self->add( @$defaults );
100
    # $self->add( 'myfield' );
101
}
139
}
102
140
103
=head3 unload
141
=head3 unload
(-)a/t/Koha/AllowList.t (-5 / +23 lines)
Lines 18-33 Link Here
18
use Modern::Perl;
18
use Modern::Perl;
19
use Test::More tests => 1;
19
use Test::More tests => 1;
20
20
21
use Koha::Allowlist;
21
use Koha::AllowList;
22
22
23
subtest 'Allowlist' => sub {
23
subtest 'AllowList' => sub {
24
    plan tests => 7;
24
    plan tests => 13;
25
25
26
    my $allowlist = Koha::Allowlist->new;
26
    my $allowlist = Koha::AllowList->new;
27
    $allowlist->load;
27
    $allowlist->load;
28
    is( $allowlist->apply, undef, 'No input returns undef' );
28
    is( $allowlist->apply, undef, 'No input returns undef' );
29
    is( %{$allowlist->apply({ input => {} })}, 0, 'Empty hash returns nothing blocked' );
29
    is( %{$allowlist->apply({ input => {} })}, 0, 'Empty hash returns nothing blocked' );
30
30
31
    # Test return from apply on hashrefs
31
    my @input = ( col1 => 1, col2 => 2, col3 => 3, col4 => 4 );
32
    my @input = ( col1 => 1, col2 => 2, col3 => 3, col4 => 4 );
32
    my $blocked = $allowlist->apply({ input => { @input } });
33
    my $blocked = $allowlist->apply({ input => { @input } });
33
    is( keys %$blocked, 4, 'Empty list blocks all' );
34
    is( keys %$blocked, 4, 'Empty list blocks all' );
Lines 42-45 subtest 'Allowlist' => sub { Link Here
42
    $allowlist->unload;
43
    $allowlist->unload;
43
    $blocked = $allowlist->apply({ input => { @input } });
44
    $blocked = $allowlist->apply({ input => { @input } });
44
    is( keys %$blocked, 4, 'Same after unloading' );
45
    is( keys %$blocked, 4, 'Same after unloading' );
46
47
    # Test dry run
48
    my $input2 = { col1 => 1, col2 => 2, col3 => 3, col4 => 4 };
49
    $allowlist->add( 'col1', 'col3' );
50
    $blocked = $allowlist->check({ input => $input2 });
51
    is( keys %$blocked, 2, 'Expected two entries' );
52
    is( keys %$input2, 4, 'Expected no change in input2' );
53
    $blocked = $allowlist->apply({ input => $input2 });
54
    is( keys %$input2, 2, 'Apply removed entries now' );
55
56
    # Test array
57
    @input = ( 'col1', 'col2', 'col3', 'col4', 'col5' );
58
    $blocked = $allowlist->check({ input => [ @input ] });
59
    is( keys %$blocked, 3, 'Expected three blocked entries' );
60
    $input2 = [ @input ];
61
    $blocked = $allowlist->apply({ input => $input2 });
62
    is( keys %$blocked, 3, 'Expected three blocked entries again' );
63
    is( @$input2, 2, 'Expect two entries now in input2' );
45
};
64
};
46
- 

Return to bug 28999