Bugzilla – Attachment 41250 Details for
Bug 14539
Introduction to castToObject(), aka. make a Koha::Object from various input types
Home
|
New
|
Browse
|
Search
|
[?]
|
Reports
|
Help
|
New Account
|
Log In
[x]
|
Forgot Password
Login:
[x]
[patch]
Bug 14539 - Introduction to cast() (ToObject), aka. make a Koha::Object from various input types and validate.
Bug-14539---Introduction-to-cast-ToObject-aka-make.patch (text/plain), 16.31 KB, created by
Olli-Antti Kivilahti
on 2015-07-31 10:32:43 UTC
(
hide
)
Description:
Bug 14539 - Introduction to cast() (ToObject), aka. make a Koha::Object from various input types and validate.
Filename:
MIME Type:
Creator:
Olli-Antti Kivilahti
Created:
2015-07-31 10:32:43 UTC
Size:
16.31 KB
patch
obsolete
>From 1010a2c8cbe0f722fa14b0c60df883d73f79d603 Mon Sep 17 00:00:00 2001 >From: Olli-Antti Kivilahti <olli-antti.kivilahti@jns.fi> >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 <kyle@bywatersolutions.com> >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
You cannot view the attachment while viewing its details because your browser does not support IFRAMEs.
View the attachment on a separate page
.
View Attachment As Diff
View Attachment As Raw
Actions:
View
|
Diff
|
Splinter Review
Attachments on
bug 14539
:
41025
|
41063
|
41122
|
41157
|
41250
|
41530
|
63235
|
63236
|
63237
|
63243
|
63246