@@ -, +, @@ accept composite primary keys Koha::SMS::Providers->find( $member->{'sms_provider_id'} ); --- Koha/Objects.pm | 17 ++++++++++++----- t/db_dependent/Koha/Objects.t | 43 +++++++++++++++++++++++++++++++++++++------ 2 files changed, 49 insertions(+), 11 deletions(-) --- a/Koha/Objects.pm +++ a/Koha/Objects.pm @@ -20,6 +20,7 @@ package Koha::Objects; use Modern::Perl; use Carp; +use List::MoreUtils qw( none ); use Koha::Database; @@ -70,19 +71,25 @@ sub _new_from_dbic { =head3 Koha::Objects->find(); -my $object = Koha::Objects->find($id); -my $object = Koha::Objects->find( { keypart1 => $keypart1, keypart2 => $keypart2 } ); +Similar to DBIx::Class::ResultSet->find this method accepts: + \%columns_values | @pk_values, { key => $unique_constraint, %attrs }? +Strictly speaking, columns_values should only refer to columns under an +unique constraint. + +my $object = Koha::Objects->find( { col1 => $val1, col2 => $val2 } ); +my $object = Koha::Objects->find( $id ); +my $object = Koha::Objects->find( $idpart1, $idpart2, $attrs ); # composite PK =cut sub find { - my ( $self, $id ) = @_; + my ( $self, @pars ) = @_; croak 'Cannot use "->find" in list context' if wantarray; - return unless defined($id); + return if !@pars || none { defined($_) } @pars; - my $result = $self->_resultset()->find($id); + my $result = $self->_resultset()->find( @pars ); return unless $result; --- a/t/db_dependent/Koha/Objects.t +++ a/t/db_dependent/Koha/Objects.t @@ -19,15 +19,12 @@ use Modern::Perl; -<<<<<<< HEAD -use Test::More tests => 10; -======= -use Test::More tests => 14; ->>>>>>> 5a26041... Bug 18539: Forbid list context calls for Koha::Objects->find +use Test::More tests => 12; use Test::Warn; use Koha::Authority::Types; use Koha::Cities; +use Koha::IssuingRules; use Koha::Patron::Category; use Koha::Patron::Categories; use Koha::Patrons; @@ -48,13 +45,19 @@ my $borrowernumber_exists = grep { /^borrowernumber$/ } @columns; is( $borrowernumber_exists, 1, 'Koha::Objects->columns should return the table columns' ); subtest 'find' => sub { - plan tests => 2; + plan tests => 4; my $patron = $builder->build({source => 'Borrower'}); my $patron_object = Koha::Patrons->find( $patron->{borrowernumber} ); is( $patron_object->borrowernumber, $patron->{borrowernumber}, '->find should return the correct object' ); eval { my @patrons = Koha::Patrons->find( $patron->{borrowernumber} ); }; like( $@, qr|^Cannot use "->find" in list context|, "->find should not be called in list context to avoid side-effects" ); + + # Test sending undef to find; should not generate a warning + warning_is { $patron = Koha::Patrons->find( undef ); } + "", "Sending undef does not trigger a DBIx warning"; + warning_is { $patron = Koha::Patrons->find( undef, undef ); } + "", "Sending two undefs does not trigger a DBIx warning too"; }; subtest 'update' => sub { @@ -112,6 +115,34 @@ subtest 'new' => sub { Koha::Patron::Categories->find($a_cat_code)->delete; }; +subtest 'find' => sub { + plan tests => 5; + + # check find on a single PK + my $patron = $builder->build({ source => 'Borrower' }); + is( Koha::Patrons->find($patron->{borrowernumber})->surname, + $patron->{surname}, "Checking an arbitrary patron column after find" + ); + # check find with unique column + my $obj = Koha::Patrons->find($patron->{cardnumber}, { key => 'cardnumber' }); + is( $obj->borrowernumber, $patron->{borrowernumber}, + 'Find with unique column and key specified' ); + # check find with an additional where clause in the attrs hash + # we do not expect to find something now + is( Koha::Patrons->find( + $patron->{borrowernumber}, + { where => { surname => { '!=', $patron->{surname} }}}, + ), undef, 'Additional where clause in find call' ); + + # check find with a composite FK + my $rule = $builder->build({ source => 'Issuingrule' }); + my @pk = ( $rule->{branchcode}, $rule->{categorycode}, $rule->{itemtype} ); + is( ref(Koha::IssuingRules->find(@pk)), "Koha::IssuingRule", + 'Find returned a Koha object for composite primary key' ); + + is( Koha::Patrons->find(), undef, 'Find returns undef if no params passed' ); +}; + subtest 'search_related' => sub { plan tests => 8; my $builder = t::lib::TestBuilder->new; --