From 1d2eff0a50a1c6d6e978866567e671dea5f7858f Mon Sep 17 00:00:00 2001
From: Lari Taskula <larit@student.uef.fi>
Date: Mon, 15 Aug 2016 17:21:05 +0300
Subject: [PATCH] Bug 17008: Test to compare Swagger property types against
 column data types

This patch adds a test that iterates through each definition-object in Swagger
and compares their properties' data types to corresponding Koha-object's column's
data type by using Koha::Util::Swagger::column_type_to_swagger_type().

This test will also check if the column is nullable and will complain
unless property has also "null" defined in its type.

To test:
1. Run t/db_dependent/api/v1/swagger/definitions.t
2. Observe that tests pass (if not, open a Bug to fix issues)
3. Modify api/v1/definitions/patron.json cardnumber to be type "integer".
4. Run the test again.
5. Observe that test fails and will complain about incorrect data type.
---
 t/db_dependent/api/v1/swagger/definitions.t | 68 ++++++++++++++++++++++++++++-
 1 file changed, 67 insertions(+), 1 deletion(-)

diff --git a/t/db_dependent/api/v1/swagger/definitions.t b/t/db_dependent/api/v1/swagger/definitions.t
index c7977e9..cbb3d4a 100644
--- a/t/db_dependent/api/v1/swagger/definitions.t
+++ b/t/db_dependent/api/v1/swagger/definitions.t
@@ -19,13 +19,15 @@
 
 use Modern::Perl;
 
-use Test::More tests => 1;
+use Test::More tests => 2;
 use Test::Mojo;
 
 use Module::Load::Conditional;
 use Swagger2;
 
 use C4::Context;
+use Koha::Database;
+use Koha::Util::Swagger;
 
 my $swaggerPath = C4::Context->config('intranetdir')."/api/v1";
 my $swagger = Swagger2->new($swaggerPath."/swagger.json")->expand;
@@ -67,6 +69,70 @@ subtest 'api/v1/definitions/*.json up-to-date with corresponding Koha-object' =>
     }
 };
 
+subtest 'Compare property data type to column data type' => sub {
+    foreach my $name (@definition_names) {
+        my $definition = $api_spec->{definitions}->{$name};
+
+        if ($definition->{type} eq "object") {
+            my $kohaObject = _koha_object($name);
+
+            next unless ($kohaObject && $kohaObject->can("_columns"));
+
+            my $columns = Koha::Database->new->schema->resultset( $kohaObject->_type )->result_source->{_columns};
+            my $properties = $definition->{properties};
+            foreach my $column_name (keys $columns) {
+                my $column = $columns->{$column_name};
+                my $property = $properties->{$column_name};
+                ok(defined $property->{type}, "$name: '$column_name' has a type definition");
+                if ($column->{is_nullable}) {
+                    if (ref($property->{type}) eq "ARRAY") {
+                        ok((grep { /null/ } @{$property->{type}}), "$name: '$column_name' is nullable and has data type 'null'");
+                    } else {
+                        ok($property->{type} eq "null", "$name: '$column_name' is nullable and has data type 'null'");
+                    }
+                } else {
+                    if (ref($property->{type}) eq "ARRAY") {
+                        is((grep { /null/ } @{$property->{type}}), 0, "$name: '$column_name' is not nullable and does not have data type 'null'");
+                    }
+                    else {
+                        ok($property->{type} ne "null", "$name: '$column_name' is not nullable and does not have data type 'null'");
+                    }
+                }
+                my $swagger_type = _get_property_type($property); # without "null"
+                my $expected_swagger_type = _expected_data_type($column); # without "null"
+
+                is($swagger_type, $expected_swagger_type, "$name: '$column_name' has correct data type '$swagger_type'");
+            }
+        }
+    }
+};
+
+sub _expected_data_type {
+    my ($column) = @_;
+
+    return Koha::Util::Swagger::column_type_to_swagger_type($column->{data_type});
+}
+
+sub _get_property_type {
+    my ($property) = @_;
+
+    my $type = $property->{type};
+    if (ref($type) eq "ARRAY") {
+        @$type = grep { !/null/ } @$type;
+        if (@$type == 1) {
+            $type = @$type[0];
+        } else {
+            # If we are here, we still have multiple types even after "null"
+            # is removed from the Swagger types.
+            # Why would we still have multiple types?
+            # Is "type": ["integer", "string"] allowed? If so, fix this test
+            return;
+        }
+    }
+
+    return $type;
+}
+
 sub _koha_object {
     my ($name) = @_;
 
-- 
1.9.1