@@ -, +, @@ (ToObject), aka. make a Koha::Object from various input types and validate. my $member = C4::Members::GetMember(borrowernumber => $borrowernumber); my $borrower = Koha::Patrons->cast($member); --- Koha/AuthUtils.pm | 39 +++++++++++++ Koha/Items.pm | 4 ++ Koha/Objects.pm | 131 ++++++++++++++++++++++++++++++++++++++++++ Koha/Patrons.pm | 53 +++++++++++++++++ t/db_dependent/Koha/Objects.t | 85 ++++++++++++++++++++++++++- 5 files changed, 311 insertions(+), 1 deletion(-) --- a/Koha/AuthUtils.pm +++ a/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::Borrower +=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__ --- a/Koha/Items.pm +++ a/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 --- a/Koha/Objects.pm +++ a/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/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/Koha/Patrons.pm +++ a/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 --- a/t/db_dependent/Koha/Objects.t +++ a/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 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::Patrons->cast($borrowernumber); + ok(0, $testDescription); + } catch { + if (blessed($_) && $_->isa('Koha::Exception::UnknownObject')) { + ok(1, $testDescription); + } + else { + die $_; + } + }; +}; + $schema->storage->txn_rollback; 1; --