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, end_of_month
=> 'limit' )->truncate( to
=> 'day' );
252 my $a_year_later = $dt->clone->add( months
=> 12, end_of_month
=> 'limit' )->truncate( to
=> 'day' );
253 my $a_year_later_minus_a_month = $dt->clone->add( months
=> 11, end_of_month
=> 'limit' )->truncate( to
=> 'day' );
254 my $a_month_later = $dt->clone->add( months
=> 1 , end_of_month
=> 'limit' )->truncate( to
=> 'day' );
255 my $a_year_later_plus_a_month = $dt->clone->add( months
=> 13, end_of_month
=> 'limit' )->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, "$a_month_ago + 12 months must be $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, "$a_month_ago + 12 months must be $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, "today + 12 months must be $a_year_later" );
305 $retrieved_expiry_date = Koha
::Patrons
->find( $patron->{borrowernumber
} )->dateexpiry;
306 is
( dt_from_string
($retrieved_expiry_date), $a_year_later, "today + 12 months must be $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, "today + 12 months must be $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, "today + 12 months must be $a_year_later" );
316 $expiry_date = $retrieved_patron_3->renew_account;
317 is
( $expiry_date, $a_year_later_plus_a_month, "$a_month_later + 12 months must be $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, "$a_month_later + 12 months must be $a_year_later_plus_a_month" );
321 $retrieved_patron->delete;
322 $retrieved_patron_2->delete;
323 $retrieved_patron_3->delete;
328 subtest
"move_to_deleted" => sub {
330 my $originally_updated_on = '2016-01-01 12:12:12';
331 my $patron = $builder->build( { source
=> 'Borrower',value
=> { updated_on
=> $originally_updated_on } } );
332 my $retrieved_patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
333 is
( ref( $retrieved_patron->move_to_deleted ), 'Koha::Schema::Result::Deletedborrower', 'Koha::Patron->move_to_deleted should return the Deleted patron' )
334 ; # FIXME This should be Koha::Deleted::Patron
335 my $deleted_patron = $schema->resultset('Deletedborrower')
336 ->search( { borrowernumber
=> $patron->{borrowernumber
} }, { result_class
=> 'DBIx::Class::ResultClass::HashRefInflator' } )
338 ok
( $retrieved_patron->updated_on, 'updated_on should be set for borrowers table' );
339 ok
( $deleted_patron->{updated_on
}, 'updated_on should be set for deleted_borrowers table' );
340 isnt
( $deleted_patron->{updated_on
}, $retrieved_patron->updated_on, 'Koha::Patron->move_to_deleted should have correctly updated the updated_on column');
341 $deleted_patron->{updated_on
} = $originally_updated_on; #reset for simplicity in comparing all other fields
342 is_deeply
( $deleted_patron, $patron, 'Koha::Patron->move_to_deleted should have correctly moved the patron to the deleted table' );
343 $retrieved_patron->delete( $patron->{borrowernumber
} ); # Cleanup
346 subtest
"delete" => sub {
348 t
::lib
::Mocks
::mock_preference
( 'BorrowersLog', 1 );
349 my $patron = $builder->build( { source
=> 'Borrower' } );
350 my $retrieved_patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
351 my $hold = $builder->build(
352 { source
=> 'Reserve',
353 value
=> { borrowernumber
=> $patron->{borrowernumber
} }
356 my $list = $builder->build(
357 { source
=> 'Virtualshelve',
358 value
=> { owner
=> $patron->{borrowernumber
} }
362 my $deleted = $retrieved_patron->delete;
363 is
( $deleted, 1, 'Koha::Patron->delete should return 1 if the patron has been correctly deleted' );
365 is
( Koha
::Patrons
->find( $patron->{borrowernumber
} ), undef, 'Koha::Patron->delete should have deleted the patron' );
367 is
( Koha
::Holds
->search( { borrowernumber
=> $patron->{borrowernumber
} } )->count, 0, q
|Koha
::Patron
->delete should have deleted patron
's holds| );
369 is( Koha::Virtualshelves->search( { owner => $patron->{borrowernumber} } )->count, 0, q|Koha::Patron->delete should have deleted patron's lists
| );
371 my $number_of_logs = $schema->resultset('ActionLog')->search( { module
=> 'MEMBERS', action
=> 'DELETE', object
=> $retrieved_patron->borrowernumber } )->count;
372 is
( $number_of_logs, 1, 'With BorrowerLogs, Koha::Patron->delete should have logged' );
375 subtest
'add_enrolment_fee_if_needed' => sub {
378 my $enrolmentfee_K = 5;
379 my $enrolmentfee_J = 10;
380 my $enrolmentfee_YA = 20;
382 my $dbh = C4
::Context
->dbh;
383 $dbh->do(q
|UPDATE categories set enrolmentfee
=? where categorycode
=?
|, undef, $enrolmentfee_K, 'K');
384 $dbh->do(q
|UPDATE categories set enrolmentfee
=? where categorycode
=?
|, undef, $enrolmentfee_J, 'J');
385 $dbh->do(q
|UPDATE categories set enrolmentfee
=? where categorycode
=?
|, undef, $enrolmentfee_YA, 'YA');
387 my %borrower_data = (
388 firstname
=> 'my firstname',
389 surname
=> 'my surname',
391 branchcode
=> $library->{branchcode
},
394 my $borrowernumber = C4
::Members
::AddMember
(%borrower_data);
395 $borrower_data{borrowernumber
} = $borrowernumber;
397 my ($total) = C4
::Members
::GetMemberAccountRecords
($borrowernumber);
398 is
( $total, $enrolmentfee_K, "New kid pay $enrolmentfee_K" );
400 t
::lib
::Mocks
::mock_preference
( 'FeeOnChangePatronCategory', 0 );
401 $borrower_data{categorycode
} = 'J';
402 C4
::Members
::ModMember
(%borrower_data);
403 ($total) = C4
::Members
::GetMemberAccountRecords
($borrowernumber);
404 is
( $total, $enrolmentfee_K, "Kid growing and become a juvenile, but shouldn't pay for the upgrade " );
406 $borrower_data{categorycode
} = 'K';
407 C4
::Members
::ModMember
(%borrower_data);
408 t
::lib
::Mocks
::mock_preference
( 'FeeOnChangePatronCategory', 1 );
410 $borrower_data{categorycode
} = 'J';
411 C4
::Members
::ModMember
(%borrower_data);
412 ($total) = C4
::Members
::GetMemberAccountRecords
($borrowernumber);
413 is
( $total, $enrolmentfee_K + $enrolmentfee_J, "Kid growing and become a juvenile, they should pay " . ( $enrolmentfee_K + $enrolmentfee_J ) );
415 # Check with calling directly Koha::Patron->get_enrolment_fee_if_needed
416 my $patron = Koha
::Patrons
->find($borrowernumber);
417 $patron->categorycode('YA')->store;
418 my $fee = $patron->add_enrolment_fee_if_needed;
419 ($total) = C4
::Members
::GetMemberAccountRecords
($borrowernumber);
421 $enrolmentfee_K + $enrolmentfee_J + $enrolmentfee_YA,
422 "Juvenile growing and become an young adult, they should pay " . ( $enrolmentfee_K + $enrolmentfee_J + $enrolmentfee_YA )
428 subtest
'checkouts + get_overdues' => sub {
431 my $library = $builder->build( { source
=> 'Branch' } );
432 my ($biblionumber_1) = AddBiblio
( MARC
::Record
->new, '' );
433 my $item_1 = $builder->build(
437 homebranch
=> $library->{branchcode
},
438 holdingbranch
=> $library->{branchcode
},
439 biblionumber
=> $biblionumber_1
443 my $item_2 = $builder->build(
447 homebranch
=> $library->{branchcode
},
448 holdingbranch
=> $library->{branchcode
},
449 biblionumber
=> $biblionumber_1
453 my ($biblionumber_2) = AddBiblio
( MARC
::Record
->new, '' );
454 my $item_3 = $builder->build(
458 homebranch
=> $library->{branchcode
},
459 holdingbranch
=> $library->{branchcode
},
460 biblionumber
=> $biblionumber_2
464 my $patron = $builder->build(
466 source
=> 'Borrower',
467 value
=> { branchcode
=> $library->{branchcode
} }
471 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
472 my $checkouts = $patron->checkouts;
473 is
( $checkouts->count, 0, 'checkouts should not return any issues for that patron' );
474 is
( ref($checkouts), 'Koha::Checkouts', 'checkouts should return a Koha::Checkouts object' );
476 # Not sure how this is useful, but AddIssue pass this variable to different other subroutines
477 $patron = GetMember
( borrowernumber
=> $patron->borrowernumber );
479 my $module = new Test
::MockModule
('C4::Context');
480 $module->mock( 'userenv', sub { { branch
=> $library->{branchcode
} } } );
482 AddIssue
( $patron, $item_1->{barcode
}, DateTime
->now->subtract( days
=> 1 ) );
483 AddIssue
( $patron, $item_2->{barcode
}, DateTime
->now->subtract( days
=> 5 ) );
484 AddIssue
( $patron, $item_3->{barcode
} );
486 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
487 $checkouts = $patron->checkouts;
488 is
( $checkouts->count, 3, 'checkouts should return 3 issues for that patron' );
489 is
( ref($checkouts), 'Koha::Checkouts', 'checkouts should return a Koha::Checkouts object' );
491 my $overdues = $patron->get_overdues;
492 is
( $overdues->count, 2, 'Patron should have 2 overdues');
493 is
( ref($overdues), 'Koha::Checkouts', 'Koha::Patron->get_overdues should return Koha::Checkouts' );
494 is
( $overdues->next->itemnumber, $item_1->{itemnumber
}, 'The issue should be returned in the same order as they have been done, first is correct' );
495 is
( $overdues->next->itemnumber, $item_2->{itemnumber
}, 'The issue should be returned in the same order as they have been done, second is correct' );
498 Koha
::Checkouts
->search( { borrowernumber
=> $patron->borrowernumber } )->delete;
500 $module->unmock('userenv');
503 subtest
'get_age' => sub {
506 my $patron = $builder->build( { source
=> 'Borrower' } );
507 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
509 my $today = dt_from_string
;
511 $patron->dateofbirth( undef );
512 is
( $patron->get_age, undef, 'get_age should return undef if no dateofbirth is defined' );
513 $patron->dateofbirth( $today->clone->add( years
=> -12, months
=> -6, days
=> -1 ) );
514 is
( $patron->get_age, 12, 'Patron should be 12' );
515 $patron->dateofbirth( $today->clone->add( years
=> -18, months
=> 0, days
=> 1 ) );
516 is
( $patron->get_age, 17, 'Patron should be 17, happy birthday tomorrow!' );
517 $patron->dateofbirth( $today->clone->add( years
=> -18, months
=> 0, days
=> 0 ) );
518 is
( $patron->get_age, 18, 'Patron should be 18' );
519 $patron->dateofbirth( $today->clone->add( years
=> -18, months
=> -12, days
=> -31 ) );
520 is
( $patron->get_age, 19, 'Patron should be 19' );
521 $patron->dateofbirth( $today->clone->add( years
=> -18, months
=> -12, days
=> -30 ) );
522 is
( $patron->get_age, 19, 'Patron should be 19 again' );
523 $patron->dateofbirth( $today->clone->add( years
=> 0, months
=> -1, days
=> -1 ) );
524 is
( $patron->get_age, 0, 'Patron is a newborn child' );
529 subtest
'account' => sub {
532 my $patron = $builder->build({source
=> 'Borrower'});
534 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
535 my $account = $patron->account;
536 is
( ref($account), 'Koha::Account', 'account should return a Koha::Account object' );
541 subtest
'search_upcoming_membership_expires' => sub {
544 my $expiry_days = 15;
545 t
::lib
::Mocks
::mock_preference
( 'MembershipExpiryDaysNotice', $expiry_days );
546 my $nb_of_days_before = 1;
547 my $nb_of_days_after = 2;
549 my $builder = t
::lib
::TestBuilder
->new();
551 my $library = $builder->build({ source
=> 'Branch' });
553 # before we add borrowers to this branch, add the expires we have now
554 # note that this pertains to the current mocked setting of the pref
555 # for this reason we add the new branchcode to most of the tests
556 my $nb_of_expires = Koha
::Patrons
->search_upcoming_membership_expires->count;
558 my $patron_1 = $builder->build({
559 source
=> 'Borrower',
561 branchcode
=> $library->{branchcode
},
562 dateexpiry
=> dt_from_string
->add( days
=> $expiry_days )
566 my $patron_2 = $builder->build({
567 source
=> 'Borrower',
569 branchcode
=> $library->{branchcode
},
570 dateexpiry
=> dt_from_string
->add( days
=> $expiry_days - $nb_of_days_before )
574 my $patron_3 = $builder->build({
575 source
=> 'Borrower',
577 branchcode
=> $library->{branchcode
},
578 dateexpiry
=> dt_from_string
->add( days
=> $expiry_days + $nb_of_days_after )
582 # Test without extra parameters
583 my $upcoming_mem_expires = Koha
::Patrons
->search_upcoming_membership_expires();
584 is
( $upcoming_mem_expires->count, $nb_of_expires + 1, 'Get upcoming membership expires should return one new borrower.' );
587 $upcoming_mem_expires = Koha
::Patrons
->search_upcoming_membership_expires({ 'me.branchcode' => $library->{branchcode
} });
588 is
( $upcoming_mem_expires->count, 1, 'Test with branch parameter' );
589 my $expired = $upcoming_mem_expires->next;
590 is
( $expired->surname, $patron_1->{surname
}, 'Get upcoming membership expires should return the correct patron.' );
591 is
( $expired->library->branchemail, $library->{branchemail
}, 'Get upcoming membership expires should return the correct patron.' );
592 is
( $expired->branchcode, $patron_1->{branchcode
}, 'Get upcoming membership expires should return the correct patron.' );
594 t
::lib
::Mocks
::mock_preference
( 'MembershipExpiryDaysNotice', 0 );
595 $upcoming_mem_expires = Koha
::Patrons
->search_upcoming_membership_expires({ 'me.branchcode' => $library->{branchcode
} });
596 is
( $upcoming_mem_expires->count, 0, 'Get upcoming membership expires with MembershipExpiryDaysNotice==0 should not return new records.' );
598 # Test MembershipExpiryDaysNotice == undef
599 t
::lib
::Mocks
::mock_preference
( 'MembershipExpiryDaysNotice', undef );
600 $upcoming_mem_expires = Koha
::Patrons
->search_upcoming_membership_expires({ 'me.branchcode' => $library->{branchcode
} });
601 is
( $upcoming_mem_expires->count, 0, 'Get upcoming membership expires without MembershipExpiryDaysNotice should not return new records.' );
603 # Test the before parameter
604 t
::lib
::Mocks
::mock_preference
( 'MembershipExpiryDaysNotice', 15 );
605 $upcoming_mem_expires = Koha
::Patrons
->search_upcoming_membership_expires({ 'me.branchcode' => $library->{branchcode
}, before
=> $nb_of_days_before });
606 is
( $upcoming_mem_expires->count, 2, 'Expect two results for before');
607 # Test after parameter also
608 $upcoming_mem_expires = Koha
::Patrons
->search_upcoming_membership_expires({ 'me.branchcode' => $library->{branchcode
}, before
=> $nb_of_days_before, after
=> $nb_of_days_after });
609 is
( $upcoming_mem_expires->count, 3, 'Expect three results when adding after' );
610 Koha
::Patrons
->search({ borrowernumber
=> { in => [ $patron_1->{borrowernumber
}, $patron_2->{borrowernumber
}, $patron_3->{borrowernumber
} ] } })->delete;
613 subtest
'holds' => sub {
616 my $library = $builder->build( { source
=> 'Branch' } );
617 my ($biblionumber_1) = AddBiblio
( MARC
::Record
->new, '' );
618 my $item_1 = $builder->build(
622 homebranch
=> $library->{branchcode
},
623 holdingbranch
=> $library->{branchcode
},
624 biblionumber
=> $biblionumber_1
628 my $item_2 = $builder->build(
632 homebranch
=> $library->{branchcode
},
633 holdingbranch
=> $library->{branchcode
},
634 biblionumber
=> $biblionumber_1
638 my ($biblionumber_2) = AddBiblio
( MARC
::Record
->new, '' );
639 my $item_3 = $builder->build(
643 homebranch
=> $library->{branchcode
},
644 holdingbranch
=> $library->{branchcode
},
645 biblionumber
=> $biblionumber_2
649 my $patron = $builder->build(
651 source
=> 'Borrower',
652 value
=> { branchcode
=> $library->{branchcode
} }
656 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
657 my $holds = $patron->holds;
658 is
( ref($holds), 'Koha::Holds',
659 'Koha::Patron->holds should return a Koha::Holds objects' );
660 is
( $holds->count, 0, 'There should not be holds placed by this patron yet' );
662 C4
::Reserves
::AddReserve
( $library->{branchcode
},
663 $patron->borrowernumber, $biblionumber_1 );
665 C4
::Reserves
::AddReserve
( $library->{branchcode
},
666 $patron->borrowernumber, $biblionumber_2, undef, undef, dt_from_string
->add( days
=> 2 ) );
668 $holds = $patron->holds;
669 is
( $holds->count, 2, 'There should be 2 holds placed by this patron' );
675 subtest
'search_patrons_to_anonymise & anonymise_issue_history' => sub {
678 # TODO create a subroutine in t::lib::Mocks
679 my $branch = $builder->build({ source
=> 'Branch' });
680 my $userenv_patron = $builder->build({
681 source
=> 'Borrower',
682 value
=> { branchcode
=> $branch->{branchcode
} },
684 C4
::Context
->_new_userenv('DUMMY SESSION');
685 C4
::Context
->set_userenv(
686 $userenv_patron->{borrowernumber
},
687 $userenv_patron->{userid
},
688 'usercnum', 'First name', 'Surname',
689 $branch->{branchcode
},
690 $branch->{branchname
},
693 my $anonymous = $builder->build( { source
=> 'Borrower', }, );
695 t
::lib
::Mocks
::mock_preference
( 'AnonymousPatron', $anonymous->{borrowernumber
} );
697 subtest
'patron privacy is 1 (default)' => sub {
700 t
::lib
::Mocks
::mock_preference
('IndependentBranches', 0);
701 my $patron = $builder->build(
702 { source
=> 'Borrower',
703 value
=> { privacy
=> 1, }
706 my $item_1 = $builder->build(
714 my $issue_1 = $builder->build(
717 borrowernumber
=> $patron->{borrowernumber
},
718 itemnumber
=> $item_1->{itemnumber
},
722 my $item_2 = $builder->build(
730 my $issue_2 = $builder->build(
733 borrowernumber
=> $patron->{borrowernumber
},
734 itemnumber
=> $item_2->{itemnumber
},
739 my ( $returned_1, undef, undef ) = C4
::Circulation
::AddReturn
( $item_1->{barcode
}, undef, undef, undef, '2010-10-10' );
740 my ( $returned_2, undef, undef ) = C4
::Circulation
::AddReturn
( $item_2->{barcode
}, undef, undef, undef, '2011-11-11' );
741 is
( $returned_1 && $returned_2, 1, 'The items should have been returned' );
743 my $patrons_to_anonymise = Koha
::Patrons
->search_patrons_to_anonymise( { before
=> '2010-10-11' } )->search( { 'me.borrowernumber' => $patron->{borrowernumber
} } );
744 is
( ref($patrons_to_anonymise), 'Koha::Patrons', 'search_patrons_to_anonymise should return Koha::Patrons' );
746 my $rows_affected = Koha
::Patrons
->search_patrons_to_anonymise( { before
=> '2011-11-12' } )->anonymise_issue_history( { before
=> '2010-10-11' } );
747 ok
( $rows_affected > 0, 'AnonymiseIssueHistory should affect at least 1 row' );
749 my $dbh = C4
::Context
->dbh;
750 my $sth = $dbh->prepare(q
|SELECT borrowernumber FROM old_issues where itemnumber
= ?
|);
751 $sth->execute($item_1->{itemnumber
});
752 my ($borrowernumber_used_to_anonymised) = $sth->fetchrow_array;
753 is
( $borrowernumber_used_to_anonymised, $anonymous->{borrowernumber
}, 'With privacy=1, the issue should have been anonymised' );
754 $sth->execute($item_2->{itemnumber
});
755 ($borrowernumber_used_to_anonymised) = $sth->fetchrow_array;
756 is
( $borrowernumber_used_to_anonymised, $patron->{borrowernumber
}, 'The issue should not have been anonymised, the returned date is later' );
758 $rows_affected = Koha
::Patrons
->search_patrons_to_anonymise( { before
=> '2011-11-12' } )->anonymise_issue_history;
759 $sth->execute($item_2->{itemnumber
});
760 ($borrowernumber_used_to_anonymised) = $sth->fetchrow_array;
761 is
( $borrowernumber_used_to_anonymised, $anonymous->{borrowernumber
}, 'The issue should have been anonymised, the returned date is before' );
763 my $sth_reset = $dbh->prepare(q
|UPDATE old_issues SET borrowernumber
= ? WHERE itemnumber
= ?
|);
764 $sth_reset->execute( $patron->{borrowernumber
}, $item_1->{itemnumber
} );
765 $sth_reset->execute( $patron->{borrowernumber
}, $item_2->{itemnumber
} );
766 $rows_affected = Koha
::Patrons
->search_patrons_to_anonymise->anonymise_issue_history;
767 $sth->execute($item_1->{itemnumber
});
768 ($borrowernumber_used_to_anonymised) = $sth->fetchrow_array;
769 is
( $borrowernumber_used_to_anonymised, $anonymous->{borrowernumber
}, 'The issue 1 should have been anonymised, before parameter was not passed' );
770 $sth->execute($item_2->{itemnumber
});
771 ($borrowernumber_used_to_anonymised) = $sth->fetchrow_array;
772 is
( $borrowernumber_used_to_anonymised, $anonymous->{borrowernumber
}, 'The issue 2 should have been anonymised, before parameter was not passed' );
774 Koha
::Patrons
->find( $patron->{borrowernumber
})->delete;
777 subtest
'patron privacy is 0 (forever)' => sub {
780 t
::lib
::Mocks
::mock_preference
('IndependentBranches', 0);
781 my $patron = $builder->build(
782 { source
=> 'Borrower',
783 value
=> { privacy
=> 0, }
786 my $item = $builder->build(
794 my $issue = $builder->build(
797 borrowernumber
=> $patron->{borrowernumber
},
798 itemnumber
=> $item->{itemnumber
},
803 my ( $returned, undef, undef ) = C4
::Circulation
::AddReturn
( $item->{barcode
}, undef, undef, undef, '2010-10-10' );
804 is
( $returned, 1, 'The item should have been returned' );
805 my $rows_affected = Koha
::Patrons
->search_patrons_to_anonymise( { before
=> '2010-10-11' } )->anonymise_issue_history( { before
=> '2010-10-11' } );
806 ok
( $rows_affected > 0, 'AnonymiseIssueHistory should not return any error if success' );
808 my $dbh = C4
::Context
->dbh;
809 my ($borrowernumber_used_to_anonymised) = $dbh->selectrow_array(q
|
810 SELECT borrowernumber FROM old_issues where itemnumber
= ?
811 |, undef, $item->{itemnumber
});
812 is
( $borrowernumber_used_to_anonymised, $patron->{borrowernumber
}, 'With privacy=0, the issue should not be anonymised' );
813 Koha
::Patrons
->find( $patron->{borrowernumber
})->delete;
816 t
::lib
::Mocks
::mock_preference
( 'AnonymousPatron', '' );
818 subtest
'AnonymousPatron is not defined' => sub {
821 t
::lib
::Mocks
::mock_preference
('IndependentBranches', 0);
822 my $patron = $builder->build(
823 { source
=> 'Borrower',
824 value
=> { privacy
=> 1, }
827 my $item = $builder->build(
835 my $issue = $builder->build(
838 borrowernumber
=> $patron->{borrowernumber
},
839 itemnumber
=> $item->{itemnumber
},
844 my ( $returned, undef, undef ) = C4
::Circulation
::AddReturn
( $item->{barcode
}, undef, undef, undef, '2010-10-10' );
845 is
( $returned, 1, 'The item should have been returned' );
846 my $rows_affected = Koha
::Patrons
->search_patrons_to_anonymise( { before
=> '2010-10-11' } )->anonymise_issue_history( { before
=> '2010-10-11' } );
847 ok
( $rows_affected > 0, 'AnonymiseIssueHistory should affect at least 1 row' );
849 my $dbh = C4
::Context
->dbh;
850 my ($borrowernumber_used_to_anonymised) = $dbh->selectrow_array(q
|
851 SELECT borrowernumber FROM old_issues where itemnumber
= ?
852 |, undef, $item->{itemnumber
});
853 is
( $borrowernumber_used_to_anonymised, undef, 'With AnonymousPatron is not defined, the issue should have been anonymised anyway' );
854 Koha
::Patrons
->find( $patron->{borrowernumber
})->delete;
857 subtest
'Logged in librarian is not superlibrarian & IndependentBranches' => sub {
859 t
::lib
::Mocks
::mock_preference
( 'IndependentBranches', 1 );
860 my $patron = $builder->build(
861 { source
=> 'Borrower',
862 value
=> { privacy
=> 1 } # Another branchcode than the logged in librarian
865 my $item = $builder->build(
873 my $issue = $builder->build(
876 borrowernumber
=> $patron->{borrowernumber
},
877 itemnumber
=> $item->{itemnumber
},
882 my ( $returned, undef, undef ) = C4
::Circulation
::AddReturn
( $item->{barcode
}, undef, undef, undef, '2010-10-10' );
883 is
( Koha
::Patrons
->search_patrons_to_anonymise( { before
=> '2010-10-11' } )->count, 0 );
884 Koha
::Patrons
->find( $patron->{borrowernumber
})->delete;
887 Koha
::Patrons
->find( $anonymous->{borrowernumber
})->delete;
888 Koha
::Patrons
->find( $userenv_patron->{borrowernumber
})->delete;
891 subtest
'account_locked' => sub {
893 my $patron = $builder->build({ source
=> 'Borrower', value
=> { login_attempts
=> 0 } });
894 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
895 for my $value ( undef, '', 0 ) {
896 t
::lib
::Mocks
::mock_preference
('FailedloginAttempts', $value);
897 is
( $patron->account_locked, 0, 'Feature is disabled, patron account should not be considered locked' );
898 $patron->login_attempts(1)->store;
899 is
( $patron->account_locked, 0, 'Feature is disabled, patron account should not be considered locked' );
902 t
::lib
::Mocks
::mock_preference
('FailedloginAttempts', 3);
903 $patron->login_attempts(2)->store;
904 is
( $patron->account_locked, 0, 'Patron has 2 failed attempts, account should not be considered locked yet' );
905 $patron->login_attempts(3)->store;
906 is
( $patron->account_locked, 1, 'Patron has 3 failed attempts, account should be considered locked yet' );
911 $retrieved_patron_1->delete;
912 is
( Koha
::Patrons
->search->count, $nb_of_patrons + 1, 'Delete should have deleted the patron' );
914 $schema->storage->txn_rollback;