From 1010a2c8cbe0f722fa14b0c60df883d73f79d603 Mon Sep 17 00:00:00 2001 From: Olli-Antti Kivilahti Date: Wed, 29 Jul 2015 10:39:35 +0300 Subject: [PATCH] Bug 14539 - Introduction to cast() (ToObject), aka. make a Koha::Object from various input types and validate. Finds a Borrower-object (or any other type) from various different types of inputs. Also doubles as a validator function, dying if input is improper. USAGE: my $member = C4::Members::GetMember(borrowernumber => $borrowernumber); my $borrower = Koha::Borrowers->cast($member); Currently Koha is like an archeological dig site, we have different layers of dealing with various business objects. We started with DBI and numerous ways of passing an HASH around. There is no telling if it will be a List of column => values, or a reference to HASH, or a HASH or just any of the business object's (eg. Borrower's) unique identifiers (userid, cardnumber, borrowernumber). Then DBIx came to the rescue and now we are need to learn DBI and DBIx and SQL to do DB operatons in Koha. Migration to DBIx is on the way. Finally we have Koha::Object and subclasses, which include and use the DBIx, but those are not directly compatible, since Koha::Object is not a subclass of DBIx::Class making life occasionally miserable. Now we need to know 3 methods of DB accession. I am really frustrated with all of those different layers of history, and making things work nicely across all different programming patterns, I have had great success in using a casting system, where we take any value and try to make a Koha::Object-subclass out of it. So we try to cast a Scalar or a reference of Koha::Object-implementation or DBIx::ResultSet or HASH, to the desired Koha::Object-implementation. This is a nice validation/entry function in any subroutine dealing with business objects, making sure that we always have the "correct" implementation of the same business object. Unit tests included demonstrating the feature and possible pitfalls. --- Koha/AuthUtils.pm | 39 +++++++++++++ Koha/Borrowers.pm | 55 +++++++++++++++++- Koha/Objects.pm | 131 +++++++++++++++++++++++++++++++++++++++++- t/db_dependent/Koha/Objects.t | 110 +++++++++++++++++++++++++++++++++++ 4 files changed, 333 insertions(+), 2 deletions(-) create mode 100644 t/db_dependent/Koha/Objects.t diff --git a/Koha/AuthUtils.pm b/Koha/AuthUtils.pm index b748c1b..5fa0afb 100644 --- a/Koha/AuthUtils.pm +++ b/Koha/AuthUtils.pm @@ -22,6 +22,8 @@ use Crypt::Eksblowfish::Bcrypt qw(bcrypt en_base64); use Encode qw( encode is_utf8 ); use Fcntl qw/O_RDONLY/; # O_RDONLY is used in generate_salt +use Koha::Borrower; + use base 'Exporter'; our $VERSION = '1.01'; @@ -133,6 +135,43 @@ sub generate_salt { close SOURCE; return $string; } + +=head checkKohaSuperuserFromUserid +See checkKohaSuperuser(), with only the "user identifier"-@PARAM. +@THROWS nothing. +=cut + +sub checkKohaSuperuserFromUserid { + my ($userid) = @_; + + if ( $userid && $userid eq C4::Context->config('user') ) { + return _createTemporarySuperuser(); + } +} + +=head _createTemporarySuperuser + +Create a temporary superuser which should be instantiated only to the environment +and then discarded. So do not ->store() it! +@RETURN Koha::Borrower +=cut + +sub _createTemporarySuperuser { + my $borrower = Koha::Borrower->new(); + + my $superuserName = C4::Context->config('user'); + $borrower->set({borrowernumber => 0, + userid => $superuserName, + cardnumber => $superuserName, + firstname => $superuserName, + surname => $superuserName, + branchcode => 'NO_LIBRARY_SET', + flags => 1, + email => C4::Context->preference('KohaAdminEmailAddress') + }); + return $borrower; +} + 1; __END__ diff --git a/Koha/Borrowers.pm b/Koha/Borrowers.pm index 9fb01f0..f586ffd 100644 --- a/Koha/Borrowers.pm +++ b/Koha/Borrowers.pm @@ -18,13 +18,17 @@ package Koha::Borrowers; # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. use Modern::Perl; +use Scalar::Util qw(blessed); +use Try::Tiny; use Carp; use Koha::Database; - +use Koha::AuthUtils; use Koha::Borrower; +use Koha::Exception::UnknownObject; + use base qw(Koha::Objects); =head1 NAME @@ -49,6 +53,55 @@ sub object_class { return 'Koha::Borrower'; } +=head cast + + my $borrower = Koha::Borrowers->cast('cardnumber'); + my $borrower = Koha::Borrowers->cast($Koha::Borrower); + my $borrower = Koha::Borrowers->cast('userid'); + my $borrower = Koha::Borrowers->cast('borrowernumber'); + my $borrower = Koha::Borrowers->cast({borrowernumber => 123, + }); + my $borrower = Koha::Borrowers->cast({firstname => 'Olli-Antti', + surname => 'Kivi', + address => 'Koskikatu 25', + }); + +Because there are gazillion million ways in Koha to invoke a Borrower, this is a +omnibus for easily creating a Borrower-object from all the arcane invocations present +in many parts of Koha. +Just throw the crazy and unpredictable return values from myriad subroutines returning +some kind of an borrowerish value to this casting function to get a brand new Koha::Borrower. +@PARAM1 Scalar, or HASHRef. +@RETURNS Koha::Borrower, possibly already in DB or a completely new one if nothing was + inferred from the DB. +@THROWS Koha::Exception::BadParameter, if no idea what to do with the input. +@THROWS Koha::Exception::UnknownObject, if we cannot find a Borrower with the given input. +=cut + +sub cast { + my ($class, $input) = @_; + + my $borrower; + try { + $borrower = $class->SUPER::cast($input); + } catch { + if (blessed($_) && $_->isa('Koha::Exception::UnknownObject')) { + $borrower = Koha::AuthUtils::checkKohaSuperuserFromUserid($input); + unless ($borrower) { + $_->rethrow(); + } + } + else { + die $_; + } + }; + + return $borrower; +} +sub _get_castable_unique_columns { + return ['borrowernumber', 'cardnumber', 'userid']; +} + =head1 AUTHOR Kyle M Hall diff --git a/Koha/Objects.pm b/Koha/Objects.pm index 8ef6390..f490549 100644 --- a/Koha/Objects.pm +++ b/Koha/Objects.pm @@ -18,11 +18,14 @@ package Koha::Objects; # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. use Modern::Perl; - +use Scalar::Util qw(blessed); use Carp; use Koha::Database; +use Koha::Exception::UnknownObject; +use Koha::Exception::BadParameter; + our $type; =head1 NAME @@ -70,6 +73,132 @@ sub _new_from_dbic { bless( $self, $class ); } +=head _get_castable_unique_columns +@ABSTRACT, OVERLOAD FROM SUBCLASS + +Get the columns this Object can use to find a matching Object from the DB. +These columns must be UNIQUE or preferably PRIMARY KEYs. +So if the castable input is not an Object, we can try to find these scalars and do +a DB search using them. +=cut + +sub _get_castable_unique_columns {} + +=head Koha::Objects->cast(); + +Try to find a matching Object from the given input. Is basically a validator to +validate the given input and make sure we get a Koha::Object or an Exception. + +=head2 An example: + + ### IN Koha/Borrowers.pm ### + package Koha::Borrowers; + ... + sub _get_castable_unique_columns { + return ['borrowernumber', 'cardnumber', 'userid']; + } + + ### SOMEWHERE IN A SCRIPT FAR AWAY ### + my $borrower = Koha::Borrowers->cast('cardnumber'); + my $borrower = Koha::Borrowers->cast($Koha::Borrower); + my $borrower = Koha::Borrowers->cast('userid'); + my $borrower = Koha::Borrowers->cast('borrowernumber'); + my $borrower = Koha::Borrowers->cast({borrowernumber => 123, + }); + my $borrower = Koha::Borrowers->cast({firstname => 'Olli-Antti', + surname => 'Kivi', + address => 'Koskikatu 25', + cardnumber => '11A001', + ... + }); + +=head Description + +Because there are gazillion million ways in Koha to invoke an Object, this is a +helper for easily creating different kinds of objects from all the arcane invocations present +in many parts of Koha. +Just throw the crazy and unpredictable return values from myriad subroutines returning +some kind of an objectish value to this casting function to get a brand new Koha::Object. +@PARAM1 Scalar, or HASHRef, or Koha::Object or Koha::Schema::Result::XXX +@RETURNS Koha::Object subclass, possibly already in DB or a completely new one if nothing was + inferred from the DB. +@THROWS Koha::Exception::BadParameter, if no idea what to do with the input. +@THROWS Koha::Exception::UnknownObject, if we cannot find an Object with the given input. + +=cut + +sub cast { + my ($class, $input) = @_; + + unless ($input) { + Koha::Exception::BadParameter->throw(error => "$class->cast():> No parameter given!"); + } + if (blessed($input) && $input->isa( $class->object_class )) { + return $input; + } + if (blessed($input) && $input->isa( 'Koha::Schema::Result::'.$class->type )) { + return $class->object_class->_new_from_dbic($input); + } + + my %searchTerms; #Make sure the search terms are processed in the order they have been introduced. + #Extract unique keys and try to get the object from them. + my $castableColumns = $class->_get_castable_unique_columns(); + my $resultSource = $class->_resultset()->result_source(); + + if (ref($input) eq 'HASH') { + foreach my $col (@$castableColumns) { + if ($input->{$col} && + $class->_cast_validate_column( $resultSource->column_info($col), $input->{$col}) ) { + $searchTerms{$col} = $input->{$col}; + } + } + } + elsif (not(ref($input))) { #We have a scalar + foreach my $col (@$castableColumns) { + if ($class->_cast_validate_column( $resultSource->column_info($col), $input) ) { + $searchTerms{$col} = $input; + } + } + } + + if (scalar(%searchTerms)) { + my @objects = $class->search({'-or' => \%searchTerms}); + + unless (scalar(@objects) == 1) { + my @keys = keys %searchTerms; + my $keys = join('|', @keys); + my @values = values %searchTerms; + my $values = join('|', @values); + Koha::Exception::UnknownObject->throw(error => "$class->cast():> Cannot find an existing ".$class->object_class." from $keys '$values'.") + if scalar(@objects) < 1; + Koha::Exception::UnknownObject->throw(error => "$class->cast():> Too many ".$class->object_class."s found with $keys '$values'. Will not possibly return the wrong ".$class->object_class) + if scalar(@objects) > 1; + } + return $objects[0]; + } + + Koha::Exception::BadParameter->throw(error => "$class->cast():> Unknown parameter '$input' given!"); +} + +=head _cast_validate_column + + For some reason MySQL decided that it is a good idea to cast String to Integer automatically + For ex. SELECT * FROM borrowers WHERE borrowernumber = '11A001'; + returns the Borrower with borrowernumber => 11, instead of no results! + This is potentially catastrophic. + Validate integers and other data types here. + +=cut + +sub _cast_validate_column { + my ($class, $column, $value) = @_; + + if ($column->{data_type} eq 'integer' && $value !~ m/^\d+$/) { + return 0; + } + return 1; +} + =head3 Koha::Objects->find(); my $object = Koha::Objects->find($id); diff --git a/t/db_dependent/Koha/Objects.t b/t/db_dependent/Koha/Objects.t new file mode 100644 index 0000000..7b51d1b --- /dev/null +++ b/t/db_dependent/Koha/Objects.t @@ -0,0 +1,110 @@ +#!/usr/bin/perl + +# Copyright Open Source Freedom Fighters 2015 +# +# 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 Test::More; +use Scalar::Util qw(blessed); +use Try::Tiny; + +use C4::Context; +use C4::Members; +use Koha::Borrowers; + +my $dbh = C4::Context->dbh; +$dbh->{AutoCommit} = 0; +$dbh->{RaiseError} = 1; + +subtest 'Koha::Objects->cast() using Koha::Borrowers implementation' => sub { + my ($borrower, $member, $testDescription); + my $borrowernumber = C4::Members::AddMember( + cardnumber => '11A001', + userid => 'Uriel Septim VII', + branchcode => 'CPL', + categorycode => 'YA', + surname => 'Costly', + firstname => 'Colt', + address => 'Valaskjalf', + zipcode => '10221'); + + $borrower = Koha::Borrowers->cast($borrowernumber); + is($borrower->cardnumber, '11A001', "Borrower cast from AddMember() output"); + + $member = C4::Members::GetMember(borrowernumber => $borrower->borrowernumber); + $borrower = Koha::Borrowers->cast($member); + is($borrower->cardnumber, '11A001', "Borrower cast from GetMember() output, whatever that is"); + + $borrower = Koha::Borrowers->cast('11A001'); + is($borrower->cardnumber, '11A001', "Borrower cast from cardnumber"); + + $borrower = Koha::Borrowers->cast('Uriel Septim VII'); + is($borrower->cardnumber, '11A001', "Borrower cast from userid"); + + $testDescription = "Borrower casting failed"; + try { + $borrower = Koha::Borrowers->cast('Uriel Septim IX'); + ok(0, $testDescription); + } catch { + if (blessed($_) && $_->isa('Koha::Exception::UnknownObject')) { + ok(1, $testDescription); + } + else { + die $_; + } + }; + + $testDescription = "Borrower casting from undef failed"; + try { + my $undefVariable; + $borrower = Koha::Borrowers->cast($undefVariable); + ok(0, $testDescription); + } catch { + if (blessed($_) && $_->isa('Koha::Exception::BadParameter')) { + ok(1, $testDescription); + } + else { + die $_; + } + }; + + #Under no circumstances we want to mix Borrower Objects. Imagine the terror! + $testDescription = "Emergency abort if casting would result in multiple matching Objects"; + my $borrowernumber2 = C4::Members::AddMember( + cardnumber => $borrowernumber, #This is bad, cardnumber is other borrowers borrowernumber! + userid => $borrowernumber, + branchcode => 'CPL', + categorycode => 'YA', + surname => 'Costly', + firstname => 'Colt', + address => 'Gladsheim', + zipcode => '10221'); + + try { + $borrower = Koha::Borrowers->cast($borrowernumber); + ok(0, $testDescription); + } catch { + if (blessed($_) && $_->isa('Koha::Exception::UnknownObject')) { + ok(1, $testDescription); + } + else { + die $_; + } + }; +}; + +done_testing; \ No newline at end of file -- 1.9.1