3 # Copyright 2015 Koha Development team
5 # This file is part of Koha
7 # Koha is free software; you can redistribute it and/or modify it
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
22 use Test::More tests => 18;
26 use Koha::Authority::Types;
28 use Koha::IssuingRules;
29 use Koha::Patron::Category;
30 use Koha::Patron::Categories;
34 use t::lib::TestBuilder;
38 my $schema = Koha::Database->new->schema;
39 $schema->storage->txn_begin;
40 my $builder = t::lib::TestBuilder->new;
42 is( ref(Koha::Authority::Types->find('')), 'Koha::Authority::Type', 'Koha::Objects->find should work if the primary key is an empty string' );
44 my @columns = Koha::Patrons->columns;
45 my $borrowernumber_exists = grep { /^borrowernumber$/ } @columns;
46 is( $borrowernumber_exists, 1, 'Koha::Objects->columns should return the table columns' );
48 subtest 'find' => sub {
50 my $patron = $builder->build({source => 'Borrower'});
51 my $patron_object = Koha::Patrons->find( $patron->{borrowernumber} );
52 is( $patron_object->borrowernumber, $patron->{borrowernumber}, '->find should return the correct object' );
54 eval { my @patrons = Koha::Patrons->find( $patron->{borrowernumber} ); };
55 like( $@, qr|^Cannot use "->find" in list context|, "->find should not be called in list context to avoid side-effects" );
57 # Test sending undef to find; should not generate a warning
58 warning_is { $patron = Koha::Patrons->find( undef ); }
59 "", "Sending undef does not trigger a DBIx warning";
60 warning_is { $patron = Koha::Patrons->find( undef, undef ); }
61 "", "Sending two undefs does not trigger a DBIx warning too";
64 subtest 'update' => sub {
67 $builder->build( { source => 'City', value => { city_country => 'UK' } } );
68 $builder->build( { source => 'City', value => { city_country => 'UK' } } );
69 $builder->build( { source => 'City', value => { city_country => 'UK' } } );
70 $builder->build( { source => 'City', value => { city_country => 'France' } } );
71 $builder->build( { source => 'City', value => { city_country => 'France' } } );
72 $builder->build( { source => 'City', value => { city_country => 'Germany' } } );
73 Koha::Cities->search( { city_country => 'UK' } )->update( { city_country => 'EU' } );
74 is( Koha::Cities->search( { city_country => 'EU' } )->count, 3, 'Koha::Objects->update should have updated the 3 rows' );
75 is( Koha::Cities->search( { city_country => 'UK' } )->count, 0, 'Koha::Objects->update should have updated the 3 rows' );
78 subtest 'reset' => sub {
81 my $patrons = Koha::Patrons->search;
82 my $first_borrowernumber = $patrons->next->borrowernumber;
83 my $second_borrowernumber = $patrons->next->borrowernumber;
84 is( ref( $patrons->reset ), 'Koha::Patrons', 'Koha::Objects->reset should allow chaining' );
85 is( ref( $patrons->reset->next ), 'Koha::Patron', 'Koha::Objects->reset should allow chaining' );
86 is( $patrons->reset->next->borrowernumber, $first_borrowernumber, 'Koha::Objects->reset should work as expected');
89 subtest 'delete' => sub {
92 my $patron_1 = $builder->build({source => 'Borrower'});
93 my $patron_2 = $builder->build({source => 'Borrower'});
94 is( Koha::Patrons->search({ -or => { borrowernumber => [ $patron_1->{borrowernumber}, $patron_2->{borrowernumber}]}})->delete, 2, '');
95 is( Koha::Patrons->search({ -or => { borrowernumber => [ $patron_1->{borrowernumber}, $patron_2->{borrowernumber}]}})->count, 0, '');
98 subtest 'new' => sub {
100 my $a_cat_code = 'A_CAT_CODE';
101 my $patron_category = Koha::Patron::Category->new( { categorycode => $a_cat_code } )->store;
102 is( Koha::Patron::Categories->find($a_cat_code)->category_type, 'A', 'Koha::Object->new should set the default value' );
103 Koha::Patron::Categories->find($a_cat_code)->delete;
104 $patron_category = Koha::Patron::Category->new( { categorycode => $a_cat_code, category_type => undef } )->store;
105 is( Koha::Patron::Categories->find($a_cat_code)->category_type, 'A', 'Koha::Object->new should set the default value even if the argument exists but is not defined' );
106 Koha::Patron::Categories->find($a_cat_code)->delete;
109 subtest 'find' => sub {
112 # check find on a single PK
113 my $patron = $builder->build({ source => 'Borrower' });
114 is( Koha::Patrons->find($patron->{borrowernumber})->surname,
115 $patron->{surname}, "Checking an arbitrary patron column after find"
117 # check find with unique column
118 my $obj = Koha::Patrons->find($patron->{cardnumber}, { key => 'cardnumber' });
119 is( $obj->borrowernumber, $patron->{borrowernumber},
120 'Find with unique column and key specified' );
121 # check find with an additional where clause in the attrs hash
122 # we do not expect to find something now
123 is( Koha::Patrons->find(
124 $patron->{borrowernumber},
125 { where => { surname => { '!=', $patron->{surname} }}},
126 ), undef, 'Additional where clause in find call' );
128 # check find with a composite FK
129 my $rule = $builder->build({ source => 'Issuingrule' });
130 my @pk = ( $rule->{branchcode}, $rule->{categorycode}, $rule->{itemtype} );
131 is( ref(Koha::IssuingRules->find(@pk)), "Koha::IssuingRule",
132 'Find returned a Koha object for composite primary key' );
134 is( Koha::Patrons->find(), undef, 'Find returns undef if no params passed' );
137 subtest 'search_related' => sub {
139 my $builder = t::lib::TestBuilder->new;
140 my $patron_1 = $builder->build( { source => 'Borrower' } );
141 my $patron_2 = $builder->build( { source => 'Borrower' } );
142 my $libraries = Koha::Patrons->search( { -or => { borrowernumber => [ $patron_1->{borrowernumber}, $patron_2->{borrowernumber} ] } } )->search_related('branchcode');
143 is( ref( $libraries ), 'Koha::Libraries', 'Koha::Objects->search_related should return an instanciated Koha::Objects-based object' );
144 is( $libraries->count, 2, 'Koha::Objects->search_related should work as expected' );
145 is( $libraries->next->branchcode, $patron_1->{branchcode}, 'Koha::Objects->search_related should work as expected' );
146 is( $libraries->next->branchcode, $patron_2->{branchcode}, 'Koha::Objects->search_related should work as expected' );
148 my @libraries = Koha::Patrons->search( { -or => { borrowernumber => [ $patron_1->{borrowernumber}, $patron_2->{borrowernumber} ] } } )->search_related('branchcode');
149 is( ref( $libraries[0] ), 'Koha::Library', 'Koha::Objects->search_related should return a list of Koha::Object-based objects' );
150 is( scalar(@libraries), 2, 'Koha::Objects->search_related should work as expected' );
151 is( $libraries[0]->branchcode, $patron_1->{branchcode}, 'Koha::Objects->search_related should work as expected' );
152 is( $libraries[1]->branchcode, $patron_2->{branchcode}, 'Koha::Objects->search_related should work as expected' );
155 subtest 'single' => sub {
157 my $builder = t::lib::TestBuilder->new;
158 my $patron_1 = $builder->build( { source => 'Borrower' } );
159 my $patron_2 = $builder->build( { source => 'Borrower' } );
160 my $patron = Koha::Patrons->search({}, { rows => 1 })->single;
161 is(ref($patron), 'Koha::Patron', 'Koha::Objects->single returns a single Koha::Patron object.');
162 warning_like { Koha::Patrons->search->single } qr/SQL that returns multiple rows/,
163 "Warning is presented if single is used for a result with multiple rows.";
166 subtest 'last' => sub {
168 my $builder = t::lib::TestBuilder->new;
169 my $patron_1 = $builder->build( { source => 'Borrower' } );
170 my $patron_2 = $builder->build( { source => 'Borrower' } );
171 my $last_patron = Koha::Patrons->search->last;
172 is( $last_patron->borrowernumber, $patron_2->{borrowernumber}, '->last should return the last inserted patron' );
173 $last_patron = Koha::Patrons->search({ borrowernumber => $patron_1->{borrowernumber} })->last;
174 is( $last_patron->borrowernumber, $patron_1->{borrowernumber}, '->last should work even if there is only 1 result' );
175 $last_patron = Koha::Patrons->search({ surname => 'should_not_exist' })->last;
176 is( $last_patron, undef, '->last should return undef if search does not return any results' );
179 subtest 'get_column' => sub {
181 my @cities = Koha::Cities->search;
182 my @city_names = map { $_->city_name } @cities;
183 is_deeply( [ Koha::Cities->search->get_column('city_name') ], \@city_names, 'Koha::Objects->get_column should be allowed' );
186 subtest 'Exceptions' => sub {
189 my $patron_borrowernumber = $builder->build({ source => 'Borrower' })->{ borrowernumber };
190 my $patron = Koha::Patrons->find( $patron_borrowernumber );
194 $patron->blah('blah');
196 ok( $_->isa('Koha::Exceptions::Object::MethodNotCoveredByTests'),
197 'Calling a non-covered method should raise a Koha::Exceptions::Object::MethodNotCoveredByTests exception' );
198 is( $_->message, 'The method Koha::Patron->blah is not covered by tests!', 'The message raised should contain the package and the method' );
202 $patron->set({ blah => 'blah' });
204 ok( $_->isa('Koha::Exceptions::Object::PropertyNotFound'),
205 'Setting a non-existent property should raise a Koha::Exceptions::Object::PropertyNotFound exception' );
210 Koha::Patrons->search->not_covered_yet;
212 ok( $_->isa('Koha::Exceptions::Object::MethodNotCoveredByTests'),
213 'Calling a non-covered method should raise a Koha::Exceptions::Object::MethodNotCoveredByTests exception' );
214 is( $_->message, 'The method Koha::Patrons->not_covered_yet is not covered by tests!', 'The message raised should contain the package and the method' );
218 Koha::Patrons->not_covered_yet;
220 ok( $_->isa('Koha::Exceptions::Object::MethodNotCoveredByTests'),
221 'Calling a non-covered method should raise a Koha::Exceptions::Object::MethodNotCoveredByTests exception' );
222 is( $_->message, 'The method Koha::Patrons->not_covered_yet is not covered by tests!', 'The message raised should contain the package and the method' );
226 $schema->storage->txn_rollback;
228 subtest '->is_paged and ->pager tests' => sub {
232 $schema->storage->txn_begin;
234 # Delete existing patrons
235 Koha::Checkouts->delete;
236 Koha::Patrons->delete;
239 $builder->build_object({ class => 'Koha::Patrons' });
242 # Non-paginated search
243 my $patrons = Koha::Patrons->search();
244 is( $patrons->count, 10, 'Search returns all patrons' );
245 ok( !$patrons->is_paged, 'Search is not paged' );
248 $patrons = Koha::Patrons->search( undef, { 'page' => 1, 'rows' => 3 } );
249 is( $patrons->count, 3, 'Search returns only one page, 3 patrons' );
250 ok( $patrons->is_paged, 'Search is paged' );
251 my $pager = $patrons->pager;
252 is( ref($patrons->pager), 'DBIx::Class::ResultSet::Pager',
253 'Koha::Objects->pager returns a valid DBIx::Class object' );
255 $schema->storage->txn_rollback;
258 subtest '->search() tests' => sub {
262 $schema->storage->txn_begin;
264 my $count = Koha::Patrons->search->count;
268 $builder->build_object({ class => 'Koha::Patrons' });
271 my $patrons = Koha::Patrons->search();
272 is( ref($patrons), 'Koha::Patrons', 'search in scalar context returns the Koha::Object-based type' );
273 my @patrons = Koha::Patrons->search();
274 is( scalar @patrons, $count + 10, 'search in list context returns a list of objects' );
277 is( ref($patrons[$i]), 'Koha::Patron', 'Objects in the list have the singular type' );
281 $schema->storage->txn_rollback;
284 subtest "to_api() tests" => sub {
288 $schema->storage->txn_begin;
290 my $city_1 = $builder->build_object( { class => 'Koha::Cities' } );
291 my $city_2 = $builder->build_object( { class => 'Koha::Cities' } );
293 my $cities = Koha::Cities->search(
295 cityid => [ $city_1->cityid, $city_2->cityid ]
297 { -orderby => { -desc => 'cityid' } }
300 is( $cities->count, 2, 'Count is correct' );
301 my $cities_api = $cities->to_api;
302 is( ref( $cities_api ), 'ARRAY', 'to_api returns an array' );
303 is_deeply( $cities_api->[0], $city_1->to_api, 'to_api returns the individual objects with ->to_api' );
304 is_deeply( $cities_api->[1], $city_2->to_api, 'to_api returns the individual objects with ->to_api' );
306 $schema->storage->txn_rollback;
309 subtest "TO_JSON() tests" => sub {
313 $schema->storage->txn_begin;
315 my $city_1 = $builder->build_object( { class => 'Koha::Cities' } );
316 my $city_2 = $builder->build_object( { class => 'Koha::Cities' } );
318 my $cities = Koha::Cities->search(
320 cityid => [ $city_1->cityid, $city_2->cityid ]
322 { -orderby => { -desc => 'cityid' } }
325 is( $cities->count, 2, 'Count is correct' );
326 my $cities_json = $cities->TO_JSON;
327 is( ref($cities_json), 'ARRAY', 'to_api returns an array' );
328 is_deeply( $cities_json->[0], $city_1->TO_JSON, 'TO_JSON returns the individual objects with ->TO_JSON' );
329 is_deeply( $cities_json->[1], $city_2->TO_JSON,'TO_JSON returns the individual objects with ->TO_JSON' );
331 $schema->storage->txn_rollback;
334 # Koha::Object[s] must behave the same as DBIx::Class
335 subtest 'Return same values as DBIx::Class' => sub {
338 subtest 'Delete' => sub {
341 $schema->storage->txn_begin;
343 subtest 'Simple Koha::Objects - Koha::Cities' => sub {
346 subtest 'Koha::Object->delete' => sub {
350 my ( $r_us, $e_us, $r_them, $e_them );
352 # CASE 1 - Delete an existing object
353 my $c = Koha::City->new( { city_name => 'city4test' } )->store;
354 try { $r_us = $c->delete; } catch { $e_us = $_ };
355 $c = $schema->resultset('City')->new( { city_name => 'city4test_2' } )->update_or_insert;
356 try { $r_them = $c->delete; } catch { $e_them = $_ };
357 ok( ref($r_us) && ref($r_them),
358 'Successful delete should return the object ' );
359 ok( !defined $e_us && !defined $e_them,
360 'Successful delete should not raise an exception' );
362 # CASE 2 - Delete an object that is not in storage
363 try { $r_us = $r_us->delete; } catch { $e_us = $_ };
364 try { $r_them = $r_them->delete; } catch { $e_them = $_ };
366 defined $e_us && defined $e_them,
367 'Delete an object that is not in storage should raise an exception'
369 is( ref($e_us), 'DBIx::Class::Exception' )
370 ; # FIXME This needs adjustement, we want to throw a Koha::Exception
374 subtest 'Koha::Objects->delete' => sub {
378 my ( $r_us, $e_us, $r_them, $e_them );
380 # CASE 1 - Delete existing objects
381 my $city_1 = $builder->build_object({ class => 'Koha::Cities' });
382 my $city_2 = $builder->build_object({ class => 'Koha::Cities' });
383 my $city_3 = $builder->build_object({ class => 'Koha::Cities' });
384 my $cities = Koha::Cities->search(
396 try { $r_us = $cities->delete; } catch { $e_us = $_ };
398 $city_1 = $builder->build_object({ class => 'Koha::Cities' });
399 $city_2 = $builder->build_object({ class => 'Koha::Cities' });
400 $city_3 = $builder->build_object({ class => 'Koha::Cities' });
401 $cities = $schema->resultset('City')->search(
413 try { $r_them = $cities->delete; } catch { $e_them = $_ };
415 ok( $r_us == 3 && $r_them == 3 );
416 ok (!defined($e_us) && !defined($e_them));
418 # CASE 2 - One of the object is not in storage
419 $city_1 = $builder->build_object({ class => 'Koha::Cities' });
420 $city_2 = $builder->build_object({ class => 'Koha::Cities' });
421 $city_3 = $builder->build_object({ class => 'Koha::Cities' });
422 $cities = Koha::Cities->search(
434 $city_2->delete; # We delete one of the object
435 try { $r_us = $cities->delete; } catch { $e_us = $_ };
437 $city_1 = $builder->build_object({ class => 'Koha::Cities' });
438 $city_2 = $builder->build_object({ class => 'Koha::Cities' });
439 $city_3 = $builder->build_object({ class => 'Koha::Cities' });
440 $cities = $schema->resultset('City')->search(
452 $city_2->delete; # We delete one of the object
453 try { $r_them = $cities->delete; } catch { $e_them = $_ };
455 ok( $r_us == 2 && $r_them == 2 );
456 ok (!defined($e_us) && !defined($e_them));
460 subtest 'Overwritten Koha::Objects->delete - Koha::Patrons' => sub {
464 subtest 'Koha::Object->delete' => sub {
468 my ( $r_us, $e_us, $r_them, $e_them );
470 # CASE 1 - Delete an existing patron
471 my $patron = $builder->build_object({ class => 'Koha::Patrons' });
472 my $patron_data = $patron->unblessed;
475 $patron = Koha::Patron->new( $patron_data )->store;
476 try {$r_us = $patron->delete;} catch { $e_us = $_ };
477 $patron = $schema->resultset('Borrower')->new( $patron_data )->update_or_insert;
478 try {$r_them = $patron->delete;} catch { $e_them = $_ };
479 ok( ref($r_us) && ref($r_them),
480 'Successful delete should return the patron object' );
481 ok( !defined $e_us && !defined $e_them,
482 'Successful delete should not raise an exception' );
484 # CASE 2 - Delete a patron that is not in storage
485 try { $r_us = $r_us->delete; } catch { $e_us = $_ };
486 try { $r_them = $r_them->delete; } catch { $e_them = $_ };
488 defined $e_us && defined $e_them,
489 'Delete a patron that is not in storage should raise an exception'
491 is( ref($e_us), 'DBIx::Class::Exception' )
492 ; # FIXME This needs adjustement, we want to throw a Koha::Exception
494 # CASE 3 - Delete a patron that cannot be deleted (as a checkout)
495 $patron = Koha::Patron->new($patron_data)->store;
496 $builder->build_object(
498 class => 'Koha::Checkouts',
499 value => { borrowernumber => $patron->borrowernumber }
502 try { $r_us = $r_us->delete; } catch { $e_us = $_ };
503 $patron = $schema->resultset('Borrower')->find( $patron->borrowernumber );
504 try { $r_them = $r_them->delete; } catch { $e_them = $_ };
506 defined $e_us && defined $e_them,
507 'Delete a patron that cannot be deleted should raise an exception'
509 is( ref($e_us), 'DBIx::Class::Exception' )
510 ; # FIXME This needs adjustement, we want to throw a Koha::Exception
513 subtest 'Koha::Objects->delete' => sub {
517 my ( $r_us, $e_us, $r_them, $e_them );
519 # CASE 1 - Delete existing objects
520 my $patron_1 = $builder->build_object({ class => 'Koha::Patrons' });
521 my $patron_2 = $builder->build_object({ class => 'Koha::Patrons' });
522 my $patron_3 = $builder->build_object({ class => 'Koha::Patrons' });
523 my $patrons = Koha::Patrons->search(
527 $patron_1->borrowernumber,
528 $patron_2->borrowernumber,
529 $patron_3->borrowernumber
535 try { $r_us = $patrons->delete; } catch { $e_us = $_ };
537 $patron_1 = $builder->build_object({ class => 'Koha::Patrons' });
538 $patron_2 = $builder->build_object({ class => 'Koha::Patrons' });
539 $patron_3 = $builder->build_object({ class => 'Koha::Patrons' });
540 $patrons = $schema->resultset('Borrower')->search(
544 $patron_1->borrowernumber,
545 $patron_2->borrowernumber,
546 $patron_3->borrowernumber
552 try { $r_them = $patrons->delete; } catch { $e_them = $_ };
554 ok( $r_us == 3 && $r_them == 3, '->delete should return the number of deleted patrons' );
555 ok (!defined($e_us) && !defined($e_them), '->delete should not raise exception if everything went well');
557 # CASE 2 - One of the patrons is not in storage
558 undef $_ for $r_us, $e_us, $r_them, $e_them;
559 $patron_1 = $builder->build_object({ class => 'Koha::Patrons' });
560 $patron_2 = $builder->build_object({ class => 'Koha::Patrons' });
561 $patron_3 = $builder->build_object({ class => 'Koha::Patrons' });
562 $patrons = Koha::Patrons->search(
566 $patron_1->borrowernumber,
567 $patron_2->borrowernumber,
568 $patron_3->borrowernumber
574 $patron_2->delete; # We delete one of the patron
575 try { $r_us = $patrons->delete; } catch { $e_us = $_ };
577 $patron_1 = $builder->build_object({ class => 'Koha::Patrons' });
578 $patron_2 = $builder->build_object({ class => 'Koha::Patrons' });
579 $patron_3 = $builder->build_object({ class => 'Koha::Patrons' });
580 $patrons = $schema->resultset('Borrower')->search(
584 $patron_1->borrowernumber,
585 $patron_2->borrowernumber,
586 $patron_3->borrowernumber
592 $patron_2->delete; # We delete one of the patron
593 try { $r_them = $patrons->delete; } catch { $e_them = $_ };
595 ok( $r_us == 2 && $r_them == 2, 'Delete patrons with one that was not in storage should delete the patrons' );
596 ok (!defined($e_us) && !defined($e_them), 'no exception should be raised if at least one patron was not in storage');
598 # CASE 3 - Delete a set of patrons with one that that cannot be deleted (as a checkout)
599 undef $_ for $r_us, $e_us, $r_them, $e_them;
600 $patron_1 = $builder->build_object({ class => 'Koha::Patrons' });
601 $patron_2 = $builder->build_object({ class => 'Koha::Patrons' });
602 $patron_3 = $builder->build_object({ class => 'Koha::Patrons' });
603 $patrons = Koha::Patrons->search(
607 $patron_1->borrowernumber,
608 $patron_2->borrowernumber,
609 $patron_3->borrowernumber
615 # Adding a checkout to patron_2
616 $builder->build_object(
618 class => 'Koha::Checkouts',
619 value => { borrowernumber => $patron_2->borrowernumber }
624 try { $r_us = $patrons->delete; } catch { $e_us = $_ };
626 qr{DBD::mysql::st execute failed: Cannot delete or update a parent row: a foreign key constraint fails},
627 "Foreign key constraint DBI error should be logged";
628 my $not_deleted_us = $patron_1->in_storage + $patron_2->in_storage + $patron_3->in_storage;
630 $patron_1 = $builder->build_object({ class => 'Koha::Patrons' });
631 $patron_2 = $builder->build_object({ class => 'Koha::Patrons' });
632 $patron_3 = $builder->build_object({ class => 'Koha::Patrons' });
633 $patrons = $schema->resultset('Borrower')->search(
637 $patron_1->borrowernumber,
638 $patron_2->borrowernumber,
639 $patron_3->borrowernumber
645 # Adding a checkout to patron_2
646 $builder->build_object(
648 class => 'Koha::Checkouts',
649 value => { borrowernumber => $patron_2->borrowernumber }
654 try { $r_them = $patrons->delete; } catch { $e_them = $_ };
656 qr{DBD::mysql::st execute failed: Cannot delete or update a parent row: a foreign key constraint fails},
657 "Foreign key constraint DBI error should be logged";
659 my $not_deleted_them = $patron_1->in_storage + $patron_2->in_storage + $patron_3->in_storage;
661 defined $e_us && defined $e_them,
662 'Delete patrons with one that cannot be deleted should raise an exception'
664 is( ref($e_us), 'DBIx::Class::Exception' )
665 ; # FIXME This needs adjustement, we want to throw a Koha::Exception
667 ok($not_deleted_us == 3 && $not_deleted_them == 3, 'If one patron cannot be deleted, none should have been deleted');
671 $schema->storage->txn_rollback;