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
=> 41;
34 use C4
::Auth
qw(checkpw_hash);
40 use Koha
::Old
::Patrons
;
41 use Koha
::Patron
::Attribute
::Types
;
42 use Koha
::Patron
::Categories
;
43 use Koha
::Patron
::Relationship
;
46 use Koha
::Virtualshelves
;
48 use t
::lib
::TestBuilder
;
51 my $schema = Koha
::Database
->new->schema;
52 $schema->storage->txn_begin;
54 my $builder = t
::lib
::TestBuilder
->new;
55 my $library = $builder->build({source
=> 'Branch' });
56 my $category = $builder->build({source
=> 'Category' });
57 my $nb_of_patrons = Koha
::Patrons
->search->count;
58 my $new_patron_1 = Koha
::Patron
->new(
59 { cardnumber
=> 'test_cn_1',
60 branchcode
=> $library->{branchcode
},
61 categorycode
=> $category->{categorycode
},
62 surname
=> 'surname for patron1',
63 firstname
=> 'firstname for patron1',
64 userid
=> 'a_nonexistent_userid_1',
65 flags
=> 1, # Is superlibrarian
68 my $new_patron_2 = Koha
::Patron
->new(
69 { cardnumber
=> 'test_cn_2',
70 branchcode
=> $library->{branchcode
},
71 categorycode
=> $category->{categorycode
},
72 surname
=> 'surname for patron2',
73 firstname
=> 'firstname for patron2',
74 userid
=> 'a_nonexistent_userid_2',
78 t
::lib
::Mocks
::mock_userenv
({ patron
=> $new_patron_1 });
80 is
( Koha
::Patrons
->search->count, $nb_of_patrons + 2, 'The 2 patrons should have been added' );
82 my $retrieved_patron_1 = Koha
::Patrons
->find( $new_patron_1->borrowernumber );
83 is
( $retrieved_patron_1->cardnumber, $new_patron_1->cardnumber, 'Find a patron by borrowernumber should return the correct patron' );
85 subtest
'library' => sub {
87 is
( $retrieved_patron_1->library->branchcode, $library->{branchcode
}, 'Koha::Patron->library should return the correct library' );
88 is
( ref($retrieved_patron_1->library), 'Koha::Library', 'Koha::Patron->library should return a Koha::Library object' );
91 subtest
'sms_provider' => sub {
93 my $sms_provider = $builder->build({source
=> 'SmsProvider' });
94 is
( $retrieved_patron_1->sms_provider, undef, '->sms_provider should return undef if none defined' );
95 $retrieved_patron_1->sms_provider_id( $sms_provider->{id
} )->store;
96 is_deeply
( $retrieved_patron_1->sms_provider->unblessed, $sms_provider, 'Koha::Patron->sms_provider returns the correct SMS provider' );
97 is
( ref($retrieved_patron_1->sms_provider), 'Koha::SMS::Provider', 'Koha::Patron->sms_provider should return a Koha::SMS::Provider object' );
100 subtest
'guarantees' => sub {
103 t
::lib
::Mocks
::mock_preference
( 'borrowerRelationship', 'test|test2' );
105 my $guarantees = $new_patron_1->guarantee_relationships;
106 is
( ref($guarantees), 'Koha::Patron::Relationships', 'Koha::Patron->guarantees should return a Koha::Patrons result set in a scalar context' );
107 is
( $guarantees->count, 0, 'new_patron_1 should have 0 guarantee relationships' );
108 my @guarantees = $new_patron_1->guarantee_relationships;
109 is
( ref(\
@guarantees), 'ARRAY', 'Koha::Patron->guarantee_relationships should return an array in a list context' );
110 is
( scalar(@guarantees), 0, 'new_patron_1 should have 0 guarantee' );
112 my $guarantee_1 = $builder->build({ source
=> 'Borrower' });
113 my $relationship_1 = Koha
::Patron
::Relationship
->new( { guarantor_id
=> $new_patron_1->id, guarantee_id
=> $guarantee_1->{borrowernumber
}, relationship
=> 'test' } )->store();
114 my $guarantee_2 = $builder->build({ source
=> 'Borrower' });
115 my $relationship_2 = Koha
::Patron
::Relationship
->new( { guarantor_id
=> $new_patron_1->id, guarantee_id
=> $guarantee_2->{borrowernumber
}, relationship
=> 'test' } )->store();
117 $guarantees = $new_patron_1->guarantee_relationships;
118 is
( ref($guarantees), 'Koha::Patron::Relationships', 'Koha::Patron->guarantee_relationships should return a Koha::Patrons result set in a scalar context' );
119 is
( $guarantees->count, 2, 'new_patron_1 should have 2 guarantees' );
120 @guarantees = $new_patron_1->guarantee_relationships;
121 is
( ref(\
@guarantees), 'ARRAY', 'Koha::Patron->guarantee_relationships should return an array in a list context' );
122 is
( scalar(@guarantees), 2, 'new_patron_1 should have 2 guarantees' );
123 $_->delete for @guarantees;
125 #Test return order of guarantees BZ 18635
126 my $categorycode = $builder->build({ source
=> 'Category' })->{categorycode
};
127 my $branchcode = $builder->build({ source
=> 'Branch' })->{branchcode
};
129 my $guarantor = $builder->build_object( { class => 'Koha::Patrons' } );
131 my $order_guarantee1 = $builder->build_object(
133 class => 'Koha::Patrons',
139 $builder->build_object(
141 class => 'Koha::Patron::Relationships',
143 guarantor_id
=> $guarantor->id,
144 guarantee_id
=> $order_guarantee1,
145 relationship
=> 'test',
150 my $order_guarantee2 = $builder->build_object(
152 class => 'Koha::Patrons',
158 $builder->build_object(
160 class => 'Koha::Patron::Relationships',
162 guarantor_id
=> $guarantor->id,
163 guarantee_id
=> $order_guarantee2,
164 relationship
=> 'test',
169 my $order_guarantee3 = $builder->build_object(
171 class => 'Koha::Patrons',
174 firstname
=> 'Walrus',
178 $builder->build_object(
180 class => 'Koha::Patron::Relationships',
182 guarantor_id
=> $guarantor->id,
183 guarantee_id
=> $order_guarantee3,
184 relationship
=> 'test',
189 my $order_guarantee4 = $builder->build_object(
191 class => 'Koha::Patrons',
194 firstname
=> 'Vulture',
195 guarantorid
=> $guarantor->borrowernumber
199 $builder->build_object(
201 class => 'Koha::Patron::Relationships',
203 guarantor_id
=> $guarantor->id,
204 guarantee_id
=> $order_guarantee4,
205 relationship
=> 'test',
210 my $order_guarantee5 = $builder->build_object(
212 class => 'Koha::Patrons',
215 firstname
=> 'Unicorn',
216 guarantorid
=> $guarantor->borrowernumber
220 my $r = $builder->build_object(
222 class => 'Koha::Patron::Relationships',
224 guarantor_id
=> $guarantor->id,
225 guarantee_id
=> $order_guarantee5,
226 relationship
=> 'test',
231 $guarantees = $guarantor->guarantee_relationships->guarantees;
233 is
( $guarantees->next()->borrowernumber, $order_guarantee5, "Return first guarantor alphabetically" );
234 is
( $guarantees->next()->borrowernumber, $order_guarantee4, "Return second guarantor alphabetically" );
235 is
( $guarantees->next()->borrowernumber, $order_guarantee3, "Return third guarantor alphabetically" );
236 is
( $guarantees->next()->borrowernumber, $order_guarantee2, "Return fourth guarantor alphabetically" );
237 is
( $guarantees->next()->borrowernumber, $order_guarantee1, "Return fifth guarantor alphabetically" );
240 subtest
'category' => sub {
242 my $patron_category = $new_patron_1->category;
243 is
( ref( $patron_category), 'Koha::Patron::Category', );
244 is
( $patron_category->categorycode, $category->{categorycode
}, );
247 subtest
'siblings' => sub {
249 my $siblings = $new_patron_1->siblings;
250 is
( $siblings, undef, 'Koha::Patron->siblings should not crashed if the patron has no guarantor' );
251 my $guarantee_1 = $builder->build( { source
=> 'Borrower' } );
252 my $relationship_1 = Koha
::Patron
::Relationship
->new( { guarantor_id
=> $new_patron_1->borrowernumber, guarantee_id
=> $guarantee_1->{borrowernumber
}, relationship
=> 'test' } )->store();
253 my $retrieved_guarantee_1 = Koha
::Patrons
->find($guarantee_1);
254 $siblings = $retrieved_guarantee_1->siblings;
255 is
( ref($siblings), 'Koha::Patrons', 'Koha::Patron->siblings should return a Koha::Patrons result set in a scalar context' );
256 my @siblings = $retrieved_guarantee_1->siblings;
257 is
( ref( \
@siblings ), 'ARRAY', 'Koha::Patron->siblings should return an array in a list context' );
258 is
( $siblings->count, 0, 'guarantee_1 should not have siblings yet' );
259 my $guarantee_2 = $builder->build( { source
=> 'Borrower' } );
260 my $relationship_2 = Koha
::Patron
::Relationship
->new( { guarantor_id
=> $new_patron_1->borrowernumber, guarantee_id
=> $guarantee_2->{borrowernumber
}, relationship
=> 'test' } )->store();
261 my $guarantee_3 = $builder->build( { source
=> 'Borrower' } );
262 my $relationship_3 = Koha
::Patron
::Relationship
->new( { guarantor_id
=> $new_patron_1->borrowernumber, guarantee_id
=> $guarantee_3->{borrowernumber
}, relationship
=> 'test' } )->store();
263 $siblings = $retrieved_guarantee_1->siblings;
264 is
( $siblings->count, 2, 'guarantee_1 should have 2 siblings' );
265 is
( $guarantee_2->{borrowernumber
}, $siblings->next->borrowernumber, 'guarantee_2 should exist in the guarantees' );
266 is
( $guarantee_3->{borrowernumber
}, $siblings->next->borrowernumber, 'guarantee_3 should exist in the guarantees' );
267 $_->delete for $retrieved_guarantee_1->siblings;
268 $retrieved_guarantee_1->delete;
271 subtest
'has_overdues' => sub {
274 my $biblioitem_1 = $builder->build( { source
=> 'Biblioitem' } );
275 my $item_1 = $builder->build(
278 homebranch
=> $library->{branchcode
},
279 holdingbranch
=> $library->{branchcode
},
283 biblionumber
=> $biblioitem_1->{biblionumber
}
287 my $retrieved_patron = Koha
::Patrons
->find( $new_patron_1->borrowernumber );
288 is
( $retrieved_patron->has_overdues, 0, );
290 my $tomorrow = DateTime
->today( time_zone
=> C4
::Context
->tz() )->add( days
=> 1 );
291 my $issue = Koha
::Checkout
->new({ borrowernumber
=> $new_patron_1->id, itemnumber
=> $item_1->{itemnumber
}, date_due
=> $tomorrow, branchcode
=> $library->{branchcode
} })->store();
292 is
( $retrieved_patron->has_overdues, 0, );
294 my $yesterday = DateTime
->today(time_zone
=> C4
::Context
->tz())->add( days
=> -1 );
295 $issue = Koha
::Checkout
->new({ borrowernumber
=> $new_patron_1->id, itemnumber
=> $item_1->{itemnumber
}, date_due
=> $yesterday, branchcode
=> $library->{branchcode
} })->store();
296 $retrieved_patron = Koha
::Patrons
->find( $new_patron_1->borrowernumber );
297 is
( $retrieved_patron->has_overdues, 1, );
301 subtest
'is_expired' => sub {
303 my $patron = $builder->build({ source
=> 'Borrower' });
304 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
305 $patron->dateexpiry( undef )->store->discard_changes;
306 is
( $patron->is_expired, 0, 'Patron should not be considered expired if dateexpiry is not set');
307 $patron->dateexpiry( dt_from_string
)->store->discard_changes;
308 is
( $patron->is_expired, 0, 'Patron should not be considered expired if dateexpiry is today');
309 $patron->dateexpiry( dt_from_string
->add( days
=> 1 ) )->store->discard_changes;
310 is
( $patron->is_expired, 0, 'Patron should not be considered expired if dateexpiry is tomorrow');
311 $patron->dateexpiry( dt_from_string
->add( days
=> -1 ) )->store->discard_changes;
312 is
( $patron->is_expired, 1, 'Patron should be considered expired if dateexpiry is yesterday');
317 subtest
'is_going_to_expire' => sub {
320 my $today = dt_from_string
(undef, undef, 'floating');
321 my $patron = $builder->build({ source
=> 'Borrower' });
322 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
323 $patron->dateexpiry( undef )->store->discard_changes;
324 is
( $patron->is_going_to_expire, 0, 'Patron should not be considered going to expire if dateexpiry is not set');
326 t
::lib
::Mocks
::mock_preference
('NotifyBorrowerDeparture', 0);
327 $patron->dateexpiry( $today )->store->discard_changes;
328 is
( $patron->is_going_to_expire, 0, 'Patron should not be considered going to expire if dateexpiry is today');
330 $patron->dateexpiry( $today )->store->discard_changes;
331 is
( $patron->is_going_to_expire, 0, 'Patron should not be considered going to expire if dateexpiry is today and pref is 0');
333 t
::lib
::Mocks
::mock_preference
('NotifyBorrowerDeparture', 10);
334 $patron->dateexpiry( $today->clone->add( days
=> 11 ) )->store->discard_changes;
335 is
( $patron->is_going_to_expire, 0, 'Patron should not be considered going to expire if dateexpiry is 11 days ahead and pref is 10');
337 t
::lib
::Mocks
::mock_preference
('NotifyBorrowerDeparture', 0);
338 $patron->dateexpiry( $today->clone->add( days
=> 10 ) )->store->discard_changes;
339 is
( $patron->is_going_to_expire, 0, 'Patron should not be considered going to expire if dateexpiry is 10 days ahead and pref is 0');
341 t
::lib
::Mocks
::mock_preference
('NotifyBorrowerDeparture', 10);
342 $patron->dateexpiry( $today->clone->add( days
=> 10 ) )->store->discard_changes;
343 is
( $patron->is_going_to_expire, 0, 'Patron should not be considered going to expire if dateexpiry is 10 days ahead and pref is 10');
346 t
::lib
::Mocks
::mock_preference
('NotifyBorrowerDeparture', 10);
347 $patron->dateexpiry( $today->clone->add( days
=> 20 ) )->store->discard_changes;
348 is
( $patron->is_going_to_expire, 0, 'Patron should not be considered going to expire if dateexpiry is 20 days ahead and pref is 10');
350 t
::lib
::Mocks
::mock_preference
('NotifyBorrowerDeparture', 20);
351 $patron->dateexpiry( $today->clone->add( days
=> 10 ) )->store->discard_changes;
352 is
( $patron->is_going_to_expire, 1, 'Patron should be considered going to expire if dateexpiry is 10 days ahead and pref is 20');
354 { # Testing invalid is going to expiry date
355 t
::lib
::Mocks
::mock_preference
('NotifyBorrowerDeparture', 30);
356 # mock_config does not work here, because of tz vs timezone subroutines
357 my $context = new Test
::MockModule
('C4::Context');
358 $context->mock( 'tz', sub {
361 $patron->dateexpiry(DateTime
->new( year
=> 2019, month
=> 12, day
=> 3 ))->store;
362 eval { $patron->is_going_to_expire };
363 is
( $@
, '', 'On invalid "is going to expire" date, the method should not crash with "Invalid local time for date in time zone"');
364 $context->unmock('tz');
371 subtest
'renew_account' => sub {
374 for my $date ( '2016-03-31', '2016-11-30', '2019-01-31', dt_from_string
() ) {
375 my $dt = dt_from_string
( $date, 'iso' );
376 Time
::Fake
->offset( $dt->epoch );
377 my $a_month_ago = $dt->clone->subtract( months
=> 1, end_of_month
=> 'limit' )->truncate( to
=> 'day' );
378 my $a_year_later = $dt->clone->add( months
=> 12, end_of_month
=> 'limit' )->truncate( to
=> 'day' );
379 my $a_year_later_minus_a_month = $a_month_ago->clone->add( months
=> 12, end_of_month
=> 'limit' )->truncate( to
=> 'day' );
380 my $a_month_later = $dt->clone->add( months
=> 1 , end_of_month
=> 'limit' )->truncate( to
=> 'day' );
381 my $a_year_later_plus_a_month = $a_month_later->clone->add( months
=> 12, end_of_month
=> 'limit' )->truncate( to
=> 'day' );
382 my $patron_category = $builder->build(
383 { source
=> 'Category',
385 enrolmentperiod
=> 12,
386 enrolmentperioddate
=> undef,
390 my $patron = $builder->build(
391 { source
=> 'Borrower',
393 dateexpiry
=> $a_month_ago,
394 categorycode
=> $patron_category->{categorycode
},
395 date_renewed
=> undef, # Force builder to not populate the column for new patron
399 my $patron_2 = $builder->build(
400 { source
=> 'Borrower',
402 dateexpiry
=> $a_month_ago,
403 categorycode
=> $patron_category->{categorycode
},
407 my $patron_3 = $builder->build(
408 { source
=> 'Borrower',
410 dateexpiry
=> $a_month_later,
411 categorycode
=> $patron_category->{categorycode
},
415 my $retrieved_patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
416 my $retrieved_patron_2 = Koha
::Patrons
->find( $patron_2->{borrowernumber
} );
417 my $retrieved_patron_3 = Koha
::Patrons
->find( $patron_3->{borrowernumber
} );
419 is
( $retrieved_patron->date_renewed, undef, "Date renewed is not set for patrons that have never been renewed" );
421 t
::lib
::Mocks
::mock_preference
( 'BorrowerRenewalPeriodBase', 'dateexpiry' );
422 t
::lib
::Mocks
::mock_preference
( 'BorrowersLog', 1 );
423 my $expiry_date = $retrieved_patron->renew_account;
424 is
( $expiry_date, $a_year_later_minus_a_month, "$a_month_ago + 12 months must be $a_year_later_minus_a_month" );
425 my $retrieved_expiry_date = Koha
::Patrons
->find( $patron->{borrowernumber
} )->dateexpiry;
426 is
( dt_from_string
($retrieved_expiry_date), $a_year_later_minus_a_month, "$a_month_ago + 12 months must be $a_year_later_minus_a_month" );
427 my $number_of_logs = $schema->resultset('ActionLog')->search( { module
=> 'MEMBERS', action
=> 'RENEW', object
=> $retrieved_patron->borrowernumber } )->count;
428 is
( $number_of_logs, 1, 'With BorrowerLogs, Koha::Patron->renew_account should have logged' );
430 t
::lib
::Mocks
::mock_preference
( 'BorrowerRenewalPeriodBase', 'now' );
431 t
::lib
::Mocks
::mock_preference
( 'BorrowersLog', 0 );
432 $expiry_date = $retrieved_patron->renew_account;
433 is
( $expiry_date, $a_year_later, "today + 12 months must be $a_year_later" );
434 $retrieved_patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
435 is
( $retrieved_patron->date_renewed, output_pref
({ dt
=> $dt, dateformat
=> 'iso', dateonly
=> 1 }), "Date renewed is set when calling renew_account" );
436 $retrieved_expiry_date = $retrieved_patron->dateexpiry;
437 is
( dt_from_string
($retrieved_expiry_date), $a_year_later, "today + 12 months must be $a_year_later" );
438 $number_of_logs = $schema->resultset('ActionLog')->search( { module
=> 'MEMBERS', action
=> 'RENEW', object
=> $retrieved_patron->borrowernumber } )->count;
439 is
( $number_of_logs, 1, 'Without BorrowerLogs, Koha::Patron->renew_account should not have logged' );
441 t
::lib
::Mocks
::mock_preference
( 'BorrowerRenewalPeriodBase', 'combination' );
442 $expiry_date = $retrieved_patron_2->renew_account;
443 is
( $expiry_date, $a_year_later, "today + 12 months must be $a_year_later" );
444 $retrieved_expiry_date = Koha
::Patrons
->find( $patron_2->{borrowernumber
} )->dateexpiry;
445 is
( dt_from_string
($retrieved_expiry_date), $a_year_later, "today + 12 months must be $a_year_later" );
447 $expiry_date = $retrieved_patron_3->renew_account;
448 is
( $expiry_date, $a_year_later_plus_a_month, "$a_month_later + 12 months must be $a_year_later_plus_a_month" );
449 $retrieved_expiry_date = Koha
::Patrons
->find( $patron_3->{borrowernumber
} )->dateexpiry;
450 is
( dt_from_string
($retrieved_expiry_date), $a_year_later_plus_a_month, "$a_month_later + 12 months must be $a_year_later_plus_a_month" );
452 $retrieved_patron->delete;
453 $retrieved_patron_2->delete;
454 $retrieved_patron_3->delete;
459 subtest
"move_to_deleted" => sub {
461 my $originally_updated_on = '2016-01-01 12:12:12';
462 my $patron = $builder->build( { source
=> 'Borrower',value
=> { updated_on
=> $originally_updated_on } } );
463 my $retrieved_patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
464 is
( ref( $retrieved_patron->move_to_deleted ), 'Koha::Schema::Result::Deletedborrower', 'Koha::Patron->move_to_deleted should return the Deleted patron' )
465 ; # FIXME This should be Koha::Deleted::Patron
466 my $deleted_patron = $schema->resultset('Deletedborrower')
467 ->search( { borrowernumber
=> $patron->{borrowernumber
} }, { result_class
=> 'DBIx::Class::ResultClass::HashRefInflator' } )
469 ok
( $retrieved_patron->updated_on, 'updated_on should be set for borrowers table' );
470 ok
( $deleted_patron->{updated_on
}, 'updated_on should be set for deleted_borrowers table' );
471 isnt
( $deleted_patron->{updated_on
}, $retrieved_patron->updated_on, 'Koha::Patron->move_to_deleted should have correctly updated the updated_on column');
472 $deleted_patron->{updated_on
} = $originally_updated_on; #reset for simplicity in comparing all other fields
473 is_deeply
( $deleted_patron, $patron, 'Koha::Patron->move_to_deleted should have correctly moved the patron to the deleted table' );
474 $retrieved_patron->delete( $patron->{borrowernumber
} ); # Cleanup
477 subtest
"delete" => sub {
479 t
::lib
::Mocks
::mock_preference
( 'BorrowersLog', 1 );
480 my $patron = $builder->build( { source
=> 'Borrower' } );
481 my $retrieved_patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
482 my $hold = $builder->build(
483 { source
=> 'Reserve',
484 value
=> { borrowernumber
=> $patron->{borrowernumber
} }
487 my $list = $builder->build(
488 { source
=> 'Virtualshelve',
489 value
=> { owner
=> $patron->{borrowernumber
} }
492 my $modification = $builder->build_object({ class => 'Koha::Patron::Modifications', value
=> { borrowernumber
=> $patron->{borrowernumber
} } });
494 my $deleted = $retrieved_patron->delete;
495 is
( ref($deleted), 'Koha::Patron', 'Koha::Patron->delete should return the deleted patron object if the patron has been correctly deleted' );
497 is
( Koha
::Patrons
->find( $patron->{borrowernumber
} ), undef, 'Koha::Patron->delete should have deleted the patron' );
499 is
(Koha
::Old
::Holds
->search( { reserve_id
=> $hold->{ reserve_id
} } )->count, 1, q
|Koha
::Patron
->delete should have cancelled patron
's holds| );
501 is( Koha::Holds->search( { borrowernumber => $patron->{borrowernumber} } )->count, 0, q|Koha::Patron->delete should have cancelled patron's holds
2| );
503 is
( Koha
::Virtualshelves
->search( { owner
=> $patron->{borrowernumber
} } )->count, 0, q
|Koha
::Patron
->delete should have deleted patron
's lists| );
505 is( Koha::Patron::Modifications->search( { borrowernumber => $patron->{borrowernumber} } )->count, 0, q|Koha::Patron->delete should have deleted patron's modifications
| );
507 my $number_of_logs = $schema->resultset('ActionLog')->search( { module
=> 'MEMBERS', action
=> 'DELETE', object
=> $retrieved_patron->borrowernumber } )->count;
508 is
( $number_of_logs, 1, 'With BorrowerLogs, Koha::Patron->delete should have logged' );
511 subtest
'Koha::Patrons->delete' => sub {
514 my $patron1 = $builder->build_object({ class => 'Koha::Patrons' });
515 my $patron2 = $builder->build_object({ class => 'Koha::Patrons' });
516 my $id1 = $patron1->borrowernumber;
517 my $set = Koha
::Patrons
->search({ borrowernumber
=> { -in => [$patron1->borrowernumber, $patron2->borrowernumber]}});
518 is
( $set->count, 2, 'Two patrons found as expected' );
519 is
( $set->delete({ move
=> 1 }), 2, 'Two patrons deleted' );
520 my $deleted_patrons = Koha
::Old
::Patrons
->search({ borrowernumber
=> { -in => [$patron1->borrowernumber, $patron2->borrowernumber]}});
521 is
( $deleted_patrons->count, 2, 'Patrons moved to deletedborrowers' );
523 # See other tests in t/db_dependent/Koha/Objects.t
526 subtest
'add_enrolment_fee_if_needed' => sub {
529 my $enrolmentfees = { K
=> 5, J
=> 10, YA
=> 20 };
530 foreach( keys %{$enrolmentfees} ) {
531 ( Koha
::Patron
::Categories
->find( $_ ) // $builder->build_object({ class => 'Koha::Patron::Categories', value
=> { categorycode
=> $_ } }) )->enrolmentfee( $enrolmentfees->{$_} )->store;
533 my $enrolmentfee_K = $enrolmentfees->{K
};
534 my $enrolmentfee_J = $enrolmentfees->{J
};
535 my $enrolmentfee_YA = $enrolmentfees->{YA
};
537 my %borrower_data = (
538 firstname
=> 'my firstname',
539 surname
=> 'my surname',
541 branchcode
=> $library->{branchcode
},
544 my $borrowernumber = Koha
::Patron
->new(\
%borrower_data)->store->borrowernumber;
545 $borrower_data{borrowernumber
} = $borrowernumber;
547 my $patron = Koha
::Patrons
->find( $borrowernumber );
548 my $total = $patron->account->balance;
549 is
( int($total), int($enrolmentfee_K), "New kid pay $enrolmentfee_K" );
551 t
::lib
::Mocks
::mock_preference
( 'FeeOnChangePatronCategory', 0 );
552 $borrower_data{categorycode
} = 'J';
553 $patron->set(\
%borrower_data)->store;
554 $total = $patron->account->balance;
555 is
( int($total), int($enrolmentfee_K), "Kid growing and become a juvenile, but shouldn't pay for the upgrade " );
557 $borrower_data{categorycode
} = 'K';
558 $patron->set(\
%borrower_data)->store;
559 t
::lib
::Mocks
::mock_preference
( 'FeeOnChangePatronCategory', 1 );
561 $borrower_data{categorycode
} = 'J';
562 $patron->set(\
%borrower_data)->store;
563 $total = $patron->account->balance;
564 is
( int($total), int($enrolmentfee_K + $enrolmentfee_J), "Kid growing and become a juvenile, they should pay " . ( $enrolmentfee_K + $enrolmentfee_J ) );
566 # Check with calling directly Koha::Patron->get_enrolment_fee_if_needed
567 $patron->categorycode('YA')->store;
568 $total = $patron->account->balance;
570 int($enrolmentfee_K + $enrolmentfee_J + $enrolmentfee_YA),
571 "Juvenile growing and become an young adult, they should pay " . ( $enrolmentfee_K + $enrolmentfee_J + $enrolmentfee_YA )
577 subtest
'checkouts + pending_checkouts + get_overdues + old_checkouts' => sub {
580 my $library = $builder->build( { source
=> 'Branch' } );
581 my ($biblionumber_1) = AddBiblio
( MARC
::Record
->new, '' );
582 my $item_1 = $builder->build(
586 homebranch
=> $library->{branchcode
},
587 holdingbranch
=> $library->{branchcode
},
588 biblionumber
=> $biblionumber_1,
594 my $item_2 = $builder->build(
598 homebranch
=> $library->{branchcode
},
599 holdingbranch
=> $library->{branchcode
},
600 biblionumber
=> $biblionumber_1,
606 my ($biblionumber_2) = AddBiblio
( MARC
::Record
->new, '' );
607 my $item_3 = $builder->build(
611 homebranch
=> $library->{branchcode
},
612 holdingbranch
=> $library->{branchcode
},
613 biblionumber
=> $biblionumber_2,
619 my $patron = $builder->build(
621 source
=> 'Borrower',
622 value
=> { branchcode
=> $library->{branchcode
} }
626 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
627 my $checkouts = $patron->checkouts;
628 is
( $checkouts->count, 0, 'checkouts should not return any issues for that patron' );
629 is
( ref($checkouts), 'Koha::Checkouts', 'checkouts should return a Koha::Checkouts object' );
630 my $pending_checkouts = $patron->pending_checkouts;
631 is
( $pending_checkouts->count, 0, 'pending_checkouts should not return any issues for that patron' );
632 is
( ref($pending_checkouts), 'Koha::Checkouts', 'pending_checkouts should return a Koha::Checkouts object' );
633 my $old_checkouts = $patron->old_checkouts;
634 is
( $old_checkouts->count, 0, 'old_checkouts should not return any issues for that patron' );
635 is
( ref($old_checkouts), 'Koha::Old::Checkouts', 'old_checkouts should return a Koha::Old::Checkouts object' );
637 # Not sure how this is useful, but AddIssue pass this variable to different other subroutines
638 $patron = Koha
::Patrons
->find( $patron->borrowernumber )->unblessed;
640 t
::lib
::Mocks
::mock_userenv
({ branchcode
=> $library->{branchcode
} });
642 AddIssue
( $patron, $item_1->{barcode
}, DateTime
->now->subtract( days
=> 1 ) );
643 AddIssue
( $patron, $item_2->{barcode
}, DateTime
->now->subtract( days
=> 5 ) );
644 AddIssue
( $patron, $item_3->{barcode
} );
646 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
647 $checkouts = $patron->checkouts;
648 is
( $checkouts->count, 3, 'checkouts should return 3 issues for that patron' );
649 is
( ref($checkouts), 'Koha::Checkouts', 'checkouts should return a Koha::Checkouts object' );
650 $pending_checkouts = $patron->pending_checkouts;
651 is
( $pending_checkouts->count, 3, 'pending_checkouts should return 3 issues for that patron' );
652 is
( ref($pending_checkouts), 'Koha::Checkouts', 'pending_checkouts should return a Koha::Checkouts object' );
654 my $first_checkout = $pending_checkouts->next;
655 is
( $first_checkout->unblessed_all_relateds->{biblionumber
}, $item_3->{biblionumber
}, 'pending_checkouts should prefetch values from other tables (here biblio)' );
657 my $overdues = $patron->get_overdues;
658 is
( $overdues->count, 2, 'Patron should have 2 overdues');
659 is
( ref($overdues), 'Koha::Checkouts', 'Koha::Patron->get_overdues should return Koha::Checkouts' );
660 is
( $overdues->next->itemnumber, $item_1->{itemnumber
}, 'The issue should be returned in the same order as they have been done, first is correct' );
661 is
( $overdues->next->itemnumber, $item_2->{itemnumber
}, 'The issue should be returned in the same order as they have been done, second is correct' );
664 C4
::Circulation
::AddReturn
( $item_1->{barcode
} );
665 C4
::Circulation
::AddReturn
( $item_2->{barcode
} );
666 $old_checkouts = $patron->old_checkouts;
667 is
( $old_checkouts->count, 2, 'old_checkouts should return 2 old checkouts that patron' );
668 is
( ref($old_checkouts), 'Koha::Old::Checkouts', 'old_checkouts should return a Koha::Old::Checkouts object' );
671 Koha
::Checkouts
->search( { borrowernumber
=> $patron->borrowernumber } )->delete;
675 subtest
'get_routing_lists' => sub {
678 my $biblio = Koha
::Biblio
->new()->store();
679 my $subscription = Koha
::Subscription
->new({
680 biblionumber
=> $biblio->biblionumber,
684 my $patron = $builder->build( { source
=> 'Borrower' } );
685 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
687 is
( $patron->get_routing_lists->count, 0, 'Retrieves correct number of routing lists: 0' );
689 my $routinglist_count = Koha
::Subscription
::Routinglists
->count;
690 my $routinglist = Koha
::Subscription
::Routinglist
->new({
691 borrowernumber
=> $patron->borrowernumber,
693 subscriptionid
=> $subscription->subscriptionid
696 is
($patron->get_routing_lists->count, 1, "Retrieves correct number of routing lists: 1");
698 my $routinglists = $patron->get_routing_lists;
699 is
($routinglists->next->ranking, 5, "Retrieves ranking: 5");
700 is
( ref($routinglists), 'Koha::Subscription::Routinglists', 'get_routing_lists returns Koha::Subscription::Routinglists' );
702 my $subscription2 = Koha
::Subscription
->new({
703 biblionumber
=> $biblio->biblionumber,
706 my $routinglist2 = Koha
::Subscription
::Routinglist
->new({
707 borrowernumber
=> $patron->borrowernumber,
709 subscriptionid
=> $subscription2->subscriptionid
712 is
($patron->get_routing_lists->count, 2, "Retrieves correct number of routing lists: 2");
714 $patron->delete; # Clean up for later tests
718 subtest
'get_age' => sub {
721 my $patron = $builder->build( { source
=> 'Borrower' } );
722 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
726 today
=> '2020-02-28',
727 has_12
=> { date
=> '2007-08-27', expected_age
=> 12 },
728 almost_18
=> { date
=> '2002-03-01', expected_age
=> 17 },
729 has_18_today
=> { date
=> '2002-02-28', expected_age
=> 18 },
730 had_18_yesterday
=> { date
=> '2002-02-27', expected_age
=> 18 },
731 almost_16
=> { date
=> '2004-02-29', expected_age
=> 15 },
732 has_16_today
=> { date
=> '2004-02-28', expected_age
=> 16 },
733 had_16_yesterday
=> { date
=> '2004-02-27', expected_age
=> 16 },
734 new_born
=> { date
=> '2020-01-27', expected_age
=> 0 },
737 today
=> '2020-02-29',
738 has_12
=> { date
=> '2007-08-27', expected_age
=> 12 },
739 almost_18
=> { date
=> '2002-03-01', expected_age
=> 17 },
740 has_18_today
=> { date
=> '2002-02-28', expected_age
=> 18 },
741 had_18_yesterday
=> { date
=> '2002-02-27', expected_age
=> 18 },
742 almost_16
=> { date
=> '2004-03-01', expected_age
=> 15 },
743 has_16_today
=> { date
=> '2004-02-29', expected_age
=> 16 },
744 had_16_yesterday
=> { date
=> '2004-02-28', expected_age
=> 16 },
745 new_born
=> { date
=> '2020-01-27', expected_age
=> 0 },
748 today
=> '2020-03-01',
749 has_12
=> { date
=> '2007-08-27', expected_age
=> 12 },
750 almost_18
=> { date
=> '2002-03-02', expected_age
=> 17 },
751 has_18_today
=> { date
=> '2002-03-01', expected_age
=> 18 },
752 had_18_yesterday
=> { date
=> '2002-02-28', expected_age
=> 18 },
753 almost_16
=> { date
=> '2004-03-02', expected_age
=> 15 },
754 has_16_today
=> { date
=> '2004-03-01', expected_age
=> 16 },
755 had_16_yesterday
=> { date
=> '2004-02-29', expected_age
=> 16 },
758 today
=> '2019-01-31',
759 has_12
=> { date
=> '2006-08-27', expected_age
=> 12 },
760 almost_18
=> { date
=> '2001-02-01', expected_age
=> 17 },
761 has_18_today
=> { date
=> '2001-01-31', expected_age
=> 18 },
762 had_18_yesterday
=> { date
=> '2001-01-30', expected_age
=> 18 },
763 almost_16
=> { date
=> '2003-02-01', expected_age
=> 15 },
764 has_16_today
=> { date
=> '2003-01-31', expected_age
=> 16 },
765 had_16_yesterday
=> { date
=> '2003-01-30', expected_age
=> 16 },
769 $patron->dateofbirth( undef );
770 is
( $patron->get_age, undef, 'get_age should return undef if no dateofbirth is defined' );
772 for my $date ( @dates ) {
774 my $dt = dt_from_string
($date->{today
});
776 Time
::Fake
->offset( $dt->epoch );
778 for my $k ( keys %$date ) {
779 next if $k eq 'today';
781 my $dob = $date->{$k};
782 $patron->dateofbirth( dt_from_string
( $dob->{date
}, 'iso' ) );
785 $dob->{expected_age
},
787 "Today=%s, dob=%s, should be %d",
788 $date->{today
}, $dob->{date
}, $dob->{expected_age
}
800 subtest
'is_valid_age' => sub {
803 my $dt = dt_from_string
('2020-02-28');
805 Time
::Fake
->offset( $dt->epoch );
807 my $category = $builder->build({
808 source
=> 'Category',
810 categorycode
=> 'AGE_5_10',
811 dateofbirthrequired
=> 5,
815 $category = Koha
::Patron
::Categories
->find( $category->{categorycode
} );
817 my $patron = $builder->build({
818 source
=> 'Borrower',
820 categorycode
=> 'AGE_5_10'
823 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
826 $patron->dateofbirth( undef );
827 is
( $patron->is_valid_age, 1, 'Patron with no dateofbirth is always valid for any category');
831 today
=> '2020-02-28',
833 { date
=> '2007-08-27', expected_age
=> 12, valid
=> 0 },
835 { date
=> '2016-08-27', expected_age
=> 3, valid
=> 0 },
837 { date
=> '2015-02-28', expected_age
=> 7, valid
=> 1 },
839 { date
=> '2015-02-28', expected_age
=> 5, valid
=> 1 },
841 { date
=> '2015-03-01', expected_age
=> 5, valid
=> 0 },
843 { date
=> '2015-02-27', expected_age
=> 5, valid
=> 1 },
845 { date
=> '2009-02-28', expected_age
=> 11, valid
=> 0 },
847 { date
=> '2009-03-01', expected_age
=> 11, valid
=> 1 },
849 { date
=> '2009-02-27', expected_age
=> 11, valid
=> 0 },
853 for my $date ( @dates ) {
855 my $dt = dt_from_string
($date->{today
});
857 Time
::Fake
->offset( $dt->epoch );
859 for my $k ( keys %$date ) {
860 next if $k eq 'today';
862 my $dob = $date->{$k};
863 $patron->dateofbirth( dt_from_string
( $dob->{date
}, 'iso' ) );
865 $patron->is_valid_age,
868 "Today=%s, dob=%s, is %s, should be valid=%s",
869 $date->{today
}, $dob->{date
}, $dob->{expected_age
}, $dob->{valid
}
882 subtest
'account' => sub {
885 my $patron = $builder->build({source
=> 'Borrower'});
887 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
888 my $account = $patron->account;
889 is
( ref($account), 'Koha::Account', 'account should return a Koha::Account object' );
894 subtest
'search_upcoming_membership_expires' => sub {
897 my $expiry_days = 15;
898 t
::lib
::Mocks
::mock_preference
( 'MembershipExpiryDaysNotice', $expiry_days );
899 my $nb_of_days_before = 1;
900 my $nb_of_days_after = 2;
902 my $builder = t
::lib
::TestBuilder
->new();
904 my $library = $builder->build({ source
=> 'Branch' });
906 # before we add borrowers to this branch, add the expires we have now
907 # note that this pertains to the current mocked setting of the pref
908 # for this reason we add the new branchcode to most of the tests
909 my $nb_of_expires = Koha
::Patrons
->search_upcoming_membership_expires->count;
911 my $patron_1 = $builder->build({
912 source
=> 'Borrower',
914 branchcode
=> $library->{branchcode
},
915 dateexpiry
=> dt_from_string
->add( days
=> $expiry_days )
919 my $patron_2 = $builder->build({
920 source
=> 'Borrower',
922 branchcode
=> $library->{branchcode
},
923 dateexpiry
=> dt_from_string
->add( days
=> $expiry_days - $nb_of_days_before )
927 my $patron_3 = $builder->build({
928 source
=> 'Borrower',
930 branchcode
=> $library->{branchcode
},
931 dateexpiry
=> dt_from_string
->add( days
=> $expiry_days + $nb_of_days_after )
935 # Test without extra parameters
936 my $upcoming_mem_expires = Koha
::Patrons
->search_upcoming_membership_expires();
937 is
( $upcoming_mem_expires->count, $nb_of_expires + 1, 'Get upcoming membership expires should return one new borrower.' );
940 $upcoming_mem_expires = Koha
::Patrons
->search_upcoming_membership_expires({ 'me.branchcode' => $library->{branchcode
} });
941 is
( $upcoming_mem_expires->count, 1, 'Test with branch parameter' );
942 my $expired = $upcoming_mem_expires->next;
943 is
( $expired->surname, $patron_1->{surname
}, 'Get upcoming membership expires should return the correct patron.' );
944 is
( $expired->library->branchemail, $library->{branchemail
}, 'Get upcoming membership expires should return the correct patron.' );
945 is
( $expired->branchcode, $patron_1->{branchcode
}, 'Get upcoming membership expires should return the correct patron.' );
947 t
::lib
::Mocks
::mock_preference
( 'MembershipExpiryDaysNotice', 0 );
948 $upcoming_mem_expires = Koha
::Patrons
->search_upcoming_membership_expires({ 'me.branchcode' => $library->{branchcode
} });
949 is
( $upcoming_mem_expires->count, 0, 'Get upcoming membership expires with MembershipExpiryDaysNotice==0 should not return new records.' );
951 # Test MembershipExpiryDaysNotice == undef
952 t
::lib
::Mocks
::mock_preference
( 'MembershipExpiryDaysNotice', undef );
953 $upcoming_mem_expires = Koha
::Patrons
->search_upcoming_membership_expires({ 'me.branchcode' => $library->{branchcode
} });
954 is
( $upcoming_mem_expires->count, 0, 'Get upcoming membership expires without MembershipExpiryDaysNotice should not return new records.' );
956 # Test the before parameter
957 t
::lib
::Mocks
::mock_preference
( 'MembershipExpiryDaysNotice', 15 );
958 $upcoming_mem_expires = Koha
::Patrons
->search_upcoming_membership_expires({ 'me.branchcode' => $library->{branchcode
}, before
=> $nb_of_days_before });
959 is
( $upcoming_mem_expires->count, 2, 'Expect two results for before');
960 # Test after parameter also
961 $upcoming_mem_expires = Koha
::Patrons
->search_upcoming_membership_expires({ 'me.branchcode' => $library->{branchcode
}, before
=> $nb_of_days_before, after
=> $nb_of_days_after });
962 is
( $upcoming_mem_expires->count, 3, 'Expect three results when adding after' );
963 Koha
::Patrons
->search({ borrowernumber
=> { in => [ $patron_1->{borrowernumber
}, $patron_2->{borrowernumber
}, $patron_3->{borrowernumber
} ] } })->delete;
966 subtest
'holds and old_holds' => sub {
969 my $library = $builder->build( { source
=> 'Branch' } );
970 my ($biblionumber_1) = AddBiblio
( MARC
::Record
->new, '' );
971 my $item_1 = $builder->build(
975 homebranch
=> $library->{branchcode
},
976 holdingbranch
=> $library->{branchcode
},
977 biblionumber
=> $biblionumber_1
981 my $item_2 = $builder->build(
985 homebranch
=> $library->{branchcode
},
986 holdingbranch
=> $library->{branchcode
},
987 biblionumber
=> $biblionumber_1
991 my ($biblionumber_2) = AddBiblio
( MARC
::Record
->new, '' );
992 my $item_3 = $builder->build(
996 homebranch
=> $library->{branchcode
},
997 holdingbranch
=> $library->{branchcode
},
998 biblionumber
=> $biblionumber_2
1002 my $patron = $builder->build(
1004 source
=> 'Borrower',
1005 value
=> { branchcode
=> $library->{branchcode
} }
1009 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
1010 my $holds = $patron->holds;
1011 is
( ref($holds), 'Koha::Holds',
1012 'Koha::Patron->holds should return a Koha::Holds objects' );
1013 is
( $holds->count, 0, 'There should not be holds placed by this patron yet' );
1015 C4
::Reserves
::AddReserve
(
1017 branchcode
=> $library->{branchcode
},
1018 borrowernumber
=> $patron->borrowernumber,
1019 biblionumber
=> $biblionumber_1
1023 C4
::Reserves
::AddReserve
(
1025 branchcode
=> $library->{branchcode
},
1026 borrowernumber
=> $patron->borrowernumber,
1027 biblionumber
=> $biblionumber_2,
1028 expiration_date
=> dt_from_string
->add( days
=> 2 )
1032 $holds = $patron->holds;
1033 is
( $holds->count, 2, 'There should be 2 holds placed by this patron' );
1035 my $old_holds = $patron->old_holds;
1036 is
( ref($old_holds), 'Koha::Old::Holds',
1037 'Koha::Patron->old_holds should return a Koha::Old::Holds objects' );
1038 is
( $old_holds->count, 0, 'There should not be any old holds yet');
1040 my $hold = $holds->next;
1043 $old_holds = $patron->old_holds;
1044 is
( $old_holds->count, 1, 'There should be 1 old (cancelled) hold');
1051 subtest
'notice_email_address' => sub {
1054 my $patron = $builder->build_object({ class => 'Koha::Patrons' });
1056 t
::lib
::Mocks
::mock_preference
( 'AutoEmailPrimaryAddress', 'OFF' );
1057 is
($patron->notice_email_address, $patron->email, "Koha::Patron->notice_email_address returns correct value when AutoEmailPrimaryAddress is off");
1059 t
::lib
::Mocks
::mock_preference
( 'AutoEmailPrimaryAddress', 'emailpro' );
1060 is
($patron->notice_email_address, $patron->emailpro, "Koha::Patron->notice_email_address returns correct value when AutoEmailPrimaryAddress is emailpro");
1065 subtest
'search_patrons_to_anonymise & anonymise_issue_history' => sub {
1068 # TODO create a subroutine in t::lib::Mocks
1069 my $branch = $builder->build({ source
=> 'Branch' });
1070 my $userenv_patron = $builder->build_object({
1071 class => 'Koha::Patrons',
1072 value
=> { branchcode
=> $branch->{branchcode
}, flags
=> 0 },
1074 t
::lib
::Mocks
::mock_userenv
({ patron
=> $userenv_patron });
1076 my $anonymous = $builder->build( { source
=> 'Borrower', }, );
1078 t
::lib
::Mocks
::mock_preference
( 'AnonymousPatron', $anonymous->{borrowernumber
} );
1080 subtest
'patron privacy is 1 (default)' => sub {
1083 t
::lib
::Mocks
::mock_preference
('IndependentBranches', 0);
1084 my $patron = $builder->build(
1085 { source
=> 'Borrower',
1086 value
=> { privacy
=> 1, }
1089 my $item_1 = $builder->build(
1097 my $issue_1 = $builder->build(
1098 { source
=> 'Issue',
1100 borrowernumber
=> $patron->{borrowernumber
},
1101 itemnumber
=> $item_1->{itemnumber
},
1105 my $item_2 = $builder->build(
1113 my $issue_2 = $builder->build(
1114 { source
=> 'Issue',
1116 borrowernumber
=> $patron->{borrowernumber
},
1117 itemnumber
=> $item_2->{itemnumber
},
1122 my ( $returned_1, undef, undef ) = C4
::Circulation
::AddReturn
( $item_1->{barcode
}, undef, undef, dt_from_string
('2010-10-10') );
1123 my ( $returned_2, undef, undef ) = C4
::Circulation
::AddReturn
( $item_2->{barcode
}, undef, undef, dt_from_string
('2011-11-11') );
1124 is
( $returned_1 && $returned_2, 1, 'The items should have been returned' );
1126 my $patrons_to_anonymise = Koha
::Patrons
->search_patrons_to_anonymise( { before
=> '2010-10-11' } )->search( { 'me.borrowernumber' => $patron->{borrowernumber
} } );
1127 is
( ref($patrons_to_anonymise), 'Koha::Patrons', 'search_patrons_to_anonymise should return Koha::Patrons' );
1129 my $rows_affected = Koha
::Patrons
->search_patrons_to_anonymise( { before
=> '2011-11-12' } )->anonymise_issue_history( { before
=> '2010-10-11' } );
1130 ok
( $rows_affected > 0, 'AnonymiseIssueHistory should affect at least 1 row' );
1132 $patrons_to_anonymise = Koha
::Patrons
->search_patrons_to_anonymise( { before
=> '2010-10-11' } );
1133 is
( $patrons_to_anonymise->count, 0, 'search_patrons_to_anonymise should return 0 after anonymisation is done' );
1135 my $dbh = C4
::Context
->dbh;
1136 my $sth = $dbh->prepare(q
|SELECT borrowernumber FROM old_issues where itemnumber
= ?
|);
1137 $sth->execute($item_1->{itemnumber
});
1138 my ($borrowernumber_used_to_anonymised) = $sth->fetchrow_array;
1139 is
( $borrowernumber_used_to_anonymised, $anonymous->{borrowernumber
}, 'With privacy=1, the issue should have been anonymised' );
1140 $sth->execute($item_2->{itemnumber
});
1141 ($borrowernumber_used_to_anonymised) = $sth->fetchrow_array;
1142 is
( $borrowernumber_used_to_anonymised, $patron->{borrowernumber
}, 'The issue should not have been anonymised, the returned date is later' );
1144 $rows_affected = Koha
::Patrons
->search_patrons_to_anonymise( { before
=> '2011-11-12' } )->anonymise_issue_history;
1145 $sth->execute($item_2->{itemnumber
});
1146 ($borrowernumber_used_to_anonymised) = $sth->fetchrow_array;
1147 is
( $borrowernumber_used_to_anonymised, $anonymous->{borrowernumber
}, 'The issue should have been anonymised, the returned date is before' );
1149 my $sth_reset = $dbh->prepare(q
|UPDATE old_issues SET borrowernumber
= ? WHERE itemnumber
= ?
|);
1150 $sth_reset->execute( $patron->{borrowernumber
}, $item_1->{itemnumber
} );
1151 $sth_reset->execute( $patron->{borrowernumber
}, $item_2->{itemnumber
} );
1152 $rows_affected = Koha
::Patrons
->search_patrons_to_anonymise->anonymise_issue_history;
1153 $sth->execute($item_1->{itemnumber
});
1154 ($borrowernumber_used_to_anonymised) = $sth->fetchrow_array;
1155 is
( $borrowernumber_used_to_anonymised, $anonymous->{borrowernumber
}, 'The issue 1 should have been anonymised, before parameter was not passed' );
1156 $sth->execute($item_2->{itemnumber
});
1157 ($borrowernumber_used_to_anonymised) = $sth->fetchrow_array;
1158 is
( $borrowernumber_used_to_anonymised, $anonymous->{borrowernumber
}, 'The issue 2 should have been anonymised, before parameter was not passed' );
1160 Koha
::Patrons
->find( $patron->{borrowernumber
})->delete;
1163 subtest
'patron privacy is 0 (forever)' => sub {
1166 t
::lib
::Mocks
::mock_preference
('IndependentBranches', 0);
1167 my $patron = $builder->build(
1168 { source
=> 'Borrower',
1169 value
=> { privacy
=> 0, }
1172 my $item = $builder->build(
1180 my $issue = $builder->build(
1181 { source
=> 'Issue',
1183 borrowernumber
=> $patron->{borrowernumber
},
1184 itemnumber
=> $item->{itemnumber
},
1189 my ( $returned, undef, undef ) = C4
::Circulation
::AddReturn
( $item->{barcode
}, undef, undef, dt_from_string
('2010-10-10') );
1190 is
( $returned, 1, 'The item should have been returned' );
1192 my $dbh = C4
::Context
->dbh;
1193 my ($borrowernumber_used_to_anonymised) = $dbh->selectrow_array(q
|
1194 SELECT borrowernumber FROM old_issues where itemnumber
= ?
1195 |, undef, $item->{itemnumber
});
1196 is
( $borrowernumber_used_to_anonymised, $patron->{borrowernumber
}, 'With privacy=0, the issue should not be anonymised' );
1197 Koha
::Patrons
->find( $patron->{borrowernumber
})->delete;
1200 t
::lib
::Mocks
::mock_preference
( 'AnonymousPatron', '' );
1202 subtest
'AnonymousPatron is not defined' => sub {
1205 t
::lib
::Mocks
::mock_preference
('IndependentBranches', 0);
1206 my $patron = $builder->build(
1207 { source
=> 'Borrower',
1208 value
=> { privacy
=> 1, }
1211 my $item = $builder->build(
1219 my $issue = $builder->build(
1220 { source
=> 'Issue',
1222 borrowernumber
=> $patron->{borrowernumber
},
1223 itemnumber
=> $item->{itemnumber
},
1228 my ( $returned, undef, undef ) = C4
::Circulation
::AddReturn
( $item->{barcode
}, undef, undef, dt_from_string
('2010-10-10') );
1229 is
( $returned, 1, 'The item should have been returned' );
1230 my $rows_affected = Koha
::Patrons
->search_patrons_to_anonymise( { before
=> '2010-10-11' } )->anonymise_issue_history( { before
=> '2010-10-11' } );
1231 ok
( $rows_affected > 0, 'AnonymiseIssueHistory should affect at least 1 row' );
1233 my $dbh = C4
::Context
->dbh;
1234 my ($borrowernumber_used_to_anonymised) = $dbh->selectrow_array(q
|
1235 SELECT borrowernumber FROM old_issues where itemnumber
= ?
1236 |, undef, $item->{itemnumber
});
1237 is
( $borrowernumber_used_to_anonymised, undef, 'With AnonymousPatron is not defined, the issue should have been anonymised anyway' );
1238 Koha
::Patrons
->find( $patron->{borrowernumber
})->delete;
1241 subtest
'Logged in librarian is not superlibrarian & IndependentBranches' => sub {
1243 t
::lib
::Mocks
::mock_preference
( 'IndependentBranches', 1 );
1244 my $patron = $builder->build(
1245 { source
=> 'Borrower',
1246 value
=> { privacy
=> 1 } # Another branchcode than the logged in librarian
1249 my $item = $builder->build(
1257 my $issue = $builder->build(
1258 { source
=> 'Issue',
1260 borrowernumber
=> $patron->{borrowernumber
},
1261 itemnumber
=> $item->{itemnumber
},
1266 my ( $returned, undef, undef ) = C4
::Circulation
::AddReturn
( $item->{barcode
}, undef, undef, dt_from_string
('2010-10-10') );
1267 is
( Koha
::Patrons
->search_patrons_to_anonymise( { before
=> '2010-10-11' } )->count, 0 );
1268 Koha
::Patrons
->find( $patron->{borrowernumber
})->delete;
1271 Koha
::Patrons
->find( $anonymous->{borrowernumber
})->delete;
1272 $userenv_patron->delete;
1274 # Reset IndependentBranches for further tests
1275 t
::lib
::Mocks
::mock_preference
('IndependentBranches', 0);
1278 subtest
'libraries_where_can_see_patrons + can_see_patron_infos + search_limited' => sub {
1286 $nb_of_patrons = Koha
::Patrons
->search->count;
1287 my $group_1 = Koha
::Library
::Group
->new( { title
=> 'TEST Group 1', ft_hide_patron_info
=> 1 } )->store;
1288 my $group_2 = Koha
::Library
::Group
->new( { title
=> 'TEST Group 2', ft_hide_patron_info
=> 1 } )->store;
1289 my $library_11 = $builder->build( { source
=> 'Branch' } );
1290 my $library_12 = $builder->build( { source
=> 'Branch' } );
1291 my $library_21 = $builder->build( { source
=> 'Branch' } );
1292 $library_11 = Koha
::Libraries
->find( $library_11->{branchcode
} );
1293 $library_12 = Koha
::Libraries
->find( $library_12->{branchcode
} );
1294 $library_21 = Koha
::Libraries
->find( $library_21->{branchcode
} );
1295 Koha
::Library
::Group
->new(
1296 { branchcode
=> $library_11->branchcode, parent_id
=> $group_1->id } )->store;
1297 Koha
::Library
::Group
->new(
1298 { branchcode
=> $library_12->branchcode, parent_id
=> $group_1->id } )->store;
1299 Koha
::Library
::Group
->new(
1300 { branchcode
=> $library_21->branchcode, parent_id
=> $group_2->id } )->store;
1302 my $sth = C4
::Context
->dbh->prepare(q
|INSERT INTO user_permissions
( borrowernumber
, module_bit
, code
) VALUES
(?
, 4, ?
)|); # 4 for borrowers
1303 # 2 patrons from library_11 (group1)
1304 # patron_11_1 see patron's infos from outside its group
1305 # Setting flags => undef to not be considered as superlibrarian
1306 my $patron_11_1 = $builder->build({ source
=> 'Borrower', value
=> { branchcode
=> $library_11->branchcode, flags
=> undef, }});
1307 $patron_11_1 = Koha
::Patrons
->find( $patron_11_1->{borrowernumber
} );
1308 $sth->execute( $patron_11_1->borrowernumber, 'edit_borrowers' );
1309 $sth->execute( $patron_11_1->borrowernumber, 'view_borrower_infos_from_any_libraries' );
1310 # patron_11_2 can only see patron's info from its group
1311 my $patron_11_2 = $builder->build({ source
=> 'Borrower', value
=> { branchcode
=> $library_11->branchcode, flags
=> undef, }});
1312 $patron_11_2 = Koha
::Patrons
->find( $patron_11_2->{borrowernumber
} );
1313 $sth->execute( $patron_11_2->borrowernumber, 'edit_borrowers' );
1314 # 1 patron from library_12 (group1)
1315 my $patron_12 = $builder->build({ source
=> 'Borrower', value
=> { branchcode
=> $library_12->branchcode, flags
=> undef, }});
1316 $patron_12 = Koha
::Patrons
->find( $patron_12->{borrowernumber
} );
1317 # 1 patron from library_21 (group2) can only see patron's info from its group
1318 my $patron_21 = $builder->build({ source
=> 'Borrower', value
=> { branchcode
=> $library_21->branchcode, flags
=> undef, }});
1319 $patron_21 = Koha
::Patrons
->find( $patron_21->{borrowernumber
} );
1320 $sth->execute( $patron_21->borrowernumber, 'edit_borrowers' );
1322 # Pfiou, we can start now!
1323 subtest
'libraries_where_can_see_patrons' => sub {
1328 t
::lib
::Mocks
::mock_userenv
({ patron
=> $patron_11_1 });
1329 @branchcodes = $patron_11_1->libraries_where_can_see_patrons;
1330 is_deeply
( \
@branchcodes, [], q
|patron_11_1 has view_borrower_infos_from_any_libraries
=> No restriction
| );
1332 t
::lib
::Mocks
::mock_userenv
({ patron
=> $patron_11_2 });
1333 @branchcodes = $patron_11_2->libraries_where_can_see_patrons;
1334 is_deeply
( \
@branchcodes, [ sort ( $library_11->branchcode, $library_12->branchcode ) ], q
|patron_11_2 has
not view_borrower_infos_from_any_libraries
=> Can only see patron
's from its group| );
1336 t::lib::Mocks::mock_userenv({ patron => $patron_21 });
1337 @branchcodes = $patron_21->libraries_where_can_see_patrons;
1338 is_deeply( \@branchcodes, [$library_21->branchcode], q|patron_21 has not view_borrower_infos_from_any_libraries => Can only see patron's from its group
| );
1340 subtest
'can_see_patron_infos' => sub {
1343 t
::lib
::Mocks
::mock_userenv
({ patron
=> $patron_11_1 });
1344 is
( $patron_11_1->can_see_patron_infos( $patron_11_2 ), 1, q
|patron_11_1 can see patron_11_2
, from its library
| );
1345 is
( $patron_11_1->can_see_patron_infos( $patron_12 ), 1, q
|patron_11_1 can see patron_12
, from its group
| );
1346 is
( $patron_11_1->can_see_patron_infos( $patron_21 ), 1, q
|patron_11_1 can see patron_11_2
, from another group
| );
1348 t
::lib
::Mocks
::mock_userenv
({ patron
=> $patron_11_2 });
1349 is
( $patron_11_2->can_see_patron_infos( $patron_11_1 ), 1, q
|patron_11_2 can see patron_11_1
, from its library
| );
1350 is
( $patron_11_2->can_see_patron_infos( $patron_12 ), 1, q
|patron_11_2 can see patron_12
, from its group
| );
1351 is
( $patron_11_2->can_see_patron_infos( $patron_21 ), 0, q
|patron_11_2 can NOT see patron_21
, from another group
| );
1353 subtest
'search_limited' => sub {
1356 t
::lib
::Mocks
::mock_userenv
({ patron
=> $patron_11_1 });
1357 my $total_number_of_patrons = $nb_of_patrons + 4; #we added four in these tests
1358 is
( Koha
::Patrons
->search->count, $total_number_of_patrons, 'Non-limited search should return all patrons' );
1359 is
( Koha
::Patrons
->search_limited->count, $total_number_of_patrons, 'patron_11_1 is allowed to see all patrons' );
1361 t
::lib
::Mocks
::mock_userenv
({ patron
=> $patron_11_2 });
1362 is
( Koha
::Patrons
->search->count, $total_number_of_patrons, 'Non-limited search should return all patrons');
1363 is
( Koha
::Patrons
->search_limited->count, 3, 'patron_12_1 is not allowed to see patrons from other groups, only patron_11_1, patron_11_2 and patron_12' );
1365 t
::lib
::Mocks
::mock_userenv
({ patron
=> $patron_21 });
1366 is
( Koha
::Patrons
->search->count, $total_number_of_patrons, 'Non-limited search should return all patrons');
1367 is
( Koha
::Patrons
->search_limited->count, 1, 'patron_21 is not allowed to see patrons from other groups, only himself' );
1369 $patron_11_1->delete;
1370 $patron_11_2->delete;
1375 subtest
'account_locked' => sub {
1377 my $patron = $builder->build({ source
=> 'Borrower', value
=> { login_attempts
=> 0 } });
1378 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
1379 for my $value ( undef, '', 0 ) {
1380 t
::lib
::Mocks
::mock_preference
('FailedloginAttempts', $value);
1381 $patron->login_attempts(0)->store;
1382 is
( $patron->account_locked, 0, 'Feature is disabled, patron account should not be considered locked' );
1383 $patron->login_attempts(1)->store;
1384 is
( $patron->account_locked, 0, 'Feature is disabled, patron account should not be considered locked' );
1385 $patron->login_attempts(-1)->store;
1386 is
( $patron->account_locked, 1, 'Feature is disabled but administrative lockout has been triggered' );
1389 t
::lib
::Mocks
::mock_preference
('FailedloginAttempts', 3);
1390 $patron->login_attempts(2)->store;
1391 is
( $patron->account_locked, 0, 'Patron has 2 failed attempts, account should not be considered locked yet' );
1392 $patron->login_attempts(3)->store;
1393 is
( $patron->account_locked, 1, 'Patron has 3 failed attempts, account should be considered locked yet' );
1394 $patron->login_attempts(4)->store;
1395 is
( $patron->account_locked, 1, 'Patron could not have 4 failed attempts, but account should still be considered locked' );
1396 $patron->login_attempts(-1)->store;
1397 is
( $patron->account_locked, 1, 'Administrative lockout triggered' );
1402 subtest
'is_child | is_adult' => sub {
1404 my $category = $builder->build_object(
1406 class => 'Koha::Patron::Categories',
1407 value
=> { category_type
=> 'A' }
1410 my $patron_adult = $builder->build_object(
1412 class => 'Koha::Patrons',
1413 value
=> { categorycode
=> $category->categorycode }
1416 $category = $builder->build_object(
1418 class => 'Koha::Patron::Categories',
1419 value
=> { category_type
=> 'I' }
1422 my $patron_adult_i = $builder->build_object(
1424 class => 'Koha::Patrons',
1425 value
=> { categorycode
=> $category->categorycode }
1428 $category = $builder->build_object(
1430 class => 'Koha::Patron::Categories',
1431 value
=> { category_type
=> 'C' }
1434 my $patron_child = $builder->build_object(
1436 class => 'Koha::Patrons',
1437 value
=> { categorycode
=> $category->categorycode }
1440 $category = $builder->build_object(
1442 class => 'Koha::Patron::Categories',
1443 value
=> { category_type
=> 'O' }
1446 my $patron_other = $builder->build_object(
1448 class => 'Koha::Patrons',
1449 value
=> { categorycode
=> $category->categorycode }
1452 is
( $patron_adult->is_adult, 1, 'Patron from category A should be considered adult' );
1453 is
( $patron_adult_i->is_adult, 1, 'Patron from category I should be considered adult' );
1454 is
( $patron_child->is_adult, 0, 'Patron from category C should not be considered adult' );
1455 is
( $patron_other->is_adult, 0, 'Patron from category O should not be considered adult' );
1457 is
( $patron_adult->is_child, 0, 'Patron from category A should be considered child' );
1458 is
( $patron_adult_i->is_child, 0, 'Patron from category I should be considered child' );
1459 is
( $patron_child->is_child, 1, 'Patron from category C should not be considered child' );
1460 is
( $patron_other->is_child, 0, 'Patron from category O should not be considered child' );
1463 $patron_adult->delete;
1464 $patron_adult_i->delete;
1465 $patron_child->delete;
1466 $patron_other->delete;
1469 subtest
'get_overdues' => sub {
1472 my $library = $builder->build( { source
=> 'Branch' } );
1473 my ($biblionumber_1) = AddBiblio
( MARC
::Record
->new, '' );
1474 my $item_1 = $builder->build(
1478 homebranch
=> $library->{branchcode
},
1479 holdingbranch
=> $library->{branchcode
},
1480 biblionumber
=> $biblionumber_1
1484 my $item_2 = $builder->build(
1488 homebranch
=> $library->{branchcode
},
1489 holdingbranch
=> $library->{branchcode
},
1490 biblionumber
=> $biblionumber_1
1494 my ($biblionumber_2) = AddBiblio
( MARC
::Record
->new, '' );
1495 my $item_3 = $builder->build(
1499 homebranch
=> $library->{branchcode
},
1500 holdingbranch
=> $library->{branchcode
},
1501 biblionumber
=> $biblionumber_2
1505 my $patron = $builder->build(
1507 source
=> 'Borrower',
1508 value
=> { branchcode
=> $library->{branchcode
} }
1512 t
::lib
::Mocks
::mock_preference
({ branchcode
=> $library->{branchcode
} });
1514 AddIssue
( $patron, $item_1->{barcode
}, DateTime
->now->subtract( days
=> 1 ) );
1515 AddIssue
( $patron, $item_2->{barcode
}, DateTime
->now->subtract( days
=> 5 ) );
1516 AddIssue
( $patron, $item_3->{barcode
} );
1518 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
1519 my $overdues = $patron->get_overdues;
1520 is
( $overdues->count, 2, 'Patron should have 2 overdues');
1521 is
( $overdues->next->itemnumber, $item_1->{itemnumber
}, 'The issue should be returned in the same order as they have been done, first is correct' );
1522 is
( $overdues->next->itemnumber, $item_2->{itemnumber
}, 'The issue should be returned in the same order as they have been done, second is correct' );
1524 my $o = $overdues->reset->next;
1525 my $unblessed_overdue = $o->unblessed_all_relateds;
1526 is
( exists( $unblessed_overdue->{issuedate
} ), 1, 'Fields from the issues table should be filled' );
1527 is
( exists( $unblessed_overdue->{itemcallnumber
} ), 1, 'Fields from the items table should be filled' );
1528 is
( exists( $unblessed_overdue->{title
} ), 1, 'Fields from the biblio table should be filled' );
1529 is
( exists( $unblessed_overdue->{itemtype
} ), 1, 'Fields from the biblioitems table should be filled' );
1532 $patron->checkouts->delete;
1536 subtest
'userid_is_valid' => sub {
1539 my $library = $builder->build_object( { class => 'Koha::Libraries' } );
1540 my $patron_category = $builder->build_object(
1542 class => 'Koha::Patron::Categories',
1543 value
=> { category_type
=> 'P', enrolmentfee
=> 0 }
1547 cardnumber
=> "123456789",
1548 firstname
=> "Tomasito",
1550 categorycode
=> $patron_category->categorycode,
1551 branchcode
=> $library->branchcode,
1554 my $expected_userid_patron_1 = 'tomasito.none';
1555 my $borrowernumber = Koha
::Patron
->new(\
%data)->store->borrowernumber;
1556 my $patron_1 = Koha
::Patrons
->find($borrowernumber);
1557 is
( $patron_1->has_valid_userid, 1, "Should be valid when compared against them self" );
1558 is
( $patron_1->userid, $expected_userid_patron_1, 'The userid generated should be the one we expect' );
1560 $patron_1->userid( 'tomasito.non' );
1561 is
( $patron_1->has_valid_userid, # FIXME Joubu: What is the difference with the next test?
1562 1, 'recently created userid -> unique (borrowernumber passed)' );
1564 $patron_1->userid( 'tomasitoxxx' );
1565 is
( $patron_1->has_valid_userid,
1566 1, 'non-existent userid -> unique (borrowernumber passed)' );
1567 $patron_1->discard_changes; # We compare with the original userid later
1569 my $patron_not_in_storage = Koha
::Patron
->new( { userid
=> '' } );
1570 is
( $patron_not_in_storage->has_valid_userid,
1571 0, 'userid exists for another patron, patron is not in storage yet' );
1573 $patron_not_in_storage = Koha
::Patron
->new( { userid
=> 'tomasitoxxx' } );
1574 is
( $patron_not_in_storage->has_valid_userid,
1575 1, 'non-existent userid, patron is not in storage yet' );
1577 # Regression tests for BZ12226
1578 my $db_patron = Koha
::Patron
->new( { userid
=> C4
::Context
->config('user') } );
1579 is
( $db_patron->has_valid_userid,
1580 0, 'Koha::Patron->has_valid_userid should return 0 for the DB user (Bug 12226)' );
1582 # Add a new borrower with the same userid but different cardnumber
1583 $data{cardnumber
} = "987654321";
1584 my $new_borrowernumber = Koha
::Patron
->new(\
%data)->store->borrowernumber;
1585 my $patron_2 = Koha
::Patrons
->find($new_borrowernumber);
1586 $patron_2->userid($patron_1->userid);
1587 is
( $patron_2->has_valid_userid,
1588 0, 'The userid is already in used, it cannot be used for another patron' );
1590 my $new_userid = 'a_user_id';
1591 $data{cardnumber
} = "234567890";
1592 $data{userid
} = 'a_user_id';
1593 $borrowernumber = Koha
::Patron
->new(\
%data)->store->borrowernumber;
1594 my $patron_3 = Koha
::Patrons
->find($borrowernumber);
1595 is
( $patron_3->userid, $new_userid,
1596 'Koha::Patron->store should insert the given userid' );
1604 subtest
'generate_userid' => sub {
1607 my $library = $builder->build_object( { class => 'Koha::Libraries' } );
1608 my $patron_category = $builder->build_object(
1610 class => 'Koha::Patron::Categories',
1611 value
=> { category_type
=> 'P', enrolmentfee
=> 0 }
1615 cardnumber
=> "123456789",
1616 firstname
=> "Tômà sÃtó",
1617 surname
=> "Ñoné",
1618 categorycode
=> $patron_category->categorycode,
1619 branchcode
=> $library->branchcode,
1622 my $expected_userid_patron_1 = 'tomasito.none';
1623 my $new_patron = Koha
::Patron
->new({ firstname
=> $data{firstname
}, surname
=> $data{surname
} } );
1624 $new_patron->generate_userid;
1625 my $userid = $new_patron->userid;
1626 is
( $userid, $expected_userid_patron_1, 'generate_userid should generate the userid we expect' );
1627 my $borrowernumber = Koha
::Patron
->new(\
%data)->store->borrowernumber;
1628 my $patron_1 = Koha
::Patrons
->find($borrowernumber);
1629 is
( $patron_1->userid, $expected_userid_patron_1, 'The userid generated should be the one we expect' );
1631 $new_patron->generate_userid;
1632 $userid = $new_patron->userid;
1633 is
( $userid, $expected_userid_patron_1 . '1', 'generate_userid should generate the userid we expect' );
1634 $data{cardnumber
} = '987654321';
1635 my $new_borrowernumber = Koha
::Patron
->new(\
%data)->store->borrowernumber;
1636 my $patron_2 = Koha
::Patrons
->find($new_borrowernumber);
1637 isnt
( $patron_2->userid, 'tomasito',
1638 "Patron with duplicate userid has new userid generated" );
1639 is
( $patron_2->userid, $expected_userid_patron_1 . '1', # TODO we could make that configurable
1640 "Patron with duplicate userid has new userid generated (1 is appened" );
1642 $new_patron->generate_userid;
1643 $userid = $new_patron->userid;
1644 is
( $userid, $expected_userid_patron_1 . '2', 'generate_userid should generate the userid we expect' );
1646 $patron_1 = Koha
::Patrons
->find($borrowernumber);
1647 $patron_1->userid(undef);
1648 $patron_1->generate_userid;
1649 $userid = $patron_1->userid;
1650 is
( $userid, $expected_userid_patron_1, 'generate_userid should generate the userid we expect' );
1657 $nb_of_patrons = Koha
::Patrons
->search->count;
1658 $retrieved_patron_1->delete;
1659 is
( Koha
::Patrons
->search->count, $nb_of_patrons - 1, 'Delete should have deleted the patron' );
1661 subtest
'BorrowersLog tests' => sub {
1664 t
::lib
::Mocks
::mock_preference
( 'BorrowersLog', 1 );
1665 my $patron = $builder->build_object( { class => 'Koha::Patrons' } );
1667 my $cardnumber = $patron->cardnumber;
1668 $patron->set( { cardnumber
=> 'TESTCARDNUMBER' });
1671 my @logs = $schema->resultset('ActionLog')->search( { module
=> 'MEMBERS', action
=> 'MODIFY', object
=> $patron->borrowernumber } );
1672 my $log_info = from_json
( $logs[0]->info );
1673 is
( $log_info->{cardnumber
}->{after
}, 'TESTCARDNUMBER', 'Got correct new cardnumber' );
1674 is
( $log_info->{cardnumber
}->{before
}, $cardnumber, 'Got correct old cardnumber' );
1675 is
( scalar @logs, 1, 'With BorrowerLogs, one detailed MODIFY action should be logged for the modification.' );
1677 t
::lib
::Mocks
::mock_preference
( 'TrackLastPatronActivity', 1 );
1678 $patron->track_login();
1679 @logs = $schema->resultset('ActionLog')->search( { module
=> 'MEMBERS', action
=> 'MODIFY', object
=> $patron->borrowernumber } );
1680 is
( scalar @logs, 1, 'With BorrowerLogs and TrackLastPatronActivity we should not spam the logs');
1683 $schema->storage->txn_rollback;
1685 subtest
'Test Koha::Patrons::merge' => sub {
1688 my $schema = Koha
::Database
->new()->schema();
1690 my $resultsets = $Koha::Patron
::RESULTSET_PATRON_ID_MAPPING
;
1692 $schema->storage->txn_begin;
1694 my $keeper = $builder->build_object({ class => 'Koha::Patrons' });
1695 my $loser_1 = $builder->build({ source
=> 'Borrower' })->{borrowernumber
};
1696 my $loser_2 = $builder->build({ source
=> 'Borrower' })->{borrowernumber
};
1698 while (my ($r, $field) = each(%$resultsets)) {
1699 $builder->build({ source
=> $r, value
=> { $field => $keeper->id } });
1700 $builder->build({ source
=> $r, value
=> { $field => $loser_1 } });
1701 $builder->build({ source
=> $r, value
=> { $field => $loser_2 } });
1704 $schema->resultset($r)->search( { $field => $keeper->id } );
1705 is
( $keeper_rs->count(), 1, "Found 1 $r rows for keeper" );
1708 $schema->resultset($r)->search( { $field => $loser_1 } );
1709 is
( $loser_1_rs->count(), 1, "Found 1 $r rows for loser_1" );
1712 $schema->resultset($r)->search( { $field => $loser_2 } );
1713 is
( $loser_2_rs->count(), 1, "Found 1 $r rows for loser_2" );
1716 my $results = $keeper->merge_with([ $loser_1, $loser_2 ]);
1718 while (my ($r, $field) = each(%$resultsets)) {
1720 $schema->resultset($r)->search( {$field => $keeper->id } );
1721 is
( $keeper_rs->count(), 3, "Found 2 $r rows for keeper" );
1724 is
( Koha
::Patrons
->find($loser_1), undef, 'Loser 1 has been deleted' );
1725 is
( Koha
::Patrons
->find($loser_2), undef, 'Loser 2 has been deleted' );
1727 $schema->storage->txn_rollback;
1730 subtest
'->store' => sub {
1732 my $schema = Koha
::Database
->new->schema;
1733 $schema->storage->txn_begin;
1735 my $print_error = $schema->storage->dbh->{PrintError
};
1736 $schema->storage->dbh->{PrintError
} = 0; ; # FIXME This does not longer work - because of the transaction in Koha::Patron->store?
1738 my $patron_1 = $builder->build_object({class=> 'Koha::Patrons'});
1739 my $patron_2 = $builder->build_object({class=> 'Koha::Patrons'});
1743 open STDERR
, '>', '/dev/null';
1744 throws_ok
{ $patron_2->userid( $patron_1->userid )->store; }
1745 'Koha::Exceptions::Object::DuplicateID',
1746 'Koha::Patron->store raises an exception on duplicate ID';
1751 t
::lib
::Mocks
::mock_preference
( 'RequireStrongPassword', 0 );
1752 my $password = 'password';
1753 $patron_1->set_password({ password
=> $password });
1754 like
( $patron_1->password, qr
|^\
$2|, 'Password should be hashed using bcrypt (start with $2)' );
1755 my $digest = $patron_1->password;
1756 $patron_1->surname('xxx')->store;
1757 is
( $patron_1->password, $digest, 'Password should not have changed on ->store');
1759 # Test uppercasesurnames
1760 t
::lib
::Mocks
::mock_preference
( 'uppercasesurnames', 1 );
1761 my $surname = lc $patron_1->surname;
1762 $patron_1->surname($surname)->store;
1763 isnt
( $patron_1->surname, $surname,
1764 'Surname converts to uppercase on store.');
1765 t
::lib
::Mocks
::mock_preference
( 'uppercasesurnames', 0 );
1766 $patron_1->surname($surname)->store;
1767 is
( $patron_1->surname, $surname,
1768 'Surname remains unchanged on store.');
1771 $patron_1->relationship("")->store;
1772 is
( $patron_1->relationship, undef, );
1774 $schema->storage->dbh->{PrintError
} = $print_error;
1775 $schema->storage->txn_rollback;
1777 subtest
'skip updated_on for BorrowersLog' => sub {
1779 $schema->storage->txn_begin;
1780 t
::lib
::Mocks
::mock_preference
('BorrowersLog', 1);
1781 my $patron = $builder->build_object({ class => 'Koha::Patrons' });
1782 $patron->updated_on(dt_from_string
($patron->updated_on)->add( seconds
=> 1 ))->store;
1783 my $logs = Koha
::ActionLogs
->search({ module
=>'MEMBERS', action
=> 'MODIFY', object
=> $patron->borrowernumber });
1784 is
($logs->count, 0, '->store should not have generated a log for updated_on') or diag
'Log generated:'.Dumper
($logs->unblessed);
1785 $schema->storage->txn_rollback;
1789 subtest
'->set_password' => sub {
1793 $schema->storage->txn_begin;
1795 my $patron = $builder->build_object( { class => 'Koha::Patrons', value
=> { login_attempts
=> 3 } } );
1797 # Disable logging password changes for this tests
1798 t
::lib
::Mocks
::mock_preference
( 'BorrowersLog', 0 );
1800 # Password-length tests
1801 t
::lib
::Mocks
::mock_preference
( 'minPasswordLength', undef );
1802 throws_ok
{ $patron->set_password({ password
=> 'ab' }); }
1803 'Koha::Exceptions::Password::TooShort',
1804 'minPasswordLength is undef, fall back to 3, fail test';
1806 'Password length (2) is shorter than required (3)',
1807 'Exception parameters passed correctly'
1810 t
::lib
::Mocks
::mock_preference
( 'minPasswordLength', 2 );
1811 throws_ok
{ $patron->set_password({ password
=> 'ab' }); }
1812 'Koha::Exceptions::Password::TooShort',
1813 'minPasswordLength is 2, fall back to 3, fail test';
1815 t
::lib
::Mocks
::mock_preference
( 'minPasswordLength', 5 );
1816 throws_ok
{ $patron->set_password({ password
=> 'abcb' }); }
1817 'Koha::Exceptions::Password::TooShort',
1818 'minPasswordLength is 5, fail test';
1820 # Trailing spaces tests
1821 throws_ok
{ $patron->set_password({ password
=> 'abcD12d ' }); }
1822 'Koha::Exceptions::Password::WhitespaceCharacters',
1823 'Password contains trailing spaces, exception is thrown';
1825 # Require strong password tests
1826 t
::lib
::Mocks
::mock_preference
( 'RequireStrongPassword', 1 );
1827 throws_ok
{ $patron->set_password({ password
=> 'abcd a' }); }
1828 'Koha::Exceptions::Password::TooWeak',
1829 'Password is too weak, exception is thrown';
1831 # Refresh patron from DB, just to make sure
1832 $patron->discard_changes;
1833 is
( $patron->login_attempts, 3, 'Previous tests kept login attemps count' );
1835 $patron->set_password({ password
=> 'abcD12 34' });
1836 $patron->discard_changes;
1838 is
( $patron->login_attempts, 0, 'Changing the password resets the login attempts count' );
1840 lives_ok
{ $patron->set_password({ password
=> 'abcd a', skip_validation
=> 1 }) }
1841 'Password is weak, but skip_validation was passed, so no exception thrown';
1844 t
::lib
::Mocks
::mock_preference
( 'RequireStrongPassword', 0 );
1845 $patron->login_attempts(3)->store;
1846 my $old_digest = $patron->password;
1847 $patron->set_password({ password
=> 'abcd a' });
1848 $patron->discard_changes;
1850 isnt
( $patron->password, $old_digest, 'Password has been updated' );
1851 ok
( checkpw_hash
('abcd a', $patron->password), 'Password hash is correct' );
1852 is
( $patron->login_attempts, 0, 'Login attemps have been reset' );
1854 my $number_of_logs = $schema->resultset('ActionLog')->search( { module
=> 'MEMBERS', action
=> 'CHANGE PASS', object
=> $patron->borrowernumber } )->count;
1855 is
( $number_of_logs, 0, 'Without BorrowerLogs, Koha::Patron->set_password doesn\'t log password changes' );
1857 # Enable logging password changes
1858 t
::lib
::Mocks
::mock_preference
( 'BorrowersLog', 1 );
1859 $patron->set_password({ password
=> 'abcd b' });
1861 $number_of_logs = $schema->resultset('ActionLog')->search( { module
=> 'MEMBERS', action
=> 'CHANGE PASS', object
=> $patron->borrowernumber } )->count;
1862 is
( $number_of_logs, 1, 'With BorrowerLogs, Koha::Patron->set_password does log password changes' );
1864 $schema->storage->txn_rollback;
1867 $schema->storage->txn_begin;
1868 subtest
'search_unsubscribed' => sub {
1871 t
::lib
::Mocks
::mock_preference
( 'FailedLoginAttempts', 3 );
1872 t
::lib
::Mocks
::mock_preference
( 'UnsubscribeReflectionDelay', '' );
1873 is
( Koha
::Patrons
->search_unsubscribed->count, 0, 'Empty delay should return empty set' );
1875 my $patron1 = $builder->build_object({ class => 'Koha::Patrons' });
1876 my $patron2 = $builder->build_object({ class => 'Koha::Patrons' });
1878 t
::lib
::Mocks
::mock_preference
( 'UnsubscribeReflectionDelay', 0 );
1879 Koha
::Patron
::Consents
->delete; # for correct counts
1880 Koha
::Patron
::Consent
->new({ borrowernumber
=> $patron1->borrowernumber, type
=> 'GDPR_PROCESSING', refused_on
=> dt_from_string
})->store;
1881 is
( Koha
::Patrons
->search_unsubscribed->count, 1, 'Find patron1' );
1883 # Add another refusal but shift the period
1884 t
::lib
::Mocks
::mock_preference
( 'UnsubscribeReflectionDelay', 2 );
1885 Koha
::Patron
::Consent
->new({ borrowernumber
=> $patron2->borrowernumber, type
=> 'GDPR_PROCESSING', refused_on
=> dt_from_string
->subtract(days
=>2) })->store;
1886 is
( Koha
::Patrons
->search_unsubscribed->count, 1, 'Find patron2 only' );
1888 # Try another (special) attempts setting
1889 t
::lib
::Mocks
::mock_preference
( 'FailedLoginAttempts', 0 );
1890 # Lockout is now disabled
1891 # Patron2 still matches: refused earlier, not locked
1892 is
( Koha
::Patrons
->search_unsubscribed->count, 1, 'Lockout disabled' );
1895 subtest
'search_anonymize_candidates' => sub {
1897 my $patron1 = $builder->build_object({ class => 'Koha::Patrons' });
1898 my $patron2 = $builder->build_object({ class => 'Koha::Patrons' });
1899 $patron1->anonymized(0);
1900 $patron1->dateexpiry( dt_from_string
->add(days
=> 1) )->store;
1901 $patron2->anonymized(0);
1902 $patron2->dateexpiry( dt_from_string
->add(days
=> 1) )->store;
1904 t
::lib
::Mocks
::mock_preference
( 'PatronAnonymizeDelay', q{} );
1905 is
( Koha
::Patrons
->search_anonymize_candidates->count, 0, 'Empty set' );
1907 t
::lib
::Mocks
::mock_preference
( 'PatronAnonymizeDelay', 0 );
1908 my $cnt = Koha
::Patrons
->search_anonymize_candidates->count;
1909 $patron1->dateexpiry( dt_from_string
->subtract(days
=> 1) )->store;
1910 $patron2->dateexpiry( dt_from_string
->subtract(days
=> 3) )->store;
1911 is
( Koha
::Patrons
->search_anonymize_candidates->count, $cnt+2, 'Delay 0' );
1913 t
::lib
::Mocks
::mock_preference
( 'PatronAnonymizeDelay', 2 );
1914 $patron1->dateexpiry( dt_from_string
->add(days
=> 1) )->store;
1915 $patron2->dateexpiry( dt_from_string
->add(days
=> 1) )->store;
1916 $cnt = Koha
::Patrons
->search_anonymize_candidates->count;
1917 $patron1->dateexpiry( dt_from_string
->subtract(days
=> 1) )->store;
1918 $patron2->dateexpiry( dt_from_string
->subtract(days
=> 3) )->store;
1919 is
( Koha
::Patrons
->search_anonymize_candidates->count, $cnt+1, 'Delay 2' );
1921 t
::lib
::Mocks
::mock_preference
( 'PatronAnonymizeDelay', 4 );
1922 $patron1->dateexpiry( dt_from_string
->add(days
=> 1) )->store;
1923 $patron2->dateexpiry( dt_from_string
->add(days
=> 1) )->store;
1924 $cnt = Koha
::Patrons
->search_anonymize_candidates->count;
1925 $patron1->dateexpiry( dt_from_string
->subtract(days
=> 1) )->store;
1926 $patron2->dateexpiry( dt_from_string
->subtract(days
=> 3) )->store;
1927 is
( Koha
::Patrons
->search_anonymize_candidates->count, $cnt, 'Delay 4' );
1929 t
::lib
::Mocks
::mock_preference
( 'FailedLoginAttempts', 3 );
1930 $patron1->dateexpiry( dt_from_string
->subtract(days
=> 5) )->store;
1931 $patron1->login_attempts(0)->store;
1932 $patron2->dateexpiry( dt_from_string
->subtract(days
=> 5) )->store;
1933 $patron2->login_attempts(0)->store;
1934 $cnt = Koha
::Patrons
->search_anonymize_candidates({locked
=> 1})->count;
1935 $patron1->login_attempts(3)->store;
1936 is
( Koha
::Patrons
->search_anonymize_candidates({locked
=> 1})->count,
1937 $cnt+1, 'Locked flag' );
1939 t
::lib
::Mocks
::mock_preference
( 'FailedLoginAttempts', q{} );
1940 # Patron 1 still on 3 == locked
1941 is
( Koha
::Patrons
->search_anonymize_candidates({locked
=> 1})->count,
1942 $cnt+1, 'Still expect same number for FailedLoginAttempts empty' );
1943 $patron1->login_attempts(0)->store;
1945 is
( Koha
::Patrons
->search_anonymize_candidates({locked
=> 1})->count,
1946 $cnt, 'Patron 1 unlocked' );
1949 subtest
'search_anonymized' => sub {
1951 my $patron1 = $builder->build_object( { class => 'Koha::Patrons' } );
1953 t
::lib
::Mocks
::mock_preference
( 'PatronRemovalDelay', q{} );
1954 is
( Koha
::Patrons
->search_anonymized->count, 0, 'Empty set' );
1956 t
::lib
::Mocks
::mock_preference
( 'PatronRemovalDelay', 1 );
1957 $patron1->dateexpiry( dt_from_string
);
1958 $patron1->anonymized(0)->store;
1959 my $cnt = Koha
::Patrons
->search_anonymized->count;
1960 $patron1->anonymized(1)->store;
1961 is
( Koha
::Patrons
->search_anonymized->count, $cnt, 'Number unchanged' );
1962 $patron1->dateexpiry( dt_from_string
->subtract(days
=> 1) )->store;
1963 is
( Koha
::Patrons
->search_anonymized->count, $cnt+1, 'Found patron1' );
1966 subtest
'lock' => sub {
1969 my $patron1 = $builder->build_object( { class => 'Koha::Patrons' } );
1970 my $patron2 = $builder->build_object( { class => 'Koha::Patrons' } );
1971 my $hold = $builder->build_object({
1972 class => 'Koha::Holds',
1973 value
=> { borrowernumber
=> $patron1->borrowernumber },
1976 t
::lib
::Mocks
::mock_preference
( 'FailedLoginAttempts', 3 );
1977 my $expiry = dt_from_string
->add(days
=> 1);
1978 $patron1->dateexpiry( $expiry );
1980 is
( $patron1->login_attempts, Koha
::Patron
::ADMINISTRATIVE_LOCKOUT
, 'Check login_attempts' );
1981 is
( $patron1->dateexpiry, $expiry, 'Not expired yet' );
1982 is
( $patron1->holds->count, 1, 'No holds removed' );
1984 $patron1->lock({ expire
=> 1, remove
=> 1});
1985 isnt
( $patron1->dateexpiry, $expiry, 'Expiry date adjusted' );
1986 is
( $patron1->holds->count, 0, 'Holds removed' );
1988 # Disable lockout feature
1989 t
::lib
::Mocks
::mock_preference
( 'FailedLoginAttempts', q{} );
1990 $patron1->login_attempts(0);
1991 $patron1->dateexpiry( $expiry );
1994 is
( $patron1->login_attempts, Koha
::Patron
::ADMINISTRATIVE_LOCKOUT
, 'Check login_attempts' );
1996 # Trivial wrapper test (Koha::Patrons->lock)
1997 $patron1->login_attempts(0)->store;
1998 Koha
::Patrons
->search({ borrowernumber
=> [ $patron1->borrowernumber, $patron2->borrowernumber ] })->lock;
1999 $patron1->discard_changes; # refresh
2000 $patron2->discard_changes;
2001 is
( $patron1->login_attempts, Koha
::Patron
::ADMINISTRATIVE_LOCKOUT
, 'Check login_attempts patron 1' );
2002 is
( $patron2->login_attempts, Koha
::Patron
::ADMINISTRATIVE_LOCKOUT
, 'Check login_attempts patron 2' );
2005 subtest
'anonymize' => sub {
2008 my $patron1 = $builder->build_object( { class => 'Koha::Patrons' } );
2009 my $patron2 = $builder->build_object( { class => 'Koha::Patrons' } );
2011 # First try patron with issues
2012 my $issue = $builder->build_object({ class => 'Koha::Checkouts', value
=> { borrowernumber
=> $patron2->borrowernumber } });
2013 warning_like
{ $patron2->anonymize } qr/still has issues/, 'Skip patron with issues';
2016 t
::lib
::Mocks
::mock_preference
( 'BorrowerMandatoryField', 'surname|email|cardnumber' );
2017 my $surname = $patron1->surname; # expect change, no clear
2018 my $branchcode = $patron1->branchcode; # expect skip
2019 $patron1->anonymize;
2020 is
($patron1->anonymized, 1, 'Check flag' );
2022 is
( $patron1->dateofbirth, undef, 'Birth date cleared' );
2023 is
( $patron1->firstname, undef, 'First name cleared' );
2024 isnt
( $patron1->surname, $surname, 'Surname changed' );
2025 ok
( $patron1->surname =~ /^\w{10}$/, 'Mandatory surname randomized' );
2026 is
( $patron1->branchcode, $branchcode, 'Branch code skipped' );
2027 is
( $patron1->email, undef, 'Email was mandatory, must be cleared' );
2029 # Test wrapper in Koha::Patrons
2030 $patron1->surname($surname)->store; # restore
2031 my $rs = Koha
::Patrons
->search({ borrowernumber
=> [ $patron1->borrowernumber, $patron2->borrowernumber ] })->anonymize;
2032 $patron1->discard_changes; # refresh
2033 isnt
( $patron1->surname, $surname, 'Surname patron1 changed again' );
2034 $patron2->discard_changes; # refresh
2035 is
( $patron2->firstname, undef, 'First name patron2 cleared' );
2037 $schema->storage->txn_rollback;
2039 subtest
'extended_attributes' => sub {
2041 my $schema = Koha
::Database
->new->schema;
2042 $schema->storage->txn_begin;
2044 my $patron_1 = $builder->build_object({class=> 'Koha::Patrons'});
2045 my $patron_2 = $builder->build_object({class=> 'Koha::Patrons'});
2047 t
::lib
::Mocks
::mock_userenv
({ patron
=> $patron_1 });
2049 my $attribute_type1 = Koha
::Patron
::Attribute
::Type
->new(
2052 description
=> 'my description1',
2056 my $attribute_type2 = Koha
::Patron
::Attribute
::Type
->new(
2059 description
=> 'my description2',
2061 staff_searchable
=> 1
2065 my $attribute_type3 = $builder->build_object({ class => 'Koha::Patron::Attribute::Types' });
2067 my $deleted_attribute_type = $builder->build_object({ class => 'Koha::Patron::Attribute::Types' });
2068 my $deleted_attribute_type_code = $deleted_attribute_type->code;
2069 $deleted_attribute_type->delete;
2071 my $new_library = $builder->build( { source
=> 'Branch' } );
2072 my $attribute_type_limited = Koha
::Patron
::Attribute
::Type
->new(
2073 { code
=> 'my code3', description
=> 'my description3' } )->store;
2074 $attribute_type_limited->library_limits( [ $new_library->{branchcode
} ] );
2076 my $attributes_for_1 = [
2078 attribute
=> 'my attribute1',
2079 code
=> $attribute_type1->code(),
2082 attribute
=> 'my attribute2',
2083 code
=> $attribute_type2->code(),
2086 attribute
=> 'my attribute limited',
2087 code
=> $attribute_type_limited->code(),
2091 my $attributes_for_2 = [
2093 attribute
=> 'my attribute12',
2094 code
=> $attribute_type1->code(),
2097 attribute
=> 'my attribute limited 2',
2098 code
=> $attribute_type_limited->code(),
2101 attribute
=> 'my nonexistent attribute 2',
2102 code
=> $deleted_attribute_type_code,
2106 my $extended_attributes = $patron_1->extended_attributes;
2107 is
( ref($extended_attributes), 'Koha::Patron::Attributes', 'Koha::Patron->extended_attributes must return a Koha::Patron::Attribute set' );
2108 is
( $extended_attributes->count, 0, 'There should not be attribute yet');
2110 $patron_1->extended_attributes->filter_by_branch_limitations->delete;
2111 $patron_2->extended_attributes->filter_by_branch_limitations->delete;
2112 $patron_1->extended_attributes($attributes_for_1);
2115 $patron_2->extended_attributes($attributes_for_2);
2116 } [ qr/a foreign key constraint fails/ ], 'nonexistent attribute should have not exploded but print a warning';
2118 my $extended_attributes_for_1 = $patron_1->extended_attributes;
2119 is
( $extended_attributes_for_1->count, 3, 'There should be 3 attributes now for patron 1');
2121 my $extended_attributes_for_2 = $patron_2->extended_attributes;
2122 is
( $extended_attributes_for_2->count, 2, 'There should be 2 attributes now for patron 2');
2124 my $attribute_12 = $extended_attributes_for_2->search({ code
=> $attribute_type1->code });
2125 is
( $attribute_12->next->attribute, 'my attribute12', 'search by code should return the correct attribute' );
2127 $attribute_12 = $patron_2->get_extended_attribute( $attribute_type1->code );
2128 is
( $attribute_12->attribute, 'my attribute12', 'Koha::Patron->get_extended_attribute should return the correct attribute value' );
2131 $extended_attributes_for_2 = $patron_2->extended_attributes->merge_with(
2134 attribute
=> 'my attribute12 XXX',
2135 code
=> $attribute_type1->code(),
2138 attribute
=> 'my nonexistent attribute 2',
2139 code
=> $deleted_attribute_type_code,
2142 attribute
=> 'my attribute 3', # Adding a new attribute using merge_with
2143 code
=> $attribute_type3->code,
2148 "Cannot merge element: unrecognized code = '$deleted_attribute_type_code'",
2149 "Trying to merge_with using a nonexistent attribute code should display a warning";
2151 is
( @
$extended_attributes_for_2, 3, 'There should be 3 attributes now for patron 3');
2152 my $expected_attributes_for_2 = [
2154 code
=> $attribute_type1->code(),
2155 attribute
=> 'my attribute12 XXX',
2158 code
=> $attribute_type_limited->code(),
2159 attribute
=> 'my attribute limited 2',
2162 attribute
=> 'my attribute 3',
2163 code
=> $attribute_type3->code,
2166 # Sorting them by code
2167 $expected_attributes_for_2 = [ sort { $a->{code
} cmp $b->{code
} } @
$expected_attributes_for_2 ];
2172 code
=> $extended_attributes_for_2->[0]->{code
},
2173 attribute
=> $extended_attributes_for_2->[0]->{attribute
}
2176 code
=> $extended_attributes_for_2->[1]->{code
},
2177 attribute
=> $extended_attributes_for_2->[1]->{attribute
}
2180 code
=> $extended_attributes_for_2->[2]->{code
},
2181 attribute
=> $extended_attributes_for_2->[2]->{attribute
}
2184 $expected_attributes_for_2
2187 # TODO - What about multiple? POD explains the problem
2188 my $non_existent = $patron_2->get_extended_attribute( 'not_exist' );
2189 is
( $non_existent, undef, 'Koha::Patron->get_extended_attribute must return undef if the attribute does not exist' );
2191 # Test branch limitations
2192 t
::lib
::Mocks
::mock_userenv
({ patron
=> $patron_2 });
2194 $extended_attributes_for_1 = $patron_1->extended_attributes;
2195 is
( $extended_attributes_for_1->count, 3, 'There should be 2 attributes for patron 1, the limited one should be returned');
2198 $extended_attributes_for_1 = $patron_1->extended_attributes->filter_by_branch_limitations;
2199 is
( $extended_attributes_for_1->count, 2, 'There should be 2 attributes for patron 1, the limited one should be returned');
2202 my $limited_value = $patron_1->get_extended_attribute( $attribute_type_limited->code );
2203 is
( $limited_value->attribute, 'my attribute limited', );
2205 ## Do we need a filtered?
2206 #$limited_value = $patron_1->get_extended_attribute( $attribute_type_limited->code );
2207 #is( $limited_value, undef, );
2209 $schema->storage->txn_rollback;