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

(-)a/t/db_dependent/api/v1/swagger/definitions.t (-126 lines)
Lines 1-125 Link Here
1
#!/usr/bin/env perl
2
3
# Copyright 2016 Koha-Suomi
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it under the
8
# terms of the GNU General Public License as published by the Free Software
9
# Foundation; either version 3 of the License, or (at your option) any later
10
# version.
11
#
12
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15
#
16
# You should have received a copy of the GNU General Public License along
17
# with Koha; if not, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
use Modern::Perl;
21
22
use Test::More tests => 1;
23
use Test::Mojo;
24
25
use Module::Load::Conditional;
26
use Swagger2;
27
28
use C4::Context;
29
use Koha::Database;
30
31
my $swaggerPath = C4::Context->config('intranetdir') . "/api/v1/swagger";
32
my $swagger     = Swagger2->new( $swaggerPath . "/swagger.json" )->expand;
33
my $api_spec    = $swagger->api_spec->data;
34
my $schema = Koha::Database->new->schema;
35
36
# The basic idea of this test:
37
# 1. Find all definitions in Swagger under api/v1/definitions
38
# 2. Iterating over each definition, check 'type' of the definition
39
#    * If type is not 'object', definition is ok. We only want objects.
40
#    * If type is an 'object', attempt to load the corresponding Koha-object.
41
#        -> If corresponding Koha-object is not found, definition is ok.
42
#        -> If corresponding Koha-object is found and loaded, compare its
43
#           columns to properties of the object defined in Swagger.
44
#             --> If columns match properties, definition is ok.
45
#             --> If columns do not match properties, definition is not ok.
46
my @definition_names = keys %{ $api_spec->{definitions} };
47
48
subtest 'api/v1/definitions/*.json up-to-date with corresponding Koha-object' => sub {
49
    plan tests => 2*(scalar(@definition_names) - 1);
50
51
    foreach my $name (@definition_names) {
52
        my $definition = $api_spec->{definitions}->{$name};
53
54
        if ($definition->{type} eq "object") {
55
            my $kohaObject = _koha_object($name);
56
57
            unless ($kohaObject && $kohaObject->can("_columns")) {
58
                ok(1, "$name is an object, but not a Koha-object!");
59
                next;
60
            }
61
62
            my $columns_info = $schema->resultset( $kohaObject->_type )->result_source->columns_info;
63
            my $properties = $definition->{properties};
64
            my @missing = check_columns_exist($properties, $columns_info);
65
            if ( @missing ) {
66
                fail( "Columns are missing for $name: " . join(", ", @missing ) );
67
            } else {
68
                pass( "No columns are missing for $name" );
69
            }
70
            my @nullable= check_is_nullable($properties, $columns_info);
71
            if ( @nullable ) {
72
                fail( "Columns is nullable in DB, not in swagger file for $name: " . join(", ", @nullable ) );
73
            } else {
74
                pass( "No null are missing for $name" );
75
            }
76
        } else {
77
            ok(1, "$name type is not an object. It is ".$definition->{type}.".");
78
        }
79
    }
80
};
81
82
sub _koha_object {
83
    my ($name) = @_;
84
85
    $name = "Koha::" . ucfirst $name;
86
87
    if (Module::Load::Conditional::can_load(modules => {$name => undef})) {
88
        return bless {}, $name ;
89
    }
90
}
91
92
sub check_columns_exist {
93
    my ($properties, $columns_info) = @_;
94
    my @missing_column;
95
    for my $column_name ( keys %$columns_info ) {
96
        my $c_info = $columns_info->{$column_name};
97
        unless ( exists $properties->{$column_name} ) {
98
            push @missing_column, $column_name;
99
            next;
100
        }
101
    }
102
    return @missing_column;
103
}
104
105
sub check_is_nullable {
106
    my ($properties, $columns_info) = @_;
107
    my @missing_nullable;
108
    for my $column_name ( keys %$columns_info ) {
109
        my $c_info = $columns_info->{$column_name};
110
        if ( $c_info->{is_nullable} or $c_info->{datetime_undef_if_invalid} ) {
111
            my $type = $properties->{$column_name}{type};
112
            next unless $type; # FIXME Is it ok not to have type defined?
113
            unless ( ref($type) ) {
114
                push @missing_nullable, $column_name;
115
                next;
116
            }
117
            my $null_exists = grep {/^null$/} @$type;
118
            unless ( $null_exists ) {
119
                push @missing_nullable, $column_name;
120
                next;
121
            }
122
        }
123
    }
124
    return @missing_nullable;
125
}
126
- 

Return to bug 19119