@@ -, +, @@ Koha::Objects $c->$cb($patron->unblessed, 200); $c->$cb($patron->swaggerize, 200); works in practice --- Koha/Object.pm | 14 +++- Koha/Objects.pm | 12 +++ Koha/Util/Swagger.pm | 148 +++++++++++++++++++++++++++++++++++++ t/db_dependent/Koha/Util/Swagger.t | 72 ++++++++++++++++++ 4 files changed, 245 insertions(+), 1 deletion(-) create mode 100644 Koha/Util/Swagger.pm create mode 100644 t/db_dependent/Koha/Util/Swagger.t --- a/Koha/Object.pm +++ a/Koha/Object.pm @@ -22,6 +22,7 @@ use Modern::Perl; use Carp; use Koha::Database; +use Koha::Util::Swagger; =head1 NAME @@ -219,6 +220,18 @@ sub unblessed { return { $self->_result->get_columns }; } +=head3 $object->swaggerize(); + +Returns an unblessed, Swagger-ready representation of object + +=cut + +sub swaggerize { + my ($self) = @_; + + return Koha::Util::Swagger::swaggerize_koha_object($self); +} + =head3 $object->_result(); Returns the internal DBIC Row object @@ -250,7 +263,6 @@ sub _columns { return $self->{_columns}; } - =head3 AUTOLOAD The autoload method is used only to get and set values for an objects properties. --- a/Koha/Objects.pm +++ a/Koha/Objects.pm @@ -220,6 +220,18 @@ sub unblessed { return [ map { $_->unblessed } $self->as_list ]; } +=head3 Koha::Objects->swaggerize + +Returns an unblessed, Swagger-ready representation of objects. + +=cut + +sub swaggerize { + my ($self) = @_; + + return Koha::Util::Swagger::swaggerize_koha_objects($self); +} + =head3 Koha::Objects->_wrap wraps the DBIC object in a corresponding Koha object --- a/Koha/Util/Swagger.pm +++ a/Koha/Util/Swagger.pm @@ -0,0 +1,148 @@ +package Koha::Util::Swagger; + +# Copyright 2016 KohaSuomi +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 3 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +use Modern::Perl; + +use Mojo::JSON; + +use Koha::Database; + +=head1 NAME + +Koha::Util::Swagger - utility class with routines for Swagger + +=head1 FUNCTIONS + +=head2 column_type_to_swagger_type + +Takes a C<$column_type> and converts it to one of the data types defined in +Swagger. + +See http://swagger.io/specification/ + +=cut + +sub column_type_to_swagger_type { + my ($column_type) = @_; + + my $mapping = { + ############ BOOLEAN ############ + 'bool' => 'boolean', + 'boolean' => 'boolean', + + ############ INTEGERS ########### + 'bigint' => 'integer', + 'integer' => 'integer', + 'int' => 'integer', + 'mediumint' => 'integer', + 'smallint' => 'integer', + 'tinyint' => 'integer', + + ############ NUMBERS ############ + 'decimal' => 'number', + 'double precision' => 'number', + 'float' => 'number', + + ############ STRINGS ############ + 'blob' => 'string', + 'char' => 'string', + 'date' => 'string', + 'datetime' => 'string', + 'enum' => 'string', + 'longblob' => 'string', + 'longtext' => 'string', + 'mediumblob' => 'string', + 'mediumtext' => 'string', + 'text' => 'string', + 'tinyblob' => 'string', + 'tinytext' => 'string', + 'timestamp' => 'string', + 'varchar' => 'string', + + }; + + return $mapping->{$column_type} if exists $mapping->{$column_type}; +} + +=head2 swaggerize_koha_object + +Returns an unblessed Swagger-ready representation of Koha-object. Checks +column type and attempts to convert it into Swagger data type. This allows +us to represent e.g. numbers as actual numbers in JSON, without quotations. + +=cut + +sub swaggerize_koha_object { + my ($object) = @_; + + return unless $object; + + if ($object->can("as_list")) { + return swaggerize_koha_objects($object); + } + + my $unblessed = $object->unblessed; + + my $columns = Koha::Database->new->schema->resultset($object->_type) + ->result_source->{_columns}; + foreach my $col (keys $columns) { + if ($columns->{$col}->{is_nullable} && !defined $unblessed->{$col}) { + $unblessed->{$col} = undef; + next; + } + + my $col_type = $columns->{$col}->{data_type}; + my $swagger_type = column_type_to_swagger_type($col_type); + if ($swagger_type eq "string") { + unless ($unblessed->{$col}) { + $unblessed->{$col} = ""; + } else { + $unblessed->{$col} = "$unblessed->{$col}"; + } + } + elsif ($swagger_type eq "boolean") { + if ($unblessed->{$col}) { + $unblessed->{$col} = Mojo::JSON->true; + } else { + $unblessed->{$col} = Mojo::JSON->false; + } + } + else { + $unblessed->{$col} += 0; + } + } + + return $unblessed; +} + +=head2 swaggerize_koha_objects + +Returns an unblessed Swagger-ready representation of Koha-objects. + +=cut + +sub swaggerize_koha_objects { + my ($objects) = @_; + + return unless $objects; + + return [ map { $_->swaggerize } $objects->as_list ]; +} + +1; --- a/t/db_dependent/Koha/Util/Swagger.t +++ a/t/db_dependent/Koha/Util/Swagger.t @@ -0,0 +1,72 @@ +#!/usr/bin/perl + +# Copyright 2016 KohaSuomi +# +# This file is part of Koha +# +# Koha is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# Koha is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with Koha; if not, see . + +use Modern::Perl; + +use Test::More tests => 7; + +use Koha::Patrons; + +use t::lib::TestBuilder; + +my $schema = Koha::Database->new->schema; +$schema->storage->txn_begin; + +use_ok("Koha::Util::Swagger"); + +my $builder = t::lib::TestBuilder->new; +my $library = $builder->build({source => 'Branch' }); +my $category = $builder->build({source => 'Category' }); +my $nb_of_patrons = Koha::Patrons->search->count; +my $new_patron_1 = Koha::Patron->new( + { cardnumber => 'test_cn_1', + branchcode => $library->{branchcode}, + categorycode => $category->{categorycode}, + surname => 'surname for patron1', + firstname => 'firstname for patron1', + userid => 'a_nonexistent_userid_1', + } +)->store; +my $new_patron_2 = Koha::Patron->new( + { cardnumber => 'test_cn_2', + branchcode => $library->{branchcode}, + categorycode => $category->{categorycode}, + surname => 'surname for patron2', + firstname => 'firstname for patron2', + userid => 'a_nonexistent_userid_2', + } +)->store; + +ok($new_patron_1->can("swaggerize"), "Koha::Patron can swaggerize"); +ok(Koha::Patrons->can("swaggerize"), "Koha::Patrons can swaggerize"); + +my $swaggerized = $new_patron_1->swaggerize; +my $unblessed = $new_patron_1->unblessed; +my $swaggerizeds = Koha::Patrons->search->swaggerize; + +my $unblesseds = Koha::Patrons->search->unblessed; + +is(Koha::Util::Swagger::column_type_to_swagger_type("varchar"), "string", "varchar = string"); +is(Koha::Util::Swagger::column_type_to_swagger_type("mediumint"), "integer", "mediumint = integer"); +is(Koha::Util::Swagger::column_type_to_swagger_type("decimal"), "number", "decimal = number"); +is(@$swaggerizeds, @$unblesseds, "Koha::Objects->swaggerize returned as many objects as unblessed (".@$unblesseds.")"); + +$schema->storage->txn_rollback; + +1; --