t/db_dependent/api/v1/swagger/definitions.t

   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 JSON::Validator::OpenAPI;
  27
  28 use C4::Context;
  29 use Koha::Database;
  30
  31 my $swaggerPath = C4::Context->config('intranetdir') . "/api/v1/swagger";
  32 my $swagger     = JSON::Validator::OpenAPI->new->load_and_validate_schema(
  33     $swaggerPath . "/swagger.json",
  34     {
  35         allow_invalid_ref => 1
  36     }
  37 );
  38 my $api_spec    = $swagger->schema->data;
  39 my $schema = Koha::Database->new->schema;
  40
  41 # The basic idea of this test:
  42 # 1. Find all definitions in Swagger under api/v1/definitions
  43 # 2. Iterating over each definition, check 'type' of the definition
  44 #    * If type is not 'object', definition is ok. We only want objects.
  45 #    * If type is an 'object', attempt to load the corresponding Koha-object.
  46 #        -> If corresponding Koha-object is not found, definition is ok.
  47 #        -> If corresponding Koha-object is found and loaded, compare its
  48 #           columns to properties of the object defined in Swagger.
  49 #             --> If columns match properties, definition is ok.
  50 #             --> If columns do not match properties, definition is not ok.
  51 my @definition_names = keys %{ $api_spec->{definitions} };
  52
  53 subtest 'api/v1/definitions/*.json up-to-date with corresponding Koha-object' => sub {
  54     plan tests => 2*(scalar(@definition_names) - 1);
  55
  56     foreach my $name (@definition_names) {
  57         my $definition = $api_spec->{definitions}->{$name};
  58
  59         if ($definition->{type} eq "object") {
  60             my $kohaObject = _koha_object($name);
  61
  62             unless ($kohaObject && $kohaObject->can("_columns")) {
  63                 ok(1, "$name is an object, but not a Koha-object!");
  64                 next;
  65             }
  66
  67             my $columns_info = $schema->resultset( $kohaObject->_type )->result_source->columns_info;
  68             my $properties = $definition->{properties};
  69             my @missing = check_columns_exist($properties, $columns_info);
  70             if ( @missing ) {
  71                 fail( "Columns are missing for $name: " . join(", ", @missing ) );
  72             } else {
  73                 pass( "No columns are missing for $name" );
  74             }
  75             my @nullable= check_is_nullable($properties, $columns_info);
  76             if ( @nullable ) {
  77                 fail( "Columns is nullable in DB, not in swagger file for $name: " . join(", ", @nullable ) );
  78             } else {
  79                 pass( "No null are missing for $name" );
  80             }
  81         } else {
  82             ok(1, "$name type is not an object. It is ".$definition->{type}.".");
  83         }
  84     }
  85 };
  86
  87 sub _koha_object {
  88     my ($name) = @_;
  89
  90     $name = "Koha::" . ucfirst $name;
  91
  92     if (Module::Load::Conditional::can_load(modules => {$name => undef})) {
  93         return bless {}, $name ;
  94     }
  95 }
  96
  97 sub check_columns_exist {
  98     my ($properties, $columns_info) = @_;
  99     my @missing_column;
 100     for my $column_name ( keys %$columns_info ) {
 101         my $c_info = $columns_info->{$column_name};
 102         unless ( exists $properties->{$column_name} ) {
 103             push @missing_column, $column_name;
 104             next;
 105         }
 106     }
 107     return @missing_column;
 108 }
 109
 110 sub check_is_nullable {
 111     my ($properties, $columns_info) = @_;
 112     my @missing_nullable;
 113     for my $column_name ( keys %$columns_info ) {
 114         my $c_info = $columns_info->{$column_name};
 115         if ( $c_info->{is_nullable} or $c_info->{datetime_undef_if_invalid} ) {
 116             my $type = $properties->{$column_name}{type};
 117             next unless $type; # FIXME Is it ok not to have type defined?
 118             unless ( ref($type) ) {
 119                 push @missing_nullable, $column_name;
 120                 next;
 121             }
 122             my $null_exists = grep {/^null$/} @$type;
 123             unless ( $null_exists ) {
 124                 push @missing_nullable, $column_name;
 125                 next;
 126             }
 127         }
 128     }
 129     return @missing_nullable;
 130 }