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
=> 22;
37 use Koha
::Virtualshelves
;
39 use t
::lib
::TestBuilder
;
42 my $schema = Koha
::Database
->new->schema;
43 $schema->storage->txn_begin;
45 my $builder = t
::lib
::TestBuilder
->new;
46 my $library = $builder->build({source
=> 'Branch' });
47 my $category = $builder->build({source
=> 'Category' });
48 my $nb_of_patrons = Koha
::Patrons
->search->count;
49 my $new_patron_1 = Koha
::Patron
->new(
50 { cardnumber
=> 'test_cn_1',
51 branchcode
=> $library->{branchcode
},
52 categorycode
=> $category->{categorycode
},
53 surname
=> 'surname for patron1',
54 firstname
=> 'firstname for patron1',
55 userid
=> 'a_nonexistent_userid_1',
58 my $new_patron_2 = Koha
::Patron
->new(
59 { cardnumber
=> 'test_cn_2',
60 branchcode
=> $library->{branchcode
},
61 categorycode
=> $category->{categorycode
},
62 surname
=> 'surname for patron2',
63 firstname
=> 'firstname for patron2',
64 userid
=> 'a_nonexistent_userid_2',
68 C4
::Context
->_new_userenv('xxx');
69 C4
::Context
->set_userenv(0,0,0,'firstname','surname', $library->{branchcode
}, 'Midway Public Library', '', '', '');
71 is
( Koha
::Patrons
->search->count, $nb_of_patrons + 2, 'The 2 patrons should have been added' );
73 my $retrieved_patron_1 = Koha
::Patrons
->find( $new_patron_1->borrowernumber );
74 is
( $retrieved_patron_1->cardnumber, $new_patron_1->cardnumber, 'Find a patron by borrowernumber should return the correct patron' );
76 subtest
'library' => sub {
78 is
( $retrieved_patron_1->library->branchcode, $library->{branchcode
}, 'Koha::Patron->library should return the correct library' );
79 is
( ref($retrieved_patron_1->library), 'Koha::Library', 'Koha::Patron->library should return a Koha::Library object' );
82 subtest
'guarantees' => sub {
84 my $guarantees = $new_patron_1->guarantees;
85 is
( ref($guarantees), 'Koha::Patrons', 'Koha::Patron->guarantees should return a Koha::Patrons result set in a scalar context' );
86 is
( $guarantees->count, 0, 'new_patron_1 should have 0 guarantee' );
87 my @guarantees = $new_patron_1->guarantees;
88 is
( ref(\
@guarantees), 'ARRAY', 'Koha::Patron->guarantees should return an array in a list context' );
89 is
( scalar(@guarantees), 0, 'new_patron_1 should have 0 guarantee' );
91 my $guarantee_1 = $builder->build({ source
=> 'Borrower', value
=> { guarantorid
=> $new_patron_1->borrowernumber }});
92 my $guarantee_2 = $builder->build({ source
=> 'Borrower', value
=> { guarantorid
=> $new_patron_1->borrowernumber }});
94 $guarantees = $new_patron_1->guarantees;
95 is
( ref($guarantees), 'Koha::Patrons', 'Koha::Patron->guarantees should return a Koha::Patrons result set in a scalar context' );
96 is
( $guarantees->count, 2, 'new_patron_1 should have 2 guarantees' );
97 @guarantees = $new_patron_1->guarantees;
98 is
( ref(\
@guarantees), 'ARRAY', 'Koha::Patron->guarantees should return an array in a list context' );
99 is
( scalar(@guarantees), 2, 'new_patron_1 should have 2 guarantees' );
100 $_->delete for @guarantees;
103 subtest
'category' => sub {
105 my $patron_category = $new_patron_1->category;
106 is
( ref( $patron_category), 'Koha::Patron::Category', );
107 is
( $patron_category->categorycode, $category->{categorycode
}, );
110 subtest
'siblings' => sub {
112 my $siblings = $new_patron_1->siblings;
113 is
( $siblings, undef, 'Koha::Patron->siblings should not crashed if the patron has no guarantor' );
114 my $guarantee_1 = $builder->build( { source
=> 'Borrower', value
=> { guarantorid
=> $new_patron_1->borrowernumber } } );
115 my $retrieved_guarantee_1 = Koha
::Patrons
->find($guarantee_1);
116 $siblings = $retrieved_guarantee_1->siblings;
117 is
( ref($siblings), 'Koha::Patrons', 'Koha::Patron->siblings should return a Koha::Patrons result set in a scalar context' );
118 my @siblings = $retrieved_guarantee_1->siblings;
119 is
( ref( \
@siblings ), 'ARRAY', 'Koha::Patron->siblings should return an array in a list context' );
120 is
( $siblings->count, 0, 'guarantee_1 should not have siblings yet' );
121 my $guarantee_2 = $builder->build( { source
=> 'Borrower', value
=> { guarantorid
=> $new_patron_1->borrowernumber } } );
122 my $guarantee_3 = $builder->build( { source
=> 'Borrower', value
=> { guarantorid
=> $new_patron_1->borrowernumber } } );
123 $siblings = $retrieved_guarantee_1->siblings;
124 is
( $siblings->count, 2, 'guarantee_1 should have 2 siblings' );
125 is
( $guarantee_2->{borrowernumber
}, $siblings->next->borrowernumber, 'guarantee_2 should exist in the guarantees' );
126 is
( $guarantee_3->{borrowernumber
}, $siblings->next->borrowernumber, 'guarantee_3 should exist in the guarantees' );
127 $_->delete for $retrieved_guarantee_1->siblings;
128 $retrieved_guarantee_1->delete;
131 subtest
'has_overdues' => sub {
134 my $biblioitem_1 = $builder->build( { source
=> 'Biblioitem' } );
135 my $item_1 = $builder->build(
138 homebranch
=> $library->{branchcode
},
139 holdingbranch
=> $library->{branchcode
},
143 biblionumber
=> $biblioitem_1->{biblionumber
}
147 my $retrieved_patron = Koha
::Patrons
->find( $new_patron_1->borrowernumber );
148 is
( $retrieved_patron->has_overdues, 0, );
150 my $tomorrow = DateTime
->today( time_zone
=> C4
::Context
->tz() )->add( days
=> 1 );
151 my $issue = Koha
::Checkout
->new({ borrowernumber
=> $new_patron_1->id, itemnumber
=> $item_1->{itemnumber
}, date_due
=> $tomorrow, branchcode
=> $library->{branchcode
} })->store();
152 is
( $retrieved_patron->has_overdues, 0, );
154 my $yesterday = DateTime
->today(time_zone
=> C4
::Context
->tz())->add( days
=> -1 );
155 $issue = Koha
::Checkout
->new({ borrowernumber
=> $new_patron_1->id, itemnumber
=> $item_1->{itemnumber
}, date_due
=> $yesterday, branchcode
=> $library->{branchcode
} })->store();
156 $retrieved_patron = Koha
::Patrons
->find( $new_patron_1->borrowernumber );
157 is
( $retrieved_patron->has_overdues, 1, );
161 subtest
'update_password' => sub {
164 t
::lib
::Mocks
::mock_preference
( 'BorrowersLog', 1 );
165 my $original_userid = $new_patron_1->userid;
166 my $original_password = $new_patron_1->password;
167 warning_like
{ $retrieved_patron_1->update_password( $new_patron_2->userid, 'another_password' ) }
169 'Koha::Patron->update_password should warn if the userid is already used by another patron';
170 is
( Koha
::Patrons
->find( $new_patron_1->borrowernumber )->userid, $original_userid, 'Koha::Patron->update_password should not have updated the userid' );
171 is
( Koha
::Patrons
->find( $new_patron_1->borrowernumber )->password, $original_password, 'Koha::Patron->update_password should not have updated the userid' );
173 $retrieved_patron_1->update_password( 'another_nonexistent_userid_1', 'another_password' );
174 is
( Koha
::Patrons
->find( $new_patron_1->borrowernumber )->userid, 'another_nonexistent_userid_1', 'Koha::Patron->update_password should have updated the userid' );
175 is
( Koha
::Patrons
->find( $new_patron_1->borrowernumber )->password, 'another_password', 'Koha::Patron->update_password should have updated the password' );
177 my $number_of_logs = $schema->resultset('ActionLog')->search( { module
=> 'MEMBERS', action
=> 'CHANGE PASS', object
=> $new_patron_1->borrowernumber } )->count;
178 is
( $number_of_logs, 1, 'With BorrowerLogs, Koha::Patron->update_password should have logged' );
180 t
::lib
::Mocks
::mock_preference
( 'BorrowersLog', 0 );
181 $retrieved_patron_1->update_password( 'yet_another_nonexistent_userid_1', 'another_password' );
182 $number_of_logs = $schema->resultset('ActionLog')->search( { module
=> 'MEMBERS', action
=> 'CHANGE PASS', object
=> $new_patron_1->borrowernumber } )->count;
183 is
( $number_of_logs, 1, 'With BorrowerLogs, Koha::Patron->update_password should not have logged' );
186 subtest
'is_expired' => sub {
188 my $patron = $builder->build({ source
=> 'Borrower' });
189 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
190 $patron->dateexpiry( undef )->store->discard_changes;
191 is
( $patron->is_expired, 0, 'Patron should not be considered expired if dateexpiry is not set');
192 $patron->dateexpiry( '0000-00-00' )->store->discard_changes;
193 is
( $patron->is_expired, 0, 'Patron should not be considered expired if dateexpiry is not 0000-00-00');
194 $patron->dateexpiry( dt_from_string
)->store->discard_changes;
195 is
( $patron->is_expired, 0, 'Patron should not be considered expired if dateexpiry is today');
196 $patron->dateexpiry( dt_from_string
->add( days
=> 1 ) )->store->discard_changes;
197 is
( $patron->is_expired, 0, 'Patron should not be considered expired if dateexpiry is tomorrow');
198 $patron->dateexpiry( dt_from_string
->add( days
=> -1 ) )->store->discard_changes;
199 is
( $patron->is_expired, 1, 'Patron should be considered expired if dateexpiry is yesterday');
204 subtest
'is_going_to_expire' => sub {
206 my $patron = $builder->build({ source
=> 'Borrower' });
207 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
208 $patron->dateexpiry( undef )->store->discard_changes;
209 is
( $patron->is_going_to_expire, 0, 'Patron should not be considered going to expire if dateexpiry is not set');
210 $patron->dateexpiry( '0000-00-00' )->store->discard_changes;
211 is
( $patron->is_going_to_expire, 0, 'Patron should not be considered going to expire if dateexpiry is not 0000-00-00');
213 t
::lib
::Mocks
::mock_preference
('NotifyBorrowerDeparture', 0);
214 $patron->dateexpiry( dt_from_string
)->store->discard_changes;
215 is
( $patron->is_going_to_expire, 0, 'Patron should not be considered going to expire if dateexpiry is today');
217 $patron->dateexpiry( dt_from_string
)->store->discard_changes;
218 is
( $patron->is_going_to_expire, 0, 'Patron should not be considered going to expire if dateexpiry is today and pref is 0');
220 t
::lib
::Mocks
::mock_preference
('NotifyBorrowerDeparture', 10);
221 $patron->dateexpiry( dt_from_string
->add( days
=> 11 ) )->store->discard_changes;
222 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');
224 t
::lib
::Mocks
::mock_preference
('NotifyBorrowerDeparture', 0);
225 $patron->dateexpiry( dt_from_string
->add( days
=> 10 ) )->store->discard_changes;
226 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');
228 t
::lib
::Mocks
::mock_preference
('NotifyBorrowerDeparture', 10);
229 $patron->dateexpiry( dt_from_string
->add( days
=> 10 ) )->store->discard_changes;
230 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');
233 t
::lib
::Mocks
::mock_preference
('NotifyBorrowerDeparture', 10);
234 $patron->dateexpiry( dt_from_string
->add( days
=> 20 ) )->store->discard_changes;
235 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');
237 t
::lib
::Mocks
::mock_preference
('NotifyBorrowerDeparture', 20);
238 $patron->dateexpiry( dt_from_string
->add( days
=> 10 ) )->store->discard_changes;
239 is
( $patron->is_going_to_expire, 1, 'Patron should be considered going to expire if dateexpiry is 10 days ahead and pref is 20');
245 subtest
'renew_account' => sub {
248 for my $date ( '2016-03-31', '2016-11-30', dt_from_string
() ) {
249 my $dt = dt_from_string
( $date, 'iso' );
250 Time
::Fake
->offset( $dt->epoch );
251 my $a_month_ago = $dt->clone->subtract( months
=> 1 )->truncate( to
=> 'day' );
252 my $a_year_later = $dt->clone->add( months
=> 12 )->truncate( to
=> 'day' );
253 my $a_year_later_minus_a_month = $dt->clone->add( months
=> 11 )->truncate( to
=> 'day' );
254 my $a_month_later = $dt->clone->add( months
=> 1 )->truncate( to
=> 'day' );
255 my $a_year_later_plus_a_month = $dt->clone->add( months
=> 13 )->truncate( to
=> 'day' );
256 my $patron_category = $builder->build(
257 { source
=> 'Category',
259 enrolmentperiod
=> 12,
260 enrolmentperioddate
=> undef,
264 my $patron = $builder->build(
265 { source
=> 'Borrower',
267 dateexpiry
=> $a_month_ago,
268 categorycode
=> $patron_category->{categorycode
},
272 my $patron_2 = $builder->build(
273 { source
=> 'Borrower',
275 dateexpiry
=> $a_month_ago,
276 categorycode
=> $patron_category->{categorycode
},
280 my $patron_3 = $builder->build(
281 { source
=> 'Borrower',
283 dateexpiry
=> $a_month_later,
284 categorycode
=> $patron_category->{categorycode
},
288 my $retrieved_patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
289 my $retrieved_patron_2 = Koha
::Patrons
->find( $patron_2->{borrowernumber
} );
290 my $retrieved_patron_3 = Koha
::Patrons
->find( $patron_3->{borrowernumber
} );
292 t
::lib
::Mocks
::mock_preference
( 'BorrowerRenewalPeriodBase', 'dateexpiry' );
293 t
::lib
::Mocks
::mock_preference
( 'BorrowersLog', 1 );
294 my $expiry_date = $retrieved_patron->renew_account;
295 is
( $expiry_date, $a_year_later_minus_a_month, );
296 my $retrieved_expiry_date = Koha
::Patrons
->find( $patron->{borrowernumber
} )->dateexpiry;
297 is
( dt_from_string
($retrieved_expiry_date), $a_year_later_minus_a_month );
298 my $number_of_logs = $schema->resultset('ActionLog')->search( { module
=> 'MEMBERS', action
=> 'RENEW', object
=> $retrieved_patron->borrowernumber } )->count;
299 is
( $number_of_logs, 1, 'With BorrowerLogs, Koha::Patron->renew_account should have logged' );
301 t
::lib
::Mocks
::mock_preference
( 'BorrowerRenewalPeriodBase', 'now' );
302 t
::lib
::Mocks
::mock_preference
( 'BorrowersLog', 0 );
303 $expiry_date = $retrieved_patron->renew_account;
304 is
( $expiry_date, $a_year_later, );
305 $retrieved_expiry_date = Koha
::Patrons
->find( $patron->{borrowernumber
} )->dateexpiry;
306 is
( dt_from_string
($retrieved_expiry_date), $a_year_later );
307 $number_of_logs = $schema->resultset('ActionLog')->search( { module
=> 'MEMBERS', action
=> 'RENEW', object
=> $retrieved_patron->borrowernumber } )->count;
308 is
( $number_of_logs, 1, 'Without BorrowerLogs, Koha::Patron->renew_account should not have logged' );
310 t
::lib
::Mocks
::mock_preference
( 'BorrowerRenewalPeriodBase', 'combination' );
311 $expiry_date = $retrieved_patron_2->renew_account;
312 is
( $expiry_date, $a_year_later );
313 $retrieved_expiry_date = Koha
::Patrons
->find( $patron_2->{borrowernumber
} )->dateexpiry;
314 is
( dt_from_string
($retrieved_expiry_date), $a_year_later );
316 $expiry_date = $retrieved_patron_3->renew_account;
317 is
( $expiry_date, $a_year_later_plus_a_month );
318 $retrieved_expiry_date = Koha
::Patrons
->find( $patron_3->{borrowernumber
} )->dateexpiry;
319 is
( dt_from_string
($retrieved_expiry_date), $a_year_later_plus_a_month );
321 $retrieved_patron->delete;
322 $retrieved_patron_2->delete;
323 $retrieved_patron_3->delete;
327 subtest
"move_to_deleted" => sub {
329 my $originally_updated_on = '2016-01-01 12:12:12';
330 my $patron = $builder->build( { source
=> 'Borrower',value
=> { updated_on
=> $originally_updated_on } } );
331 my $retrieved_patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
332 is
( ref( $retrieved_patron->move_to_deleted ), 'Koha::Schema::Result::Deletedborrower', 'Koha::Patron->move_to_deleted should return the Deleted patron' )
333 ; # FIXME This should be Koha::Deleted::Patron
334 my $deleted_patron = $schema->resultset('Deletedborrower')
335 ->search( { borrowernumber
=> $patron->{borrowernumber
} }, { result_class
=> 'DBIx::Class::ResultClass::HashRefInflator' } )
337 ok
( $retrieved_patron->updated_on, 'updated_on should be set for borrowers table' );
338 ok
( $deleted_patron->{updated_on
}, 'updated_on should be set for deleted_borrowers table' );
339 isnt
( $deleted_patron->{updated_on
}, $retrieved_patron->updated_on, 'Koha::Patron->move_to_deleted should have correctly updated the updated_on column');
340 $deleted_patron->{updated_on
} = $originally_updated_on; #reset for simplicity in comparing all other fields
341 is_deeply
( $deleted_patron, $patron, 'Koha::Patron->move_to_deleted should have correctly moved the patron to the deleted table' );
342 $retrieved_patron->delete( $patron->{borrowernumber
} ); # Cleanup
345 subtest
"delete" => sub {
347 t
::lib
::Mocks
::mock_preference
( 'BorrowersLog', 1 );
348 my $patron = $builder->build( { source
=> 'Borrower' } );
349 my $retrieved_patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
350 my $hold = $builder->build(
351 { source
=> 'Reserve',
352 value
=> { borrowernumber
=> $patron->{borrowernumber
} }
355 my $list = $builder->build(
356 { source
=> 'Virtualshelve',
357 value
=> { owner
=> $patron->{borrowernumber
} }
361 my $deleted = $retrieved_patron->delete;
362 is
( $deleted, 1, 'Koha::Patron->delete should return 1 if the patron has been correctly deleted' );
364 is
( Koha
::Patrons
->find( $patron->{borrowernumber
} ), undef, 'Koha::Patron->delete should have deleted the patron' );
366 is
( Koha
::Holds
->search( { borrowernumber
=> $patron->{borrowernumber
} } )->count, 0, q
|Koha
::Patron
->delete should have deleted patron
's holds| );
368 is( Koha::Virtualshelves->search( { owner => $patron->{borrowernumber} } )->count, 0, q|Koha::Patron->delete should have deleted patron's lists
| );
370 my $number_of_logs = $schema->resultset('ActionLog')->search( { module
=> 'MEMBERS', action
=> 'DELETE', object
=> $retrieved_patron->borrowernumber } )->count;
371 is
( $number_of_logs, 1, 'With BorrowerLogs, Koha::Patron->delete should have logged' );
374 subtest
'add_enrolment_fee_if_needed' => sub {
377 my $enrolmentfee_K = 5;
378 my $enrolmentfee_J = 10;
379 my $enrolmentfee_YA = 20;
381 my $dbh = C4
::Context
->dbh;
382 $dbh->do(q
|UPDATE categories set enrolmentfee
=? where categorycode
=?
|, undef, $enrolmentfee_K, 'K');
383 $dbh->do(q
|UPDATE categories set enrolmentfee
=? where categorycode
=?
|, undef, $enrolmentfee_J, 'J');
384 $dbh->do(q
|UPDATE categories set enrolmentfee
=? where categorycode
=?
|, undef, $enrolmentfee_YA, 'YA');
386 my %borrower_data = (
387 firstname
=> 'my firstname',
388 surname
=> 'my surname',
390 branchcode
=> $library->{branchcode
},
393 my $borrowernumber = C4
::Members
::AddMember
(%borrower_data);
394 $borrower_data{borrowernumber
} = $borrowernumber;
396 my ($total) = C4
::Members
::GetMemberAccountRecords
($borrowernumber);
397 is
( $total, $enrolmentfee_K, "New kid pay $enrolmentfee_K" );
399 t
::lib
::Mocks
::mock_preference
( 'FeeOnChangePatronCategory', 0 );
400 $borrower_data{categorycode
} = 'J';
401 C4
::Members
::ModMember
(%borrower_data);
402 ($total) = C4
::Members
::GetMemberAccountRecords
($borrowernumber);
403 is
( $total, $enrolmentfee_K, "Kid growing and become a juvenile, but shouldn't pay for the upgrade " );
405 $borrower_data{categorycode
} = 'K';
406 C4
::Members
::ModMember
(%borrower_data);
407 t
::lib
::Mocks
::mock_preference
( 'FeeOnChangePatronCategory', 1 );
409 $borrower_data{categorycode
} = 'J';
410 C4
::Members
::ModMember
(%borrower_data);
411 ($total) = C4
::Members
::GetMemberAccountRecords
($borrowernumber);
412 is
( $total, $enrolmentfee_K + $enrolmentfee_J, "Kid growing and become a juvenile, they should pay " . ( $enrolmentfee_K + $enrolmentfee_J ) );
414 # Check with calling directly Koha::Patron->get_enrolment_fee_if_needed
415 my $patron = Koha
::Patrons
->find($borrowernumber);
416 $patron->categorycode('YA')->store;
417 my $fee = $patron->add_enrolment_fee_if_needed;
418 ($total) = C4
::Members
::GetMemberAccountRecords
($borrowernumber);
420 $enrolmentfee_K + $enrolmentfee_J + $enrolmentfee_YA,
421 "Juvenile growing and become an young adult, they should pay " . ( $enrolmentfee_K + $enrolmentfee_J + $enrolmentfee_YA )
427 subtest
'checkouts + get_overdues' => sub {
430 my $library = $builder->build( { source
=> 'Branch' } );
431 my ($biblionumber_1) = AddBiblio
( MARC
::Record
->new, '' );
432 my $item_1 = $builder->build(
436 homebranch
=> $library->{branchcode
},
437 holdingbranch
=> $library->{branchcode
},
438 biblionumber
=> $biblionumber_1
442 my $item_2 = $builder->build(
446 homebranch
=> $library->{branchcode
},
447 holdingbranch
=> $library->{branchcode
},
448 biblionumber
=> $biblionumber_1
452 my ($biblionumber_2) = AddBiblio
( MARC
::Record
->new, '' );
453 my $item_3 = $builder->build(
457 homebranch
=> $library->{branchcode
},
458 holdingbranch
=> $library->{branchcode
},
459 biblionumber
=> $biblionumber_2
463 my $patron = $builder->build(
465 source
=> 'Borrower',
466 value
=> { branchcode
=> $library->{branchcode
} }
470 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
471 my $checkouts = $patron->checkouts;
472 is
( $checkouts->count, 0, 'checkouts should not return any issues for that patron' );
473 is
( ref($checkouts), 'Koha::Checkouts', 'checkouts should return a Koha::Checkouts object' );
475 # Not sure how this is useful, but AddIssue pass this variable to different other subroutines
476 $patron = Koha
::Patrons
->find( $patron->borrowernumber )->unblessed;
478 my $module = new Test
::MockModule
('C4::Context');
479 $module->mock( 'userenv', sub { { branch
=> $library->{branchcode
} } } );
481 AddIssue
( $patron, $item_1->{barcode
}, DateTime
->now->subtract( days
=> 1 ) );
482 AddIssue
( $patron, $item_2->{barcode
}, DateTime
->now->subtract( days
=> 5 ) );
483 AddIssue
( $patron, $item_3->{barcode
} );
485 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
486 $checkouts = $patron->checkouts;
487 is
( $checkouts->count, 3, 'checkouts should return 3 issues for that patron' );
488 is
( ref($checkouts), 'Koha::Checkouts', 'checkouts should return a Koha::Checkouts object' );
490 my $overdues = $patron->get_overdues;
491 is
( $overdues->count, 2, 'Patron should have 2 overdues');
492 is
( ref($overdues), 'Koha::Checkouts', 'Koha::Patron->get_overdues should return Koha::Checkouts' );
493 is
( $overdues->next->itemnumber, $item_1->{itemnumber
}, 'The issue should be returned in the same order as they have been done, first is correct' );
494 is
( $overdues->next->itemnumber, $item_2->{itemnumber
}, 'The issue should be returned in the same order as they have been done, second is correct' );
497 Koha
::Checkouts
->search( { borrowernumber
=> $patron->borrowernumber } )->delete;
499 $module->unmock('userenv');
502 subtest
'get_age' => sub {
505 my $patron = $builder->build( { source
=> 'Borrower' } );
506 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
508 my $today = dt_from_string
;
510 $patron->dateofbirth( undef );
511 is
( $patron->get_age, undef, 'get_age should return undef if no dateofbirth is defined' );
512 $patron->dateofbirth( $today->clone->add( years
=> -12, months
=> -6, days
=> -1 ) );
513 is
( $patron->get_age, 12, 'Patron should be 12' );
514 $patron->dateofbirth( $today->clone->add( years
=> -18, months
=> 0, days
=> 1 ) );
515 is
( $patron->get_age, 17, 'Patron should be 17, happy birthday tomorrow!' );
516 $patron->dateofbirth( $today->clone->add( years
=> -18, months
=> 0, days
=> 0 ) );
517 is
( $patron->get_age, 18, 'Patron should be 18' );
518 $patron->dateofbirth( $today->clone->add( years
=> -18, months
=> -12, days
=> -31 ) );
519 is
( $patron->get_age, 19, 'Patron should be 19' );
520 $patron->dateofbirth( $today->clone->add( years
=> -18, months
=> -12, days
=> -30 ) );
521 is
( $patron->get_age, 19, 'Patron should be 19 again' );
522 $patron->dateofbirth( $today->clone->add( years
=> 0, months
=> -1, days
=> -1 ) );
523 is
( $patron->get_age, 0, 'Patron is a newborn child' );
528 subtest
'account' => sub {
531 my $patron = $builder->build({source
=> 'Borrower'});
533 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
534 my $account = $patron->account;
535 is
( ref($account), 'Koha::Account', 'account should return a Koha::Account object' );
540 subtest
'search_upcoming_membership_expires' => sub {
543 my $expiry_days = 15;
544 t
::lib
::Mocks
::mock_preference
( 'MembershipExpiryDaysNotice', $expiry_days );
545 my $nb_of_days_before = 1;
546 my $nb_of_days_after = 2;
548 my $builder = t
::lib
::TestBuilder
->new();
550 my $library = $builder->build({ source
=> 'Branch' });
552 # before we add borrowers to this branch, add the expires we have now
553 # note that this pertains to the current mocked setting of the pref
554 # for this reason we add the new branchcode to most of the tests
555 my $nb_of_expires = Koha
::Patrons
->search_upcoming_membership_expires->count;
557 my $patron_1 = $builder->build({
558 source
=> 'Borrower',
560 branchcode
=> $library->{branchcode
},
561 dateexpiry
=> dt_from_string
->add( days
=> $expiry_days )
565 my $patron_2 = $builder->build({
566 source
=> 'Borrower',
568 branchcode
=> $library->{branchcode
},
569 dateexpiry
=> dt_from_string
->add( days
=> $expiry_days - $nb_of_days_before )
573 my $patron_3 = $builder->build({
574 source
=> 'Borrower',
576 branchcode
=> $library->{branchcode
},
577 dateexpiry
=> dt_from_string
->add( days
=> $expiry_days + $nb_of_days_after )
581 # Test without extra parameters
582 my $upcoming_mem_expires = Koha
::Patrons
->search_upcoming_membership_expires();
583 is
( $upcoming_mem_expires->count, $nb_of_expires + 1, 'Get upcoming membership expires should return one new borrower.' );
586 $upcoming_mem_expires = Koha
::Patrons
->search_upcoming_membership_expires({ 'me.branchcode' => $library->{branchcode
} });
587 is
( $upcoming_mem_expires->count, 1, 'Test with branch parameter' );
588 my $expired = $upcoming_mem_expires->next;
589 is
( $expired->surname, $patron_1->{surname
}, 'Get upcoming membership expires should return the correct patron.' );
590 is
( $expired->library->branchemail, $library->{branchemail
}, 'Get upcoming membership expires should return the correct patron.' );
591 is
( $expired->branchcode, $patron_1->{branchcode
}, 'Get upcoming membership expires should return the correct patron.' );
593 t
::lib
::Mocks
::mock_preference
( 'MembershipExpiryDaysNotice', 0 );
594 $upcoming_mem_expires = Koha
::Patrons
->search_upcoming_membership_expires({ 'me.branchcode' => $library->{branchcode
} });
595 is
( $upcoming_mem_expires->count, 0, 'Get upcoming membership expires with MembershipExpiryDaysNotice==0 should not return new records.' );
597 # Test MembershipExpiryDaysNotice == undef
598 t
::lib
::Mocks
::mock_preference
( 'MembershipExpiryDaysNotice', undef );
599 $upcoming_mem_expires = Koha
::Patrons
->search_upcoming_membership_expires({ 'me.branchcode' => $library->{branchcode
} });
600 is
( $upcoming_mem_expires->count, 0, 'Get upcoming membership expires without MembershipExpiryDaysNotice should not return new records.' );
602 # Test the before parameter
603 t
::lib
::Mocks
::mock_preference
( 'MembershipExpiryDaysNotice', 15 );
604 $upcoming_mem_expires = Koha
::Patrons
->search_upcoming_membership_expires({ 'me.branchcode' => $library->{branchcode
}, before
=> $nb_of_days_before });
605 is
( $upcoming_mem_expires->count, 2, 'Expect two results for before');
606 # Test after parameter also
607 $upcoming_mem_expires = Koha
::Patrons
->search_upcoming_membership_expires({ 'me.branchcode' => $library->{branchcode
}, before
=> $nb_of_days_before, after
=> $nb_of_days_after });
608 is
( $upcoming_mem_expires->count, 3, 'Expect three results when adding after' );
609 Koha
::Patrons
->search({ borrowernumber
=> { in => [ $patron_1->{borrowernumber
}, $patron_2->{borrowernumber
}, $patron_3->{borrowernumber
} ] } })->delete;
612 subtest
'holds' => sub {
615 my $library = $builder->build( { source
=> 'Branch' } );
616 my ($biblionumber_1) = AddBiblio
( MARC
::Record
->new, '' );
617 my $item_1 = $builder->build(
621 homebranch
=> $library->{branchcode
},
622 holdingbranch
=> $library->{branchcode
},
623 biblionumber
=> $biblionumber_1
627 my $item_2 = $builder->build(
631 homebranch
=> $library->{branchcode
},
632 holdingbranch
=> $library->{branchcode
},
633 biblionumber
=> $biblionumber_1
637 my ($biblionumber_2) = AddBiblio
( MARC
::Record
->new, '' );
638 my $item_3 = $builder->build(
642 homebranch
=> $library->{branchcode
},
643 holdingbranch
=> $library->{branchcode
},
644 biblionumber
=> $biblionumber_2
648 my $patron = $builder->build(
650 source
=> 'Borrower',
651 value
=> { branchcode
=> $library->{branchcode
} }
655 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
656 my $holds = $patron->holds;
657 is
( ref($holds), 'Koha::Holds',
658 'Koha::Patron->holds should return a Koha::Holds objects' );
659 is
( $holds->count, 0, 'There should not be holds placed by this patron yet' );
661 C4
::Reserves
::AddReserve
( $library->{branchcode
},
662 $patron->borrowernumber, $biblionumber_1 );
664 C4
::Reserves
::AddReserve
( $library->{branchcode
},
665 $patron->borrowernumber, $biblionumber_2, undef, undef, dt_from_string
->add( days
=> 2 ) );
667 $holds = $patron->holds;
668 is
( $holds->count, 2, 'There should be 2 holds placed by this patron' );
674 subtest
'search_patrons_to_anonymise & anonymise_issue_history' => sub {
677 # TODO create a subroutine in t::lib::Mocks
678 my $branch = $builder->build({ source
=> 'Branch' });
679 my $userenv_patron = $builder->build({
680 source
=> 'Borrower',
681 value
=> { branchcode
=> $branch->{branchcode
} },
683 C4
::Context
->_new_userenv('DUMMY SESSION');
684 C4
::Context
->set_userenv(
685 $userenv_patron->{borrowernumber
},
686 $userenv_patron->{userid
},
687 'usercnum', 'First name', 'Surname',
688 $branch->{branchcode
},
689 $branch->{branchname
},
692 my $anonymous = $builder->build( { source
=> 'Borrower', }, );
694 t
::lib
::Mocks
::mock_preference
( 'AnonymousPatron', $anonymous->{borrowernumber
} );
696 subtest
'patron privacy is 1 (default)' => sub {
699 t
::lib
::Mocks
::mock_preference
('IndependentBranches', 0);
700 my $patron = $builder->build(
701 { source
=> 'Borrower',
702 value
=> { privacy
=> 1, }
705 my $item_1 = $builder->build(
713 my $issue_1 = $builder->build(
716 borrowernumber
=> $patron->{borrowernumber
},
717 itemnumber
=> $item_1->{itemnumber
},
721 my $item_2 = $builder->build(
729 my $issue_2 = $builder->build(
732 borrowernumber
=> $patron->{borrowernumber
},
733 itemnumber
=> $item_2->{itemnumber
},
738 my ( $returned_1, undef, undef ) = C4
::Circulation
::AddReturn
( $item_1->{barcode
}, undef, undef, undef, '2010-10-10' );
739 my ( $returned_2, undef, undef ) = C4
::Circulation
::AddReturn
( $item_2->{barcode
}, undef, undef, undef, '2011-11-11' );
740 is
( $returned_1 && $returned_2, 1, 'The items should have been returned' );
742 my $patrons_to_anonymise = Koha
::Patrons
->search_patrons_to_anonymise( { before
=> '2010-10-11' } )->search( { 'me.borrowernumber' => $patron->{borrowernumber
} } );
743 is
( ref($patrons_to_anonymise), 'Koha::Patrons', 'search_patrons_to_anonymise should return Koha::Patrons' );
745 my $rows_affected = Koha
::Patrons
->search_patrons_to_anonymise( { before
=> '2011-11-12' } )->anonymise_issue_history( { before
=> '2010-10-11' } );
746 ok
( $rows_affected > 0, 'AnonymiseIssueHistory should affect at least 1 row' );
748 my $dbh = C4
::Context
->dbh;
749 my $sth = $dbh->prepare(q
|SELECT borrowernumber FROM old_issues where itemnumber
= ?
|);
750 $sth->execute($item_1->{itemnumber
});
751 my ($borrowernumber_used_to_anonymised) = $sth->fetchrow_array;
752 is
( $borrowernumber_used_to_anonymised, $anonymous->{borrowernumber
}, 'With privacy=1, the issue should have been anonymised' );
753 $sth->execute($item_2->{itemnumber
});
754 ($borrowernumber_used_to_anonymised) = $sth->fetchrow_array;
755 is
( $borrowernumber_used_to_anonymised, $patron->{borrowernumber
}, 'The issue should not have been anonymised, the returned date is later' );
757 $rows_affected = Koha
::Patrons
->search_patrons_to_anonymise( { before
=> '2011-11-12' } )->anonymise_issue_history;
758 $sth->execute($item_2->{itemnumber
});
759 ($borrowernumber_used_to_anonymised) = $sth->fetchrow_array;
760 is
( $borrowernumber_used_to_anonymised, $anonymous->{borrowernumber
}, 'The issue should have been anonymised, the returned date is before' );
762 my $sth_reset = $dbh->prepare(q
|UPDATE old_issues SET borrowernumber
= ? WHERE itemnumber
= ?
|);
763 $sth_reset->execute( $patron->{borrowernumber
}, $item_1->{itemnumber
} );
764 $sth_reset->execute( $patron->{borrowernumber
}, $item_2->{itemnumber
} );
765 $rows_affected = Koha
::Patrons
->search_patrons_to_anonymise->anonymise_issue_history;
766 $sth->execute($item_1->{itemnumber
});
767 ($borrowernumber_used_to_anonymised) = $sth->fetchrow_array;
768 is
( $borrowernumber_used_to_anonymised, $anonymous->{borrowernumber
}, 'The issue 1 should have been anonymised, before parameter was not passed' );
769 $sth->execute($item_2->{itemnumber
});
770 ($borrowernumber_used_to_anonymised) = $sth->fetchrow_array;
771 is
( $borrowernumber_used_to_anonymised, $anonymous->{borrowernumber
}, 'The issue 2 should have been anonymised, before parameter was not passed' );
773 Koha
::Patrons
->find( $patron->{borrowernumber
})->delete;
776 subtest
'patron privacy is 0 (forever)' => sub {
779 t
::lib
::Mocks
::mock_preference
('IndependentBranches', 0);
780 my $patron = $builder->build(
781 { source
=> 'Borrower',
782 value
=> { privacy
=> 0, }
785 my $item = $builder->build(
793 my $issue = $builder->build(
796 borrowernumber
=> $patron->{borrowernumber
},
797 itemnumber
=> $item->{itemnumber
},
802 my ( $returned, undef, undef ) = C4
::Circulation
::AddReturn
( $item->{barcode
}, undef, undef, undef, '2010-10-10' );
803 is
( $returned, 1, 'The item should have been returned' );
804 my $rows_affected = Koha
::Patrons
->search_patrons_to_anonymise( { before
=> '2010-10-11' } )->anonymise_issue_history( { before
=> '2010-10-11' } );
805 ok
( $rows_affected > 0, 'AnonymiseIssueHistory should not return any error if success' );
807 my $dbh = C4
::Context
->dbh;
808 my ($borrowernumber_used_to_anonymised) = $dbh->selectrow_array(q
|
809 SELECT borrowernumber FROM old_issues where itemnumber
= ?
810 |, undef, $item->{itemnumber
});
811 is
( $borrowernumber_used_to_anonymised, $patron->{borrowernumber
}, 'With privacy=0, the issue should not be anonymised' );
812 Koha
::Patrons
->find( $patron->{borrowernumber
})->delete;
815 t
::lib
::Mocks
::mock_preference
( 'AnonymousPatron', '' );
817 subtest
'AnonymousPatron is not defined' => sub {
820 t
::lib
::Mocks
::mock_preference
('IndependentBranches', 0);
821 my $patron = $builder->build(
822 { source
=> 'Borrower',
823 value
=> { privacy
=> 1, }
826 my $item = $builder->build(
834 my $issue = $builder->build(
837 borrowernumber
=> $patron->{borrowernumber
},
838 itemnumber
=> $item->{itemnumber
},
843 my ( $returned, undef, undef ) = C4
::Circulation
::AddReturn
( $item->{barcode
}, undef, undef, undef, '2010-10-10' );
844 is
( $returned, 1, 'The item should have been returned' );
845 my $rows_affected = Koha
::Patrons
->search_patrons_to_anonymise( { before
=> '2010-10-11' } )->anonymise_issue_history( { before
=> '2010-10-11' } );
846 ok
( $rows_affected > 0, 'AnonymiseIssueHistory should affect at least 1 row' );
848 my $dbh = C4
::Context
->dbh;
849 my ($borrowernumber_used_to_anonymised) = $dbh->selectrow_array(q
|
850 SELECT borrowernumber FROM old_issues where itemnumber
= ?
851 |, undef, $item->{itemnumber
});
852 is
( $borrowernumber_used_to_anonymised, undef, 'With AnonymousPatron is not defined, the issue should have been anonymised anyway' );
853 Koha
::Patrons
->find( $patron->{borrowernumber
})->delete;
856 subtest
'Logged in librarian is not superlibrarian & IndependentBranches' => sub {
858 t
::lib
::Mocks
::mock_preference
( 'IndependentBranches', 1 );
859 my $patron = $builder->build(
860 { source
=> 'Borrower',
861 value
=> { privacy
=> 1 } # Another branchcode than the logged in librarian
864 my $item = $builder->build(
872 my $issue = $builder->build(
875 borrowernumber
=> $patron->{borrowernumber
},
876 itemnumber
=> $item->{itemnumber
},
881 my ( $returned, undef, undef ) = C4
::Circulation
::AddReturn
( $item->{barcode
}, undef, undef, undef, '2010-10-10' );
882 is
( Koha
::Patrons
->search_patrons_to_anonymise( { before
=> '2010-10-11' } )->count, 0 );
883 Koha
::Patrons
->find( $patron->{borrowernumber
})->delete;
886 Koha
::Patrons
->find( $anonymous->{borrowernumber
})->delete;
887 Koha
::Patrons
->find( $userenv_patron->{borrowernumber
})->delete;
890 subtest
'account_locked' => sub {
892 my $patron = $builder->build({ source
=> 'Borrower', value
=> { login_attempts
=> 0 } });
893 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
894 for my $value ( undef, '', 0 ) {
895 t
::lib
::Mocks
::mock_preference
('FailedloginAttempts', $value);
896 is
( $patron->account_locked, 0, 'Feature is disabled, patron account should not be considered locked' );
897 $patron->login_attempts(1)->store;
898 is
( $patron->account_locked, 0, 'Feature is disabled, patron account should not be considered locked' );
901 t
::lib
::Mocks
::mock_preference
('FailedloginAttempts', 3);
902 $patron->login_attempts(2)->store;
903 is
( $patron->account_locked, 0, 'Patron has 2 failed attempts, account should not be considered locked yet' );
904 $patron->login_attempts(3)->store;
905 is
( $patron->account_locked, 1, 'Patron has 3 failed attempts, account should be considered locked yet' );
910 $retrieved_patron_1->delete;
911 is
( Koha
::Patrons
->search->count, $nb_of_patrons + 1, 'Delete should have deleted the patron' );
913 $schema->storage->txn_rollback;