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

(-)a/Koha/Validator.pm (+57 lines)
Line 0 Link Here
1
package Koha::Validator;
2
3
#TODO License
4
5
use Modern::Perl;
6
use List::Util qw(any);
7
use Koha::Exceptions;
8
use Koha::Email;
9
10
our $default_rules = {
11
    digits_only => qr/^\d+$/,
12
    email       => \&_check_email,
13
};
14
15
#TODO POD
16
17
sub new {
18
    my ( $class, $params ) = @_;
19
    my $self = bless $params // {}, $class;
20
    return $self;
21
}
22
23
sub load {
24
    my ( $self, $rules ) = @_;
25
    $self->{rules} = $rules if ref($rules) eq 'HASH';
26
}
27
28
sub check_array {    #TODO Add later
29
}
30
31
sub check_hash {
32
    my ( $self, $values ) = @_;
33
    return if ref($values) ne 'HASH';
34
35
    foreach my $key (%$values) {
36
        my $rule = $self->{rules}->{$key} or next;
37
        $rule = $default_rules->{$rule} if ref($rule) eq '';
38
        if ( ref($rule) eq 'Regexp' ) {
39
            next if $values->{$key} =~ $rule;
40
        } elsif ( ref($rule) eq 'CODE' ) {
41
            next if $rule->( $values->{$key} );
42
        } elsif ( ref($rule) eq 'ARRAY' ) {
43
            next if any { $_ eq $values->{$key} } @$rule;
44
        }
45
        Koha::Exceptions::BadParameter->throw( parameter => $key );
46
    }
47
    return 1;
48
}
49
50
sub _check_email {    # TODO Incorporate into Koha::Email?
51
    my $email = shift;
52
    return 0 if !Koha::Email->is_valid($email);
53
    return 0 if $email =~ /[\`\$]/;
54
    return 1;
55
}
56
57
1;
(-)a/t/Koha/Validator.t (-1 / +58 lines)
Line 0 Link Here
0
- 
1
#!/usr/bin/perl
2
3
# Copyright 2023 Rijksmuseum
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it
8
# under the terms of the GNU General Public License as published by
9
# the Free Software Foundation; either version 3 of the License, or
10
# (at your option) any later version.
11
#
12
# Koha is distributed in the hope that it will be useful, but
13
# WITHOUT ANY WARRANTY; without even the implied warranty of
14
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15
# GNU General Public License for more details.
16
#
17
# You should have received a copy of the GNU General Public License
18
# along with Koha; if not, see <http://www.gnu.org/licenses>.
19
20
use Modern::Perl;
21
22
use Test::More tests => 1;
23
use Test::Warn;
24
use Try::Tiny;
25
26
use Koha::Validator;
27
28
subtest 'trivial tests' => sub {
29
    plan tests => 3;
30
31
    my $rules = {
32
        test01 => 'digits_only',
33
        test02 => [ 1, 2 ],
34
        test03 => sub { 0 },
35
        test04 => 'email',
36
        test05 => qr/test/,
37
    };
38
    my $validator = Koha::Validator->new( { rules => $rules } );
39
    try {
40
        $validator->check_hash(
41
            { test01 => 2, test02 => 1, test04 => 'marcel@test.nl', test05 => 'includes test word' } );
42
        ok( 1, 'validator green' );
43
    } catch {
44
        ok(0);
45
    };
46
    try {
47
        $validator->check_hash( { test01 => 2, test02 => 1, test03 => 'nomatterwhat' } );
48
        ok( 0, 'we should not be here' );
49
    } catch {
50
        ok( 1, 'validator red' );
51
    };
52
    try {
53
        $validator->check_hash( { test04 => 'withbacktic`ls`@test.com' } );
54
        ok( 0, 'we should not be here' );
55
    } catch {
56
        ok( 1, 'validator red for email' );
57
    };
58
};

Return to bug 34430