@@ -, +, @@ Koha::Object from various input types and validate. my $member = C4::Members::GetMember(borrowernumber => $borrowernumber); my $borrower = Koha::Borrowers->cast($member); --- 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 --- a/Koha/AuthUtils.pm +++ a/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__ --- a/Koha/Borrowers.pm +++ a/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 --- a/Koha/Objects.pm +++ a/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); --- a/t/db_dependent/Koha/Objects.t +++ a/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; --