From b78611afb6ff819371da8e47ec1c6fb4e58c71e5 Mon Sep 17 00:00:00 2001 From: Olli-Antti Kivilahti Date: Wed, 29 Jul 2015 10:39:35 +0300 Subject: [PATCH] Bug 14539 - Koha::Objects->cast(). Introduction to cast() (ToObject), aka. make a Koha::Object from various input types and validate. Finds a Patron-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::Patrons->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. Patron'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/Acquisition/Booksellers.pm | 4 ++ Koha/AuthUtils.pm | 39 ++++++++++++ Koha/Items.pm | 4 ++ Koha/Objects.pm | 131 ++++++++++++++++++++++++++++++++++++++++ Koha/Patrons.pm | 53 ++++++++++++++++ Koha/Subscriptions.pm | 4 ++ t/db_dependent/Koha/Objects.t | 85 +++++++++++++++++++++++++- 7 files changed, 319 insertions(+), 1 deletion(-) diff --git a/Koha/Acquisition/Booksellers.pm b/Koha/Acquisition/Booksellers.pm index 5fa3540..3f75b1c 100644 --- a/Koha/Acquisition/Booksellers.pm +++ b/Koha/Acquisition/Booksellers.pm @@ -34,4 +34,8 @@ sub object_class { return 'Koha::Acquisition::Bookseller'; } +sub _get_castable_unique_columns { + return ['id']; +} + 1; diff --git a/Koha/AuthUtils.pm b/Koha/AuthUtils.pm index a8b391d..a2b8f41 100644 --- a/Koha/AuthUtils.pm +++ b/Koha/AuthUtils.pm @@ -23,6 +23,8 @@ use Encode qw( encode is_utf8 ); use Fcntl qw/O_RDONLY/; # O_RDONLY is used in generate_salt use List::MoreUtils qw/ any /; +use Koha::Patron; + use base 'Exporter'; our @EXPORT_OK = qw(hash_password get_script_name); @@ -152,6 +154,43 @@ sub get_script_name { } } +=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::Patron +=cut + +sub _createTemporarySuperuser { + my $patron = Koha::Patron->new(); + + my $superuserName = C4::Context->config('user'); + $patron->set({borrowernumber => 0, + userid => $superuserName, + cardnumber => $superuserName, + firstname => $superuserName, + surname => $superuserName, + branchcode => 'NO_LIBRARY_SET', + flags => 1, + email => C4::Context->preference('KohaAdminEmailAddress') + }); + return $patron; +} + + 1; __END__ diff --git a/Koha/Items.pm b/Koha/Items.pm index 7b86c5a..db2f12f 100644 --- a/Koha/Items.pm +++ b/Koha/Items.pm @@ -37,6 +37,10 @@ Koha::Items - Koha Item object set class =cut +sub _get_castable_unique_columns { + return ['itemnumber', 'barcode']; +} + =head3 type =cut diff --git a/Koha/Objects.pm b/Koha/Objects.pm index 7e73297..3bd70d7 100644 --- a/Koha/Objects.pm +++ b/Koha/Objects.pm @@ -19,10 +19,15 @@ package Koha::Objects; use Modern::Perl; +use Scalar::Util qw(blessed); use Carp; use Koha::Database; + +use Koha::Exception::UnknownObject; +use Koha::Exception::BadParameter; + =head1 NAME Koha::Objects - Koha Object set base class @@ -68,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/Patrons.pm ### + package Koha::Patrons; + ... + sub _get_castable_unique_columns { + return ['borrowernumber', 'cardnumber', 'userid']; + } + + ### SOMEWHERE IN A SCRIPT FAR AWAY ### + my $borrower = Koha::Patrons->cast('cardnumber'); + my $borrower = Koha::Patrons->cast($Koha::Patron); + my $borrower = Koha::Patrons->cast('userid'); + my $borrower = Koha::Patrons->cast('borrowernumber'); + my $borrower = Koha::Patrons->cast({borrowernumber => 123, + }); + my $borrower = Koha::Patrons->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/Koha/Patrons.pm b/Koha/Patrons.pm index b8aebeb..485b638 100644 --- a/Koha/Patrons.pm +++ b/Koha/Patrons.pm @@ -31,6 +31,9 @@ use Koha::Patron; use base qw(Koha::Objects); +use Scalar::Util qw(blessed); +use Try::Tiny; + =head1 NAME Koha::Patron - Koha Patron Object class @@ -41,6 +44,10 @@ Koha::Patron - Koha Patron Object class =cut +sub _get_castable_unique_columns { + return ['borrowernumber', 'cardnumber', 'userid']; +} + =head3 search_housebound_choosers Returns all Patrons which are Housebound choosers. @@ -183,6 +190,52 @@ sub anonymise_issue_history { $old_issues_to_anonymise->update( { 'old_issues.borrowernumber' => $anonymous_patron } ); } +=head cast + + my $borrower = Koha::Patrons->cast('cardnumber'); + my $borrower = Koha::Patrons->cast($Koha::Patron); + my $borrower = Koha::Patrons->cast('userid'); + my $borrower = Koha::Patrons->cast('borrowernumber'); + my $borrower = Koha::Patrons->cast({borrowernumber => 123, + }); + my $borrower = Koha::Patrons->cast({firstname => 'Olli-Antti', + surname => 'Kivi', + address => 'Koskikatu 25', + }); + +Because there are gazillion million ways in Koha to invoke a Patron, this is a +omnibus for easily creating a Patron-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 patronish value to this casting function to get a brand new Koha::Patron. +@PARAM1 Scalar, or HASHRef. +@RETURNS Koha::Patron, 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 Patron with the given input. +=cut + +sub cast { + my ($class, $input) = @_; + + my $patron; + try { + $patron = $class->SUPER::cast($input); + } catch { + if (blessed($_) && $_->isa('Koha::Exception::UnknownObject')) { + $patron = Koha::AuthUtils::checkKohaSuperuserFromUserid($input); + unless ($patron) { + $_->rethrow(); + } + } + else { + die $_; + } + }; + + return $patron; +} + =head3 type =cut diff --git a/Koha/Subscriptions.pm b/Koha/Subscriptions.pm index 3538c15..5d5ecb3 100644 --- a/Koha/Subscriptions.pm +++ b/Koha/Subscriptions.pm @@ -49,6 +49,10 @@ sub object_class { return 'Koha::Subscription'; } +sub _get_castable_unique_columns { + return ['subscriptionid']; +} + =head1 AUTHOR Kyle M Hall diff --git a/t/db_dependent/Koha/Objects.t b/t/db_dependent/Koha/Objects.t index 935dc47..fd4d594 100644 --- a/t/db_dependent/Koha/Objects.t +++ b/t/db_dependent/Koha/Objects.t @@ -19,9 +19,11 @@ use Modern::Perl; -use Test::More tests => 13; +use Test::More tests => 14; use Test::Warn; +use C4::Members; + use Koha::Authority::Types; use Koha::Cities; use Koha::Patron::Category; @@ -31,6 +33,7 @@ use Koha::Database; use t::lib::TestBuilder; +use Scalar::Util qw(blessed); use Try::Tiny; my $schema = Koha::Database->new->schema; @@ -168,5 +171,85 @@ subtest 'Exceptions' => sub { }; }; +subtest 'Koha::Objects->cast() using Koha::Patrons 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::Patrons->cast($borrowernumber); + is($borrower->cardnumber, '11A001', "Patron cast from AddMember() output"); + + $member = C4::Members::GetMember(borrowernumber => $borrower->borrowernumber); + $borrower = Koha::Patrons->cast($member); + is($borrower->cardnumber, '11A001', "Patron cast from GetMember() output, whatever that is"); + + $borrower = Koha::Patrons->cast('11A001'); + is($borrower->cardnumber, '11A001', "Patron cast from cardnumber"); + + $borrower = Koha::Patrons->cast('Uriel Septim VII'); + is($borrower->cardnumber, '11A001', "Patron cast from userid"); + + $borrower = Koha::Patrons->cast(C4::Context->config('user')); + is($borrower->cardnumber, C4::Context->config('user'), "Patron cast from db user"); + + $testDescription = "Patron casting failed"; + try { + $borrower = Koha::Patrons->cast('Uriel Septim IX'); + ok(0, $testDescription); + } catch { + if (blessed($_) && $_->isa('Koha::Exception::UnknownObject')) { + ok(1, $testDescription); + } + else { + die $_; + } + }; + + $testDescription = "Patron casting from undef failed"; + try { + my $undefVariable; + $borrower = Koha::Patrons->cast($undefVariable); + ok(0, $testDescription); + } catch { + if (blessed($_) && $_->isa('Koha::Exception::BadParameter')) { + ok(1, $testDescription); + } + else { + die $_; + } + }; + + #Under no circumstances we want to mix Patron 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::Patrons->cast($borrowernumber); + ok(0, $testDescription); + } catch { + if (blessed($_) && $_->isa('Koha::Exception::UnknownObject')) { + ok(1, $testDescription); + } + else { + die $_; + } + }; +}; + $schema->storage->txn_rollback; 1; -- 2.7.4