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
=> 34;
32 use C4
::Auth
qw(checkpw_hash);
36 use Koha
::Patron
::Categories
;
39 use Koha
::Virtualshelves
;
41 use t
::lib
::TestBuilder
;
44 my $schema = Koha
::Database
->new->schema;
45 $schema->storage->txn_begin;
47 my $builder = t
::lib
::TestBuilder
->new;
48 my $library = $builder->build({source
=> 'Branch' });
49 my $category = $builder->build({source
=> 'Category' });
50 my $nb_of_patrons = Koha
::Patrons
->search->count;
51 my $new_patron_1 = Koha
::Patron
->new(
52 { cardnumber
=> 'test_cn_1',
53 branchcode
=> $library->{branchcode
},
54 categorycode
=> $category->{categorycode
},
55 surname
=> 'surname for patron1',
56 firstname
=> 'firstname for patron1',
57 userid
=> 'a_nonexistent_userid_1',
58 flags
=> 1, # Is superlibrarian
61 my $new_patron_2 = Koha
::Patron
->new(
62 { cardnumber
=> 'test_cn_2',
63 branchcode
=> $library->{branchcode
},
64 categorycode
=> $category->{categorycode
},
65 surname
=> 'surname for patron2',
66 firstname
=> 'firstname for patron2',
67 userid
=> 'a_nonexistent_userid_2',
71 t
::lib
::Mocks
::mock_userenv
({ patron
=> $new_patron_1 });
73 is
( Koha
::Patrons
->search->count, $nb_of_patrons + 2, 'The 2 patrons should have been added' );
75 my $retrieved_patron_1 = Koha
::Patrons
->find( $new_patron_1->borrowernumber );
76 is
( $retrieved_patron_1->cardnumber, $new_patron_1->cardnumber, 'Find a patron by borrowernumber should return the correct patron' );
78 subtest
'library' => sub {
80 is
( $retrieved_patron_1->library->branchcode, $library->{branchcode
}, 'Koha::Patron->library should return the correct library' );
81 is
( ref($retrieved_patron_1->library), 'Koha::Library', 'Koha::Patron->library should return a Koha::Library object' );
84 subtest
'guarantees' => sub {
86 my $guarantees = $new_patron_1->guarantees;
87 is
( ref($guarantees), 'Koha::Patrons', 'Koha::Patron->guarantees should return a Koha::Patrons result set in a scalar context' );
88 is
( $guarantees->count, 0, 'new_patron_1 should have 0 guarantee' );
89 my @guarantees = $new_patron_1->guarantees;
90 is
( ref(\
@guarantees), 'ARRAY', 'Koha::Patron->guarantees should return an array in a list context' );
91 is
( scalar(@guarantees), 0, 'new_patron_1 should have 0 guarantee' );
93 my $guarantee_1 = $builder->build({ source
=> 'Borrower', value
=> { guarantorid
=> $new_patron_1->borrowernumber }});
94 my $guarantee_2 = $builder->build({ source
=> 'Borrower', value
=> { guarantorid
=> $new_patron_1->borrowernumber }});
96 $guarantees = $new_patron_1->guarantees;
97 is
( ref($guarantees), 'Koha::Patrons', 'Koha::Patron->guarantees should return a Koha::Patrons result set in a scalar context' );
98 is
( $guarantees->count, 2, 'new_patron_1 should have 2 guarantees' );
99 @guarantees = $new_patron_1->guarantees;
100 is
( ref(\
@guarantees), 'ARRAY', 'Koha::Patron->guarantees should return an array in a list context' );
101 is
( scalar(@guarantees), 2, 'new_patron_1 should have 2 guarantees' );
102 $_->delete for @guarantees;
104 #Test return order of guarantees BZ 18635
105 my $categorycode = $builder->build({ source
=> 'Category' })->{categorycode
};
106 my $branchcode = $builder->build({ source
=> 'Branch' })->{branchcode
};
108 my $guarantor = $builder->build_object( { class => 'Koha::Patrons' } );
110 my $order_guarantee1 = $builder->build_object( { class => 'Koha::Patrons' , value
=> {
112 guarantorid
=> $guarantor->borrowernumber
116 my $order_guarantee2 = $builder->build_object( { class => 'Koha::Patrons' , value
=> {
118 guarantorid
=> $guarantor->borrowernumber
122 my $order_guarantee3 = $builder->build_object( { class => 'Koha::Patrons' , value
=> {
124 firstname
=> 'Walrus',
125 guarantorid
=> $guarantor->borrowernumber
129 my $order_guarantee4 = $builder->build_object( { class => 'Koha::Patrons' , value
=> {
131 firstname
=> 'Vulture',
132 guarantorid
=> $guarantor->borrowernumber
136 my $order_guarantee5 = $builder->build_object( { class => 'Koha::Patrons' , value
=> {
138 firstname
=> 'Unicorn',
139 guarantorid
=> $guarantor->borrowernumber
143 $guarantees = $guarantor->guarantees();
145 is
( $guarantees->next()->borrowernumber, $order_guarantee5, "Return first guarantor alphabetically" );
146 is
( $guarantees->next()->borrowernumber, $order_guarantee4, "Return second guarantor alphabetically" );
147 is
( $guarantees->next()->borrowernumber, $order_guarantee3, "Return third guarantor alphabetically" );
148 is
( $guarantees->next()->borrowernumber, $order_guarantee2, "Return fourth guarantor alphabetically" );
149 is
( $guarantees->next()->borrowernumber, $order_guarantee1, "Return fifth guarantor alphabetically" );
152 subtest
'category' => sub {
154 my $patron_category = $new_patron_1->category;
155 is
( ref( $patron_category), 'Koha::Patron::Category', );
156 is
( $patron_category->categorycode, $category->{categorycode
}, );
159 subtest
'siblings' => sub {
161 my $siblings = $new_patron_1->siblings;
162 is
( $siblings, undef, 'Koha::Patron->siblings should not crashed if the patron has no guarantor' );
163 my $guarantee_1 = $builder->build( { source
=> 'Borrower', value
=> { guarantorid
=> $new_patron_1->borrowernumber } } );
164 my $retrieved_guarantee_1 = Koha
::Patrons
->find($guarantee_1);
165 $siblings = $retrieved_guarantee_1->siblings;
166 is
( ref($siblings), 'Koha::Patrons', 'Koha::Patron->siblings should return a Koha::Patrons result set in a scalar context' );
167 my @siblings = $retrieved_guarantee_1->siblings;
168 is
( ref( \
@siblings ), 'ARRAY', 'Koha::Patron->siblings should return an array in a list context' );
169 is
( $siblings->count, 0, 'guarantee_1 should not have siblings yet' );
170 my $guarantee_2 = $builder->build( { source
=> 'Borrower', value
=> { guarantorid
=> $new_patron_1->borrowernumber } } );
171 my $guarantee_3 = $builder->build( { source
=> 'Borrower', value
=> { guarantorid
=> $new_patron_1->borrowernumber } } );
172 $siblings = $retrieved_guarantee_1->siblings;
173 is
( $siblings->count, 2, 'guarantee_1 should have 2 siblings' );
174 is
( $guarantee_2->{borrowernumber
}, $siblings->next->borrowernumber, 'guarantee_2 should exist in the guarantees' );
175 is
( $guarantee_3->{borrowernumber
}, $siblings->next->borrowernumber, 'guarantee_3 should exist in the guarantees' );
176 $_->delete for $retrieved_guarantee_1->siblings;
177 $retrieved_guarantee_1->delete;
180 subtest
'has_overdues' => sub {
183 my $biblioitem_1 = $builder->build( { source
=> 'Biblioitem' } );
184 my $item_1 = $builder->build(
187 homebranch
=> $library->{branchcode
},
188 holdingbranch
=> $library->{branchcode
},
192 biblionumber
=> $biblioitem_1->{biblionumber
}
196 my $retrieved_patron = Koha
::Patrons
->find( $new_patron_1->borrowernumber );
197 is
( $retrieved_patron->has_overdues, 0, );
199 my $tomorrow = DateTime
->today( time_zone
=> C4
::Context
->tz() )->add( days
=> 1 );
200 my $issue = Koha
::Checkout
->new({ borrowernumber
=> $new_patron_1->id, itemnumber
=> $item_1->{itemnumber
}, date_due
=> $tomorrow, branchcode
=> $library->{branchcode
} })->store();
201 is
( $retrieved_patron->has_overdues, 0, );
203 my $yesterday = DateTime
->today(time_zone
=> C4
::Context
->tz())->add( days
=> -1 );
204 $issue = Koha
::Checkout
->new({ borrowernumber
=> $new_patron_1->id, itemnumber
=> $item_1->{itemnumber
}, date_due
=> $yesterday, branchcode
=> $library->{branchcode
} })->store();
205 $retrieved_patron = Koha
::Patrons
->find( $new_patron_1->borrowernumber );
206 is
( $retrieved_patron->has_overdues, 1, );
210 subtest
'is_expired' => sub {
212 my $patron = $builder->build({ source
=> 'Borrower' });
213 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
214 $patron->dateexpiry( undef )->store->discard_changes;
215 is
( $patron->is_expired, 0, 'Patron should not be considered expired if dateexpiry is not set');
216 $patron->dateexpiry( dt_from_string
)->store->discard_changes;
217 is
( $patron->is_expired, 0, 'Patron should not be considered expired if dateexpiry is today');
218 $patron->dateexpiry( dt_from_string
->add( days
=> 1 ) )->store->discard_changes;
219 is
( $patron->is_expired, 0, 'Patron should not be considered expired if dateexpiry is tomorrow');
220 $patron->dateexpiry( dt_from_string
->add( days
=> -1 ) )->store->discard_changes;
221 is
( $patron->is_expired, 1, 'Patron should be considered expired if dateexpiry is yesterday');
226 subtest
'is_going_to_expire' => sub {
228 my $patron = $builder->build({ source
=> 'Borrower' });
229 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
230 $patron->dateexpiry( undef )->store->discard_changes;
231 is
( $patron->is_going_to_expire, 0, 'Patron should not be considered going to expire if dateexpiry is not set');
233 t
::lib
::Mocks
::mock_preference
('NotifyBorrowerDeparture', 0);
234 $patron->dateexpiry( dt_from_string
)->store->discard_changes;
235 is
( $patron->is_going_to_expire, 0, 'Patron should not be considered going to expire if dateexpiry is today');
237 $patron->dateexpiry( dt_from_string
)->store->discard_changes;
238 is
( $patron->is_going_to_expire, 0, 'Patron should not be considered going to expire if dateexpiry is today and pref is 0');
240 t
::lib
::Mocks
::mock_preference
('NotifyBorrowerDeparture', 10);
241 $patron->dateexpiry( dt_from_string
->add( days
=> 11 ) )->store->discard_changes;
242 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');
244 t
::lib
::Mocks
::mock_preference
('NotifyBorrowerDeparture', 0);
245 $patron->dateexpiry( dt_from_string
->add( days
=> 10 ) )->store->discard_changes;
246 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');
248 t
::lib
::Mocks
::mock_preference
('NotifyBorrowerDeparture', 10);
249 $patron->dateexpiry( dt_from_string
->add( days
=> 10 ) )->store->discard_changes;
250 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');
253 t
::lib
::Mocks
::mock_preference
('NotifyBorrowerDeparture', 10);
254 $patron->dateexpiry( dt_from_string
->add( days
=> 20 ) )->store->discard_changes;
255 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');
257 t
::lib
::Mocks
::mock_preference
('NotifyBorrowerDeparture', 20);
258 $patron->dateexpiry( dt_from_string
->add( days
=> 10 ) )->store->discard_changes;
259 is
( $patron->is_going_to_expire, 1, 'Patron should be considered going to expire if dateexpiry is 10 days ahead and pref is 20');
265 subtest
'renew_account' => sub {
268 for my $date ( '2016-03-31', '2016-11-30', '2019-01-31', dt_from_string
() ) {
269 my $dt = dt_from_string
( $date, 'iso' );
270 Time
::Fake
->offset( $dt->epoch );
271 my $a_month_ago = $dt->clone->subtract( months
=> 1, end_of_month
=> 'limit' )->truncate( to
=> 'day' );
272 my $a_year_later = $dt->clone->add( months
=> 12, end_of_month
=> 'limit' )->truncate( to
=> 'day' );
273 my $a_year_later_minus_a_month = $a_month_ago->clone->add( months
=> 12, end_of_month
=> 'limit' )->truncate( to
=> 'day' );
274 my $a_month_later = $dt->clone->add( months
=> 1 , end_of_month
=> 'limit' )->truncate( to
=> 'day' );
275 my $a_year_later_plus_a_month = $a_month_later->clone->add( months
=> 12, end_of_month
=> 'limit' )->truncate( to
=> 'day' );
276 my $patron_category = $builder->build(
277 { source
=> 'Category',
279 enrolmentperiod
=> 12,
280 enrolmentperioddate
=> undef,
284 my $patron = $builder->build(
285 { source
=> 'Borrower',
287 dateexpiry
=> $a_month_ago,
288 categorycode
=> $patron_category->{categorycode
},
289 date_renewed
=> undef, # Force builder to not populate the column for new patron
293 my $patron_2 = $builder->build(
294 { source
=> 'Borrower',
296 dateexpiry
=> $a_month_ago,
297 categorycode
=> $patron_category->{categorycode
},
301 my $patron_3 = $builder->build(
302 { source
=> 'Borrower',
304 dateexpiry
=> $a_month_later,
305 categorycode
=> $patron_category->{categorycode
},
309 my $retrieved_patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
310 my $retrieved_patron_2 = Koha
::Patrons
->find( $patron_2->{borrowernumber
} );
311 my $retrieved_patron_3 = Koha
::Patrons
->find( $patron_3->{borrowernumber
} );
313 is
( $retrieved_patron->date_renewed, undef, "Date renewed is not set for patrons that have never been renewed" );
315 t
::lib
::Mocks
::mock_preference
( 'BorrowerRenewalPeriodBase', 'dateexpiry' );
316 t
::lib
::Mocks
::mock_preference
( 'BorrowersLog', 1 );
317 my $expiry_date = $retrieved_patron->renew_account;
318 is
( $expiry_date, $a_year_later_minus_a_month, "$a_month_ago + 12 months must be $a_year_later_minus_a_month" );
319 my $retrieved_expiry_date = Koha
::Patrons
->find( $patron->{borrowernumber
} )->dateexpiry;
320 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" );
321 my $number_of_logs = $schema->resultset('ActionLog')->search( { module
=> 'MEMBERS', action
=> 'RENEW', object
=> $retrieved_patron->borrowernumber } )->count;
322 is
( $number_of_logs, 1, 'With BorrowerLogs, Koha::Patron->renew_account should have logged' );
324 t
::lib
::Mocks
::mock_preference
( 'BorrowerRenewalPeriodBase', 'now' );
325 t
::lib
::Mocks
::mock_preference
( 'BorrowersLog', 0 );
326 $expiry_date = $retrieved_patron->renew_account;
327 is
( $expiry_date, $a_year_later, "today + 12 months must be $a_year_later" );
328 $retrieved_patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
329 is
( $retrieved_patron->date_renewed, output_pref
({ dt
=> $dt, dateformat
=> 'iso', dateonly
=> 1 }), "Date renewed is set when calling renew_account" );
330 $retrieved_expiry_date = $retrieved_patron->dateexpiry;
331 is
( dt_from_string
($retrieved_expiry_date), $a_year_later, "today + 12 months must be $a_year_later" );
332 $number_of_logs = $schema->resultset('ActionLog')->search( { module
=> 'MEMBERS', action
=> 'RENEW', object
=> $retrieved_patron->borrowernumber } )->count;
333 is
( $number_of_logs, 1, 'Without BorrowerLogs, Koha::Patron->renew_account should not have logged' );
335 t
::lib
::Mocks
::mock_preference
( 'BorrowerRenewalPeriodBase', 'combination' );
336 $expiry_date = $retrieved_patron_2->renew_account;
337 is
( $expiry_date, $a_year_later, "today + 12 months must be $a_year_later" );
338 $retrieved_expiry_date = Koha
::Patrons
->find( $patron_2->{borrowernumber
} )->dateexpiry;
339 is
( dt_from_string
($retrieved_expiry_date), $a_year_later, "today + 12 months must be $a_year_later" );
341 $expiry_date = $retrieved_patron_3->renew_account;
342 is
( $expiry_date, $a_year_later_plus_a_month, "$a_month_later + 12 months must be $a_year_later_plus_a_month" );
343 $retrieved_expiry_date = Koha
::Patrons
->find( $patron_3->{borrowernumber
} )->dateexpiry;
344 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" );
346 $retrieved_patron->delete;
347 $retrieved_patron_2->delete;
348 $retrieved_patron_3->delete;
353 subtest
"move_to_deleted" => sub {
355 my $originally_updated_on = '2016-01-01 12:12:12';
356 my $patron = $builder->build( { source
=> 'Borrower',value
=> { updated_on
=> $originally_updated_on } } );
357 my $retrieved_patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
358 is
( ref( $retrieved_patron->move_to_deleted ), 'Koha::Schema::Result::Deletedborrower', 'Koha::Patron->move_to_deleted should return the Deleted patron' )
359 ; # FIXME This should be Koha::Deleted::Patron
360 my $deleted_patron = $schema->resultset('Deletedborrower')
361 ->search( { borrowernumber
=> $patron->{borrowernumber
} }, { result_class
=> 'DBIx::Class::ResultClass::HashRefInflator' } )
363 ok
( $retrieved_patron->updated_on, 'updated_on should be set for borrowers table' );
364 ok
( $deleted_patron->{updated_on
}, 'updated_on should be set for deleted_borrowers table' );
365 isnt
( $deleted_patron->{updated_on
}, $retrieved_patron->updated_on, 'Koha::Patron->move_to_deleted should have correctly updated the updated_on column');
366 $deleted_patron->{updated_on
} = $originally_updated_on; #reset for simplicity in comparing all other fields
367 is_deeply
( $deleted_patron, $patron, 'Koha::Patron->move_to_deleted should have correctly moved the patron to the deleted table' );
368 $retrieved_patron->delete( $patron->{borrowernumber
} ); # Cleanup
371 subtest
"delete" => sub {
373 t
::lib
::Mocks
::mock_preference
( 'BorrowersLog', 1 );
374 my $patron = $builder->build( { source
=> 'Borrower' } );
375 my $retrieved_patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
376 my $hold = $builder->build(
377 { source
=> 'Reserve',
378 value
=> { borrowernumber
=> $patron->{borrowernumber
} }
381 my $list = $builder->build(
382 { source
=> 'Virtualshelve',
383 value
=> { owner
=> $patron->{borrowernumber
} }
387 my $deleted = $retrieved_patron->delete;
388 is
( $deleted, 1, 'Koha::Patron->delete should return 1 if the patron has been correctly deleted' );
390 is
( Koha
::Patrons
->find( $patron->{borrowernumber
} ), undef, 'Koha::Patron->delete should have deleted the patron' );
392 is
( Koha
::Holds
->search( { borrowernumber
=> $patron->{borrowernumber
} } )->count, 0, q
|Koha
::Patron
->delete should have deleted patron
's holds| );
394 is( Koha::Virtualshelves->search( { owner => $patron->{borrowernumber} } )->count, 0, q|Koha::Patron->delete should have deleted patron's lists
| );
396 my $number_of_logs = $schema->resultset('ActionLog')->search( { module
=> 'MEMBERS', action
=> 'DELETE', object
=> $retrieved_patron->borrowernumber } )->count;
397 is
( $number_of_logs, 1, 'With BorrowerLogs, Koha::Patron->delete should have logged' );
400 subtest
'Koha::Patrons->delete' => sub {
403 my $mod_patron = Test
::MockModule
->new( 'Koha::Patron' );
404 my $moved_to_deleted = 0;
405 $mod_patron->mock( 'move_to_deleted', sub { $moved_to_deleted++; } );
407 my $patron1 = $builder->build_object({ class => 'Koha::Patrons' });
408 my $patron2 = $builder->build_object({ class => 'Koha::Patrons' });
409 my $id1 = $patron1->borrowernumber;
410 my $set = Koha
::Patrons
->search({ borrowernumber
=> { '>=' => $id1 }});
411 is
( $set->count, 2, 'Two patrons found as expected' );
412 is
( $set->delete({ move
=> 1 }), 2, 'Two patrons deleted' );
413 is
( $moved_to_deleted, 2, 'Patrons moved to deletedborrowers' );
415 # Add again, test if we can raise an exception
416 $mod_patron->mock( 'delete', sub { return -1; } );
417 $patron1 = $builder->build_object({ class => 'Koha::Patrons' });
418 $id1 = $patron1->borrowernumber;
419 $set = Koha
::Patrons
->search({ borrowernumber
=> { '>=' => $id1 }});
420 throws_ok
{ $set->delete } 'Koha::Exceptions::Patron::FailedDelete',
421 'Exception raised for deleting patron';
424 subtest
'add_enrolment_fee_if_needed' => sub {
427 my $enrolmentfees = { K
=> 5, J
=> 10, YA
=> 20 };
428 foreach( keys %{$enrolmentfees} ) {
429 ( Koha
::Patron
::Categories
->find( $_ ) // $builder->build_object({ class => 'Koha::Patron::Categories', value
=> { categorycode
=> $_ } }) )->enrolmentfee( $enrolmentfees->{$_} )->store;
431 my $enrolmentfee_K = $enrolmentfees->{K
};
432 my $enrolmentfee_J = $enrolmentfees->{J
};
433 my $enrolmentfee_YA = $enrolmentfees->{YA
};
435 my %borrower_data = (
436 firstname
=> 'my firstname',
437 surname
=> 'my surname',
439 branchcode
=> $library->{branchcode
},
442 my $borrowernumber = Koha
::Patron
->new(\
%borrower_data)->store->borrowernumber;
443 $borrower_data{borrowernumber
} = $borrowernumber;
445 my $patron = Koha
::Patrons
->find( $borrowernumber );
446 my $total = $patron->account->balance;
447 is
( int($total), int($enrolmentfee_K), "New kid pay $enrolmentfee_K" );
449 t
::lib
::Mocks
::mock_preference
( 'FeeOnChangePatronCategory', 0 );
450 $borrower_data{categorycode
} = 'J';
451 $patron->set(\
%borrower_data)->store;
452 $total = $patron->account->balance;
453 is
( int($total), int($enrolmentfee_K), "Kid growing and become a juvenile, but shouldn't pay for the upgrade " );
455 $borrower_data{categorycode
} = 'K';
456 $patron->set(\
%borrower_data)->store;
457 t
::lib
::Mocks
::mock_preference
( 'FeeOnChangePatronCategory', 1 );
459 $borrower_data{categorycode
} = 'J';
460 $patron->set(\
%borrower_data)->store;
461 $total = $patron->account->balance;
462 is
( int($total), int($enrolmentfee_K + $enrolmentfee_J), "Kid growing and become a juvenile, they should pay " . ( $enrolmentfee_K + $enrolmentfee_J ) );
464 # Check with calling directly Koha::Patron->get_enrolment_fee_if_needed
465 $patron->categorycode('YA')->store;
466 $total = $patron->account->balance;
468 int($enrolmentfee_K + $enrolmentfee_J + $enrolmentfee_YA),
469 "Juvenile growing and become an young adult, they should pay " . ( $enrolmentfee_K + $enrolmentfee_J + $enrolmentfee_YA )
475 subtest
'checkouts + pending_checkouts + get_overdues + old_checkouts' => sub {
478 my $library = $builder->build( { source
=> 'Branch' } );
479 my ($biblionumber_1) = AddBiblio
( MARC
::Record
->new, '' );
480 my $item_1 = $builder->build(
484 homebranch
=> $library->{branchcode
},
485 holdingbranch
=> $library->{branchcode
},
486 biblionumber
=> $biblionumber_1,
492 my $item_2 = $builder->build(
496 homebranch
=> $library->{branchcode
},
497 holdingbranch
=> $library->{branchcode
},
498 biblionumber
=> $biblionumber_1,
504 my ($biblionumber_2) = AddBiblio
( MARC
::Record
->new, '' );
505 my $item_3 = $builder->build(
509 homebranch
=> $library->{branchcode
},
510 holdingbranch
=> $library->{branchcode
},
511 biblionumber
=> $biblionumber_2,
517 my $patron = $builder->build(
519 source
=> 'Borrower',
520 value
=> { branchcode
=> $library->{branchcode
} }
524 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
525 my $checkouts = $patron->checkouts;
526 is
( $checkouts->count, 0, 'checkouts should not return any issues for that patron' );
527 is
( ref($checkouts), 'Koha::Checkouts', 'checkouts should return a Koha::Checkouts object' );
528 my $pending_checkouts = $patron->pending_checkouts;
529 is
( $pending_checkouts->count, 0, 'pending_checkouts should not return any issues for that patron' );
530 is
( ref($pending_checkouts), 'Koha::Checkouts', 'pending_checkouts should return a Koha::Checkouts object' );
531 my $old_checkouts = $patron->old_checkouts;
532 is
( $old_checkouts->count, 0, 'old_checkouts should not return any issues for that patron' );
533 is
( ref($old_checkouts), 'Koha::Old::Checkouts', 'old_checkouts should return a Koha::Old::Checkouts object' );
535 # Not sure how this is useful, but AddIssue pass this variable to different other subroutines
536 $patron = Koha
::Patrons
->find( $patron->borrowernumber )->unblessed;
538 t
::lib
::Mocks
::mock_userenv
({ branchcode
=> $library->{branchcode
} });
540 AddIssue
( $patron, $item_1->{barcode
}, DateTime
->now->subtract( days
=> 1 ) );
541 AddIssue
( $patron, $item_2->{barcode
}, DateTime
->now->subtract( days
=> 5 ) );
542 AddIssue
( $patron, $item_3->{barcode
} );
544 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
545 $checkouts = $patron->checkouts;
546 is
( $checkouts->count, 3, 'checkouts should return 3 issues for that patron' );
547 is
( ref($checkouts), 'Koha::Checkouts', 'checkouts should return a Koha::Checkouts object' );
548 $pending_checkouts = $patron->pending_checkouts;
549 is
( $pending_checkouts->count, 3, 'pending_checkouts should return 3 issues for that patron' );
550 is
( ref($pending_checkouts), 'Koha::Checkouts', 'pending_checkouts should return a Koha::Checkouts object' );
552 my $first_checkout = $pending_checkouts->next;
553 is
( $first_checkout->unblessed_all_relateds->{biblionumber
}, $item_3->{biblionumber
}, 'pending_checkouts should prefetch values from other tables (here biblio)' );
555 my $overdues = $patron->get_overdues;
556 is
( $overdues->count, 2, 'Patron should have 2 overdues');
557 is
( ref($overdues), 'Koha::Checkouts', 'Koha::Patron->get_overdues should return Koha::Checkouts' );
558 is
( $overdues->next->itemnumber, $item_1->{itemnumber
}, 'The issue should be returned in the same order as they have been done, first is correct' );
559 is
( $overdues->next->itemnumber, $item_2->{itemnumber
}, 'The issue should be returned in the same order as they have been done, second is correct' );
562 C4
::Circulation
::AddReturn
( $item_1->{barcode
} );
563 C4
::Circulation
::AddReturn
( $item_2->{barcode
} );
564 $old_checkouts = $patron->old_checkouts;
565 is
( $old_checkouts->count, 2, 'old_checkouts should return 2 old checkouts that patron' );
566 is
( ref($old_checkouts), 'Koha::Old::Checkouts', 'old_checkouts should return a Koha::Old::Checkouts object' );
569 Koha
::Checkouts
->search( { borrowernumber
=> $patron->borrowernumber } )->delete;
573 subtest
'get_routing_lists' => sub {
576 my $biblio = Koha
::Biblio
->new()->store();
577 my $subscription = Koha
::Subscription
->new({
578 biblionumber
=> $biblio->biblionumber,
582 my $patron = $builder->build( { source
=> 'Borrower' } );
583 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
585 is
( $patron->get_routing_lists->count, 0, 'Retrieves correct number of routing lists: 0' );
587 my $routinglist_count = Koha
::Subscription
::Routinglists
->count;
588 my $routinglist = Koha
::Subscription
::Routinglist
->new({
589 borrowernumber
=> $patron->borrowernumber,
591 subscriptionid
=> $subscription->subscriptionid
594 is
($patron->get_routing_lists->count, 1, "Retrieves correct number of routing lists: 1");
596 my $routinglists = $patron->get_routing_lists;
597 is
($routinglists->next->ranking, 5, "Retrieves ranking: 5");
598 is
( ref($routinglists), 'Koha::Subscription::Routinglists', 'get_routing_lists returns Koha::Subscription::Routinglists' );
600 my $subscription2 = Koha
::Subscription
->new({
601 biblionumber
=> $biblio->biblionumber,
604 my $routinglist2 = Koha
::Subscription
::Routinglist
->new({
605 borrowernumber
=> $patron->borrowernumber,
607 subscriptionid
=> $subscription2->subscriptionid
610 is
($patron->get_routing_lists->count, 2, "Retrieves correct number of routing lists: 2");
612 $patron->delete; # Clean up for later tests
616 subtest
'get_age' => sub {
619 my $patron = $builder->build( { source
=> 'Borrower' } );
620 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
622 my $today = dt_from_string
;
624 $patron->dateofbirth( undef );
625 is
( $patron->get_age, undef, 'get_age should return undef if no dateofbirth is defined' );
626 $patron->dateofbirth( $today->clone->add( years
=> -12, months
=> -6, days
=> -1, end_of_month
=> 'limit' ) );
627 is
( $patron->get_age, 12, 'Patron should be 12' );
628 $patron->dateofbirth( $today->clone->add( years
=> -18, months
=> 0, days
=> 1, end_of_month
=> 'limit' ) );
629 is
( $patron->get_age, 17, 'Patron should be 17, happy birthday tomorrow!' );
630 $patron->dateofbirth( $today->clone->add( years
=> -18, months
=> 0, days
=> 0, end_of_month
=> 'limit' ) );
631 is
( $patron->get_age, 18, 'Patron should be 18' );
632 $patron->dateofbirth( $today->clone->add( years
=> -18, months
=> -12, days
=> -31, end_of_month
=> 'limit' ) );
633 is
( $patron->get_age, 19, 'Patron should be 19' );
634 $patron->dateofbirth( $today->clone->add( years
=> -18, months
=> -12, days
=> -30, end_of_month
=> 'limit' ) );
635 is
( $patron->get_age, 19, 'Patron should be 19 again' );
636 $patron->dateofbirth( $today->clone->add( years
=> 0, months
=> -1, days
=> -1, end_of_month
=> 'limit' ) );
637 is
( $patron->get_age, 0, 'Patron is a newborn child' );
642 subtest
'account' => sub {
645 my $patron = $builder->build({source
=> 'Borrower'});
647 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
648 my $account = $patron->account;
649 is
( ref($account), 'Koha::Account', 'account should return a Koha::Account object' );
654 subtest
'search_upcoming_membership_expires' => sub {
657 my $expiry_days = 15;
658 t
::lib
::Mocks
::mock_preference
( 'MembershipExpiryDaysNotice', $expiry_days );
659 my $nb_of_days_before = 1;
660 my $nb_of_days_after = 2;
662 my $builder = t
::lib
::TestBuilder
->new();
664 my $library = $builder->build({ source
=> 'Branch' });
666 # before we add borrowers to this branch, add the expires we have now
667 # note that this pertains to the current mocked setting of the pref
668 # for this reason we add the new branchcode to most of the tests
669 my $nb_of_expires = Koha
::Patrons
->search_upcoming_membership_expires->count;
671 my $patron_1 = $builder->build({
672 source
=> 'Borrower',
674 branchcode
=> $library->{branchcode
},
675 dateexpiry
=> dt_from_string
->add( days
=> $expiry_days )
679 my $patron_2 = $builder->build({
680 source
=> 'Borrower',
682 branchcode
=> $library->{branchcode
},
683 dateexpiry
=> dt_from_string
->add( days
=> $expiry_days - $nb_of_days_before )
687 my $patron_3 = $builder->build({
688 source
=> 'Borrower',
690 branchcode
=> $library->{branchcode
},
691 dateexpiry
=> dt_from_string
->add( days
=> $expiry_days + $nb_of_days_after )
695 # Test without extra parameters
696 my $upcoming_mem_expires = Koha
::Patrons
->search_upcoming_membership_expires();
697 is
( $upcoming_mem_expires->count, $nb_of_expires + 1, 'Get upcoming membership expires should return one new borrower.' );
700 $upcoming_mem_expires = Koha
::Patrons
->search_upcoming_membership_expires({ 'me.branchcode' => $library->{branchcode
} });
701 is
( $upcoming_mem_expires->count, 1, 'Test with branch parameter' );
702 my $expired = $upcoming_mem_expires->next;
703 is
( $expired->surname, $patron_1->{surname
}, 'Get upcoming membership expires should return the correct patron.' );
704 is
( $expired->library->branchemail, $library->{branchemail
}, 'Get upcoming membership expires should return the correct patron.' );
705 is
( $expired->branchcode, $patron_1->{branchcode
}, 'Get upcoming membership expires should return the correct patron.' );
707 t
::lib
::Mocks
::mock_preference
( 'MembershipExpiryDaysNotice', 0 );
708 $upcoming_mem_expires = Koha
::Patrons
->search_upcoming_membership_expires({ 'me.branchcode' => $library->{branchcode
} });
709 is
( $upcoming_mem_expires->count, 0, 'Get upcoming membership expires with MembershipExpiryDaysNotice==0 should not return new records.' );
711 # Test MembershipExpiryDaysNotice == undef
712 t
::lib
::Mocks
::mock_preference
( 'MembershipExpiryDaysNotice', undef );
713 $upcoming_mem_expires = Koha
::Patrons
->search_upcoming_membership_expires({ 'me.branchcode' => $library->{branchcode
} });
714 is
( $upcoming_mem_expires->count, 0, 'Get upcoming membership expires without MembershipExpiryDaysNotice should not return new records.' );
716 # Test the before parameter
717 t
::lib
::Mocks
::mock_preference
( 'MembershipExpiryDaysNotice', 15 );
718 $upcoming_mem_expires = Koha
::Patrons
->search_upcoming_membership_expires({ 'me.branchcode' => $library->{branchcode
}, before
=> $nb_of_days_before });
719 is
( $upcoming_mem_expires->count, 2, 'Expect two results for before');
720 # Test after parameter also
721 $upcoming_mem_expires = Koha
::Patrons
->search_upcoming_membership_expires({ 'me.branchcode' => $library->{branchcode
}, before
=> $nb_of_days_before, after
=> $nb_of_days_after });
722 is
( $upcoming_mem_expires->count, 3, 'Expect three results when adding after' );
723 Koha
::Patrons
->search({ borrowernumber
=> { in => [ $patron_1->{borrowernumber
}, $patron_2->{borrowernumber
}, $patron_3->{borrowernumber
} ] } })->delete;
726 subtest
'holds and old_holds' => sub {
729 my $library = $builder->build( { source
=> 'Branch' } );
730 my ($biblionumber_1) = AddBiblio
( MARC
::Record
->new, '' );
731 my $item_1 = $builder->build(
735 homebranch
=> $library->{branchcode
},
736 holdingbranch
=> $library->{branchcode
},
737 biblionumber
=> $biblionumber_1
741 my $item_2 = $builder->build(
745 homebranch
=> $library->{branchcode
},
746 holdingbranch
=> $library->{branchcode
},
747 biblionumber
=> $biblionumber_1
751 my ($biblionumber_2) = AddBiblio
( MARC
::Record
->new, '' );
752 my $item_3 = $builder->build(
756 homebranch
=> $library->{branchcode
},
757 holdingbranch
=> $library->{branchcode
},
758 biblionumber
=> $biblionumber_2
762 my $patron = $builder->build(
764 source
=> 'Borrower',
765 value
=> { branchcode
=> $library->{branchcode
} }
769 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
770 my $holds = $patron->holds;
771 is
( ref($holds), 'Koha::Holds',
772 'Koha::Patron->holds should return a Koha::Holds objects' );
773 is
( $holds->count, 0, 'There should not be holds placed by this patron yet' );
775 C4
::Reserves
::AddReserve
( $library->{branchcode
},
776 $patron->borrowernumber, $biblionumber_1 );
778 C4
::Reserves
::AddReserve
( $library->{branchcode
},
779 $patron->borrowernumber, $biblionumber_2, undef, undef, dt_from_string
->add( days
=> 2 ) );
781 $holds = $patron->holds;
782 is
( $holds->count, 2, 'There should be 2 holds placed by this patron' );
784 my $old_holds = $patron->old_holds;
785 is
( ref($old_holds), 'Koha::Old::Holds',
786 'Koha::Patron->old_holds should return a Koha::Old::Holds objects' );
787 is
( $old_holds->count, 0, 'There should not be any old holds yet');
789 my $hold = $holds->next;
792 $old_holds = $patron->old_holds;
793 is
( $old_holds->count, 1, 'There should be 1 old (cancelled) hold');
800 subtest
'notice_email_address' => sub {
803 my $patron = $builder->build_object({ class => 'Koha::Patrons' });
805 t
::lib
::Mocks
::mock_preference
( 'AutoEmailPrimaryAddress', 'OFF' );
806 is
($patron->notice_email_address, $patron->email, "Koha::Patron->notice_email_address returns correct value when AutoEmailPrimaryAddress is off");
808 t
::lib
::Mocks
::mock_preference
( 'AutoEmailPrimaryAddress', 'emailpro' );
809 is
($patron->notice_email_address, $patron->emailpro, "Koha::Patron->notice_email_address returns correct value when AutoEmailPrimaryAddress is emailpro");
814 subtest
'search_patrons_to_anonymise & anonymise_issue_history' => sub {
817 # TODO create a subroutine in t::lib::Mocks
818 my $branch = $builder->build({ source
=> 'Branch' });
819 my $userenv_patron = $builder->build_object({
820 class => 'Koha::Patrons',
821 value
=> { branchcode
=> $branch->{branchcode
}, flags
=> 0 },
823 t
::lib
::Mocks
::mock_userenv
({ patron
=> $userenv_patron });
825 my $anonymous = $builder->build( { source
=> 'Borrower', }, );
827 t
::lib
::Mocks
::mock_preference
( 'AnonymousPatron', $anonymous->{borrowernumber
} );
829 subtest
'patron privacy is 1 (default)' => sub {
832 t
::lib
::Mocks
::mock_preference
('IndependentBranches', 0);
833 my $patron = $builder->build(
834 { source
=> 'Borrower',
835 value
=> { privacy
=> 1, }
838 my $item_1 = $builder->build(
846 my $issue_1 = $builder->build(
849 borrowernumber
=> $patron->{borrowernumber
},
850 itemnumber
=> $item_1->{itemnumber
},
854 my $item_2 = $builder->build(
862 my $issue_2 = $builder->build(
865 borrowernumber
=> $patron->{borrowernumber
},
866 itemnumber
=> $item_2->{itemnumber
},
871 my ( $returned_1, undef, undef ) = C4
::Circulation
::AddReturn
( $item_1->{barcode
}, undef, undef, dt_from_string
('2010-10-10') );
872 my ( $returned_2, undef, undef ) = C4
::Circulation
::AddReturn
( $item_2->{barcode
}, undef, undef, dt_from_string
('2011-11-11') );
873 is
( $returned_1 && $returned_2, 1, 'The items should have been returned' );
875 my $patrons_to_anonymise = Koha
::Patrons
->search_patrons_to_anonymise( { before
=> '2010-10-11' } )->search( { 'me.borrowernumber' => $patron->{borrowernumber
} } );
876 is
( ref($patrons_to_anonymise), 'Koha::Patrons', 'search_patrons_to_anonymise should return Koha::Patrons' );
878 my $rows_affected = Koha
::Patrons
->search_patrons_to_anonymise( { before
=> '2011-11-12' } )->anonymise_issue_history( { before
=> '2010-10-11' } );
879 ok
( $rows_affected > 0, 'AnonymiseIssueHistory should affect at least 1 row' );
881 my $dbh = C4
::Context
->dbh;
882 my $sth = $dbh->prepare(q
|SELECT borrowernumber FROM old_issues where itemnumber
= ?
|);
883 $sth->execute($item_1->{itemnumber
});
884 my ($borrowernumber_used_to_anonymised) = $sth->fetchrow_array;
885 is
( $borrowernumber_used_to_anonymised, $anonymous->{borrowernumber
}, 'With privacy=1, the issue should have been anonymised' );
886 $sth->execute($item_2->{itemnumber
});
887 ($borrowernumber_used_to_anonymised) = $sth->fetchrow_array;
888 is
( $borrowernumber_used_to_anonymised, $patron->{borrowernumber
}, 'The issue should not have been anonymised, the returned date is later' );
890 $rows_affected = Koha
::Patrons
->search_patrons_to_anonymise( { before
=> '2011-11-12' } )->anonymise_issue_history;
891 $sth->execute($item_2->{itemnumber
});
892 ($borrowernumber_used_to_anonymised) = $sth->fetchrow_array;
893 is
( $borrowernumber_used_to_anonymised, $anonymous->{borrowernumber
}, 'The issue should have been anonymised, the returned date is before' );
895 my $sth_reset = $dbh->prepare(q
|UPDATE old_issues SET borrowernumber
= ? WHERE itemnumber
= ?
|);
896 $sth_reset->execute( $patron->{borrowernumber
}, $item_1->{itemnumber
} );
897 $sth_reset->execute( $patron->{borrowernumber
}, $item_2->{itemnumber
} );
898 $rows_affected = Koha
::Patrons
->search_patrons_to_anonymise->anonymise_issue_history;
899 $sth->execute($item_1->{itemnumber
});
900 ($borrowernumber_used_to_anonymised) = $sth->fetchrow_array;
901 is
( $borrowernumber_used_to_anonymised, $anonymous->{borrowernumber
}, 'The issue 1 should have been anonymised, before parameter was not passed' );
902 $sth->execute($item_2->{itemnumber
});
903 ($borrowernumber_used_to_anonymised) = $sth->fetchrow_array;
904 is
( $borrowernumber_used_to_anonymised, $anonymous->{borrowernumber
}, 'The issue 2 should have been anonymised, before parameter was not passed' );
906 Koha
::Patrons
->find( $patron->{borrowernumber
})->delete;
909 subtest
'patron privacy is 0 (forever)' => sub {
912 t
::lib
::Mocks
::mock_preference
('IndependentBranches', 0);
913 my $patron = $builder->build(
914 { source
=> 'Borrower',
915 value
=> { privacy
=> 0, }
918 my $item = $builder->build(
926 my $issue = $builder->build(
929 borrowernumber
=> $patron->{borrowernumber
},
930 itemnumber
=> $item->{itemnumber
},
935 my ( $returned, undef, undef ) = C4
::Circulation
::AddReturn
( $item->{barcode
}, undef, undef, dt_from_string
('2010-10-10') );
936 is
( $returned, 1, 'The item should have been returned' );
937 my $rows_affected = Koha
::Patrons
->search_patrons_to_anonymise( { before
=> '2010-10-11' } )->anonymise_issue_history( { before
=> '2010-10-11' } );
938 ok
( $rows_affected > 0, 'AnonymiseIssueHistory should not return any error if success' );
940 my $dbh = C4
::Context
->dbh;
941 my ($borrowernumber_used_to_anonymised) = $dbh->selectrow_array(q
|
942 SELECT borrowernumber FROM old_issues where itemnumber
= ?
943 |, undef, $item->{itemnumber
});
944 is
( $borrowernumber_used_to_anonymised, $patron->{borrowernumber
}, 'With privacy=0, the issue should not be anonymised' );
945 Koha
::Patrons
->find( $patron->{borrowernumber
})->delete;
948 t
::lib
::Mocks
::mock_preference
( 'AnonymousPatron', '' );
950 subtest
'AnonymousPatron is not defined' => sub {
953 t
::lib
::Mocks
::mock_preference
('IndependentBranches', 0);
954 my $patron = $builder->build(
955 { source
=> 'Borrower',
956 value
=> { privacy
=> 1, }
959 my $item = $builder->build(
967 my $issue = $builder->build(
970 borrowernumber
=> $patron->{borrowernumber
},
971 itemnumber
=> $item->{itemnumber
},
976 my ( $returned, undef, undef ) = C4
::Circulation
::AddReturn
( $item->{barcode
}, undef, undef, dt_from_string
('2010-10-10') );
977 is
( $returned, 1, 'The item should have been returned' );
978 my $rows_affected = Koha
::Patrons
->search_patrons_to_anonymise( { before
=> '2010-10-11' } )->anonymise_issue_history( { before
=> '2010-10-11' } );
979 ok
( $rows_affected > 0, 'AnonymiseIssueHistory should affect at least 1 row' );
981 my $dbh = C4
::Context
->dbh;
982 my ($borrowernumber_used_to_anonymised) = $dbh->selectrow_array(q
|
983 SELECT borrowernumber FROM old_issues where itemnumber
= ?
984 |, undef, $item->{itemnumber
});
985 is
( $borrowernumber_used_to_anonymised, undef, 'With AnonymousPatron is not defined, the issue should have been anonymised anyway' );
986 Koha
::Patrons
->find( $patron->{borrowernumber
})->delete;
989 subtest
'Logged in librarian is not superlibrarian & IndependentBranches' => sub {
991 t
::lib
::Mocks
::mock_preference
( 'IndependentBranches', 1 );
992 my $patron = $builder->build(
993 { source
=> 'Borrower',
994 value
=> { privacy
=> 1 } # Another branchcode than the logged in librarian
997 my $item = $builder->build(
1005 my $issue = $builder->build(
1006 { source
=> 'Issue',
1008 borrowernumber
=> $patron->{borrowernumber
},
1009 itemnumber
=> $item->{itemnumber
},
1014 my ( $returned, undef, undef ) = C4
::Circulation
::AddReturn
( $item->{barcode
}, undef, undef, dt_from_string
('2010-10-10') );
1015 is
( Koha
::Patrons
->search_patrons_to_anonymise( { before
=> '2010-10-11' } )->count, 0 );
1016 Koha
::Patrons
->find( $patron->{borrowernumber
})->delete;
1019 Koha
::Patrons
->find( $anonymous->{borrowernumber
})->delete;
1020 $userenv_patron->delete;
1022 # Reset IndependentBranches for further tests
1023 t
::lib
::Mocks
::mock_preference
('IndependentBranches', 0);
1026 subtest
'libraries_where_can_see_patrons + can_see_patron_infos + search_limited' => sub {
1034 $nb_of_patrons = Koha
::Patrons
->search->count;
1035 my $group_1 = Koha
::Library
::Group
->new( { title
=> 'TEST Group 1', ft_hide_patron_info
=> 1 } )->store;
1036 my $group_2 = Koha
::Library
::Group
->new( { title
=> 'TEST Group 2', ft_hide_patron_info
=> 1 } )->store;
1037 my $library_11 = $builder->build( { source
=> 'Branch' } );
1038 my $library_12 = $builder->build( { source
=> 'Branch' } );
1039 my $library_21 = $builder->build( { source
=> 'Branch' } );
1040 $library_11 = Koha
::Libraries
->find( $library_11->{branchcode
} );
1041 $library_12 = Koha
::Libraries
->find( $library_12->{branchcode
} );
1042 $library_21 = Koha
::Libraries
->find( $library_21->{branchcode
} );
1043 Koha
::Library
::Group
->new(
1044 { branchcode
=> $library_11->branchcode, parent_id
=> $group_1->id } )->store;
1045 Koha
::Library
::Group
->new(
1046 { branchcode
=> $library_12->branchcode, parent_id
=> $group_1->id } )->store;
1047 Koha
::Library
::Group
->new(
1048 { branchcode
=> $library_21->branchcode, parent_id
=> $group_2->id } )->store;
1050 my $sth = C4
::Context
->dbh->prepare(q
|INSERT INTO user_permissions
( borrowernumber
, module_bit
, code
) VALUES
(?
, 4, ?
)|); # 4 for borrowers
1051 # 2 patrons from library_11 (group1)
1052 # patron_11_1 see patron's infos from outside its group
1053 # Setting flags => undef to not be considered as superlibrarian
1054 my $patron_11_1 = $builder->build({ source
=> 'Borrower', value
=> { branchcode
=> $library_11->branchcode, flags
=> undef, }});
1055 $patron_11_1 = Koha
::Patrons
->find( $patron_11_1->{borrowernumber
} );
1056 $sth->execute( $patron_11_1->borrowernumber, 'edit_borrowers' );
1057 $sth->execute( $patron_11_1->borrowernumber, 'view_borrower_infos_from_any_libraries' );
1058 # patron_11_2 can only see patron's info from its group
1059 my $patron_11_2 = $builder->build({ source
=> 'Borrower', value
=> { branchcode
=> $library_11->branchcode, flags
=> undef, }});
1060 $patron_11_2 = Koha
::Patrons
->find( $patron_11_2->{borrowernumber
} );
1061 $sth->execute( $patron_11_2->borrowernumber, 'edit_borrowers' );
1062 # 1 patron from library_12 (group1)
1063 my $patron_12 = $builder->build({ source
=> 'Borrower', value
=> { branchcode
=> $library_12->branchcode, flags
=> undef, }});
1064 $patron_12 = Koha
::Patrons
->find( $patron_12->{borrowernumber
} );
1065 # 1 patron from library_21 (group2) can only see patron's info from its group
1066 my $patron_21 = $builder->build({ source
=> 'Borrower', value
=> { branchcode
=> $library_21->branchcode, flags
=> undef, }});
1067 $patron_21 = Koha
::Patrons
->find( $patron_21->{borrowernumber
} );
1068 $sth->execute( $patron_21->borrowernumber, 'edit_borrowers' );
1070 # Pfiou, we can start now!
1071 subtest
'libraries_where_can_see_patrons' => sub {
1076 t
::lib
::Mocks
::mock_userenv
({ patron
=> $patron_11_1 });
1077 @branchcodes = $patron_11_1->libraries_where_can_see_patrons;
1078 is_deeply
( \
@branchcodes, [], q
|patron_11_1 has view_borrower_infos_from_any_libraries
=> No restriction
| );
1080 t
::lib
::Mocks
::mock_userenv
({ patron
=> $patron_11_2 });
1081 @branchcodes = $patron_11_2->libraries_where_can_see_patrons;
1082 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| );
1084 t::lib::Mocks::mock_userenv({ patron => $patron_21 });
1085 @branchcodes = $patron_21->libraries_where_can_see_patrons;
1086 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
| );
1088 subtest
'can_see_patron_infos' => sub {
1091 t
::lib
::Mocks
::mock_userenv
({ patron
=> $patron_11_1 });
1092 is
( $patron_11_1->can_see_patron_infos( $patron_11_2 ), 1, q
|patron_11_1 can see patron_11_2
, from its library
| );
1093 is
( $patron_11_1->can_see_patron_infos( $patron_12 ), 1, q
|patron_11_1 can see patron_12
, from its group
| );
1094 is
( $patron_11_1->can_see_patron_infos( $patron_21 ), 1, q
|patron_11_1 can see patron_11_2
, from another group
| );
1096 t
::lib
::Mocks
::mock_userenv
({ patron
=> $patron_11_2 });
1097 is
( $patron_11_2->can_see_patron_infos( $patron_11_1 ), 1, q
|patron_11_2 can see patron_11_1
, from its library
| );
1098 is
( $patron_11_2->can_see_patron_infos( $patron_12 ), 1, q
|patron_11_2 can see patron_12
, from its group
| );
1099 is
( $patron_11_2->can_see_patron_infos( $patron_21 ), 0, q
|patron_11_2 can NOT see patron_21
, from another group
| );
1101 subtest
'search_limited' => sub {
1104 t
::lib
::Mocks
::mock_userenv
({ patron
=> $patron_11_1 });
1105 my $total_number_of_patrons = $nb_of_patrons + 4; #we added four in these tests
1106 is
( Koha
::Patrons
->search->count, $total_number_of_patrons, 'Non-limited search should return all patrons' );
1107 is
( Koha
::Patrons
->search_limited->count, $total_number_of_patrons, 'patron_11_1 is allowed to see all patrons' );
1109 t
::lib
::Mocks
::mock_userenv
({ patron
=> $patron_11_2 });
1110 is
( Koha
::Patrons
->search->count, $total_number_of_patrons, 'Non-limited search should return all patrons');
1111 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' );
1113 t
::lib
::Mocks
::mock_userenv
({ patron
=> $patron_21 });
1114 is
( Koha
::Patrons
->search->count, $total_number_of_patrons, 'Non-limited search should return all patrons');
1115 is
( Koha
::Patrons
->search_limited->count, 1, 'patron_21 is not allowed to see patrons from other groups, only himself' );
1117 $patron_11_1->delete;
1118 $patron_11_2->delete;
1123 subtest
'account_locked' => sub {
1125 my $patron = $builder->build({ source
=> 'Borrower', value
=> { login_attempts
=> 0 } });
1126 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
1127 for my $value ( undef, '', 0 ) {
1128 t
::lib
::Mocks
::mock_preference
('FailedloginAttempts', $value);
1129 is
( $patron->account_locked, 0, 'Feature is disabled, patron account should not be considered locked' );
1130 $patron->login_attempts(1)->store;
1131 is
( $patron->account_locked, 0, 'Feature is disabled, patron account should not be considered locked' );
1134 t
::lib
::Mocks
::mock_preference
('FailedloginAttempts', 3);
1135 $patron->login_attempts(2)->store;
1136 is
( $patron->account_locked, 0, 'Patron has 2 failed attempts, account should not be considered locked yet' );
1137 $patron->login_attempts(3)->store;
1138 is
( $patron->account_locked, 1, 'Patron has 3 failed attempts, account should be considered locked yet' );
1143 subtest
'is_child | is_adult' => sub {
1145 my $category = $builder->build_object(
1147 class => 'Koha::Patron::Categories',
1148 value
=> { category_type
=> 'A' }
1151 my $patron_adult = $builder->build_object(
1153 class => 'Koha::Patrons',
1154 value
=> { categorycode
=> $category->categorycode }
1157 $category = $builder->build_object(
1159 class => 'Koha::Patron::Categories',
1160 value
=> { category_type
=> 'I' }
1163 my $patron_adult_i = $builder->build_object(
1165 class => 'Koha::Patrons',
1166 value
=> { categorycode
=> $category->categorycode }
1169 $category = $builder->build_object(
1171 class => 'Koha::Patron::Categories',
1172 value
=> { category_type
=> 'C' }
1175 my $patron_child = $builder->build_object(
1177 class => 'Koha::Patrons',
1178 value
=> { categorycode
=> $category->categorycode }
1181 $category = $builder->build_object(
1183 class => 'Koha::Patron::Categories',
1184 value
=> { category_type
=> 'O' }
1187 my $patron_other = $builder->build_object(
1189 class => 'Koha::Patrons',
1190 value
=> { categorycode
=> $category->categorycode }
1193 is
( $patron_adult->is_adult, 1, 'Patron from category A should be considered adult' );
1194 is
( $patron_adult_i->is_adult, 1, 'Patron from category I should be considered adult' );
1195 is
( $patron_child->is_adult, 0, 'Patron from category C should not be considered adult' );
1196 is
( $patron_other->is_adult, 0, 'Patron from category O should not be considered adult' );
1198 is
( $patron_adult->is_child, 0, 'Patron from category A should be considered child' );
1199 is
( $patron_adult_i->is_child, 0, 'Patron from category I should be considered child' );
1200 is
( $patron_child->is_child, 1, 'Patron from category C should not be considered child' );
1201 is
( $patron_other->is_child, 0, 'Patron from category O should not be considered child' );
1204 $patron_adult->delete;
1205 $patron_adult_i->delete;
1206 $patron_child->delete;
1207 $patron_other->delete;
1210 subtest
'get_overdues' => sub {
1213 my $library = $builder->build( { source
=> 'Branch' } );
1214 my ($biblionumber_1) = AddBiblio
( MARC
::Record
->new, '' );
1215 my $item_1 = $builder->build(
1219 homebranch
=> $library->{branchcode
},
1220 holdingbranch
=> $library->{branchcode
},
1221 biblionumber
=> $biblionumber_1
1225 my $item_2 = $builder->build(
1229 homebranch
=> $library->{branchcode
},
1230 holdingbranch
=> $library->{branchcode
},
1231 biblionumber
=> $biblionumber_1
1235 my ($biblionumber_2) = AddBiblio
( MARC
::Record
->new, '' );
1236 my $item_3 = $builder->build(
1240 homebranch
=> $library->{branchcode
},
1241 holdingbranch
=> $library->{branchcode
},
1242 biblionumber
=> $biblionumber_2
1246 my $patron = $builder->build(
1248 source
=> 'Borrower',
1249 value
=> { branchcode
=> $library->{branchcode
} }
1253 t
::lib
::Mocks
::mock_preference
({ branchcode
=> $library->{branchcode
} });
1255 AddIssue
( $patron, $item_1->{barcode
}, DateTime
->now->subtract( days
=> 1 ) );
1256 AddIssue
( $patron, $item_2->{barcode
}, DateTime
->now->subtract( days
=> 5 ) );
1257 AddIssue
( $patron, $item_3->{barcode
} );
1259 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
1260 my $overdues = $patron->get_overdues;
1261 is
( $overdues->count, 2, 'Patron should have 2 overdues');
1262 is
( $overdues->next->itemnumber, $item_1->{itemnumber
}, 'The issue should be returned in the same order as they have been done, first is correct' );
1263 is
( $overdues->next->itemnumber, $item_2->{itemnumber
}, 'The issue should be returned in the same order as they have been done, second is correct' );
1265 my $o = $overdues->reset->next;
1266 my $unblessed_overdue = $o->unblessed_all_relateds;
1267 is
( exists( $unblessed_overdue->{issuedate
} ), 1, 'Fields from the issues table should be filled' );
1268 is
( exists( $unblessed_overdue->{itemcallnumber
} ), 1, 'Fields from the items table should be filled' );
1269 is
( exists( $unblessed_overdue->{title
} ), 1, 'Fields from the biblio table should be filled' );
1270 is
( exists( $unblessed_overdue->{itemtype
} ), 1, 'Fields from the biblioitems table should be filled' );
1273 $patron->checkouts->delete;
1277 subtest
'userid_is_valid' => sub {
1280 my $library = $builder->build_object( { class => 'Koha::Libraries' } );
1281 my $patron_category = $builder->build_object(
1283 class => 'Koha::Patron::Categories',
1284 value
=> { category_type
=> 'P', enrolmentfee
=> 0 }
1288 cardnumber
=> "123456789",
1289 firstname
=> "Tomasito",
1291 categorycode
=> $patron_category->categorycode,
1292 branchcode
=> $library->branchcode,
1295 my $expected_userid_patron_1 = 'tomasito.none';
1296 my $borrowernumber = Koha
::Patron
->new(\
%data)->store->borrowernumber;
1297 my $patron_1 = Koha
::Patrons
->find($borrowernumber);
1298 is
( $patron_1->has_valid_userid, 1, "Should be valid when compared against them self" );
1299 is
( $patron_1->userid, $expected_userid_patron_1, 'The userid generated should be the one we expect' );
1301 $patron_1->userid( 'tomasito.non' );
1302 is
( $patron_1->has_valid_userid, # FIXME Joubu: What is the difference with the next test?
1303 1, 'recently created userid -> unique (borrowernumber passed)' );
1305 $patron_1->userid( 'tomasitoxxx' );
1306 is
( $patron_1->has_valid_userid,
1307 1, 'non-existent userid -> unique (borrowernumber passed)' );
1308 $patron_1->discard_changes; # We compare with the original userid later
1310 my $patron_not_in_storage = Koha
::Patron
->new( { userid
=> '' } );
1311 is
( $patron_not_in_storage->has_valid_userid,
1312 0, 'userid exists for another patron, patron is not in storage yet' );
1314 $patron_not_in_storage = Koha
::Patron
->new( { userid
=> 'tomasitoxxx' } );
1315 is
( $patron_not_in_storage->has_valid_userid,
1316 1, 'non-existent userid, patron is not in storage yet' );
1318 # Regression tests for BZ12226
1319 my $db_patron = Koha
::Patron
->new( { userid
=> C4
::Context
->config('user') } );
1320 is
( $db_patron->has_valid_userid,
1321 0, 'Koha::Patron->has_valid_userid should return 0 for the DB user (Bug 12226)' );
1323 # Add a new borrower with the same userid but different cardnumber
1324 $data{cardnumber
} = "987654321";
1325 my $new_borrowernumber = Koha
::Patron
->new(\
%data)->store->borrowernumber;
1326 my $patron_2 = Koha
::Patrons
->find($new_borrowernumber);
1327 $patron_2->userid($patron_1->userid);
1328 is
( $patron_2->has_valid_userid,
1329 0, 'The userid is already in used, it cannot be used for another patron' );
1331 my $new_userid = 'a_user_id';
1332 $data{cardnumber
} = "234567890";
1333 $data{userid
} = 'a_user_id';
1334 $borrowernumber = Koha
::Patron
->new(\
%data)->store->borrowernumber;
1335 my $patron_3 = Koha
::Patrons
->find($borrowernumber);
1336 is
( $patron_3->userid, $new_userid,
1337 'Koha::Patron->store should insert the given userid' );
1345 subtest
'generate_userid' => sub {
1348 my $library = $builder->build_object( { class => 'Koha::Libraries' } );
1349 my $patron_category = $builder->build_object(
1351 class => 'Koha::Patron::Categories',
1352 value
=> { category_type
=> 'P', enrolmentfee
=> 0 }
1356 cardnumber
=> "123456789",
1357 firstname
=> "Tomasito",
1359 categorycode
=> $patron_category->categorycode,
1360 branchcode
=> $library->branchcode,
1363 my $expected_userid_patron_1 = 'tomasito.none';
1364 my $new_patron = Koha
::Patron
->new({ firstname
=> $data{firstname
}, surname
=> $data{surname
} } );
1365 $new_patron->generate_userid;
1366 my $userid = $new_patron->userid;
1367 is
( $userid, $expected_userid_patron_1, 'generate_userid should generate the userid we expect' );
1368 my $borrowernumber = Koha
::Patron
->new(\
%data)->store->borrowernumber;
1369 my $patron_1 = Koha
::Patrons
->find($borrowernumber);
1370 is
( $patron_1->userid, $expected_userid_patron_1, 'The userid generated should be the one we expect' );
1372 $new_patron->generate_userid;
1373 $userid = $new_patron->userid;
1374 is
( $userid, $expected_userid_patron_1 . '1', 'generate_userid should generate the userid we expect' );
1375 $data{cardnumber
} = '987654321';
1376 my $new_borrowernumber = Koha
::Patron
->new(\
%data)->store->borrowernumber;
1377 my $patron_2 = Koha
::Patrons
->find($new_borrowernumber);
1378 isnt
( $patron_2->userid, 'tomasito',
1379 "Patron with duplicate userid has new userid generated" );
1380 is
( $patron_2->userid, $expected_userid_patron_1 . '1', # TODO we could make that configurable
1381 "Patron with duplicate userid has new userid generated (1 is appened" );
1383 $new_patron->generate_userid;
1384 $userid = $new_patron->userid;
1385 is
( $userid, $expected_userid_patron_1 . '2', 'generate_userid should generate the userid we expect' );
1387 $patron_1 = Koha
::Patrons
->find($borrowernumber);
1388 $patron_1->userid(undef);
1389 $patron_1->generate_userid;
1390 $userid = $patron_1->userid;
1391 is
( $userid, $expected_userid_patron_1, 'generate_userid should generate the userid we expect' );
1398 subtest
'attributes' => sub {
1401 my $library1 = Koha
::Library
->new({
1402 branchcode
=> 'LIBPATRON',
1403 branchname
=> 'Library of testing patron',
1406 my $library2 = Koha
::Library
->new({
1407 branchcode
=> 'LIBATTR',
1408 branchname
=> 'Library for testing attribute',
1411 my $category = Koha
::Patron
::Category
->new({
1412 categorycode
=> 'CAT1',
1413 description
=> 'Category 1',
1416 my $patron = Koha
::Patron
->new({
1417 firstname
=> 'Patron',
1418 surname
=> 'with attributes',
1419 branchcode
=> 'LIBPATRON',
1420 categorycode
=> 'CAT1',
1423 my $attribute_type1 = Koha
::Patron
::Attribute
::Type
->new({
1425 description
=> 'Code A desciption',
1428 my $attribute_type2 = Koha
::Patron
::Attribute
::Type
->new({
1430 description
=> 'Code A desciption',
1433 $attribute_type2->library_limits ( [ $library2->branchcode ] );
1435 Koha
::Patron
::Attribute
->new({ borrowernumber
=> $patron->borrowernumber, code
=> $attribute_type1->code, attribute
=> 'value 1' } )->store();
1436 Koha
::Patron
::Attribute
->new({ borrowernumber
=> $patron->borrowernumber, code
=> $attribute_type2->code, attribute
=> 'value 2' } )->store();
1438 is
( $patron->attributes->count, 1, 'There should be one attribute');
1440 $attribute_type2->library_limits ( [ $library1->branchcode ] );
1442 is
( $patron->attributes->count, 2, 'There should be 2 attributes');
1447 $nb_of_patrons = Koha
::Patrons
->search->count;
1448 $retrieved_patron_1->delete;
1449 is
( Koha
::Patrons
->search->count, $nb_of_patrons - 1, 'Delete should have deleted the patron' );
1451 subtest
'BorrowersLog tests' => sub {
1454 t
::lib
::Mocks
::mock_preference
( 'BorrowersLog', 1 );
1455 my $patron = $builder->build_object( { class => 'Koha::Patrons' } );
1457 my $cardnumber = $patron->cardnumber;
1458 $patron->set( { cardnumber
=> 'TESTCARDNUMBER' });
1461 my @logs = $schema->resultset('ActionLog')->search( { module
=> 'MEMBERS', action
=> 'MODIFY', object
=> $patron->borrowernumber } );
1462 my $log_info = from_json
( $logs[0]->info );
1463 is
( $log_info->{cardnumber
}->{after
}, 'TESTCARDNUMBER', 'Got correct new cardnumber' );
1464 is
( $log_info->{cardnumber
}->{before
}, $cardnumber, 'Got correct old cardnumber' );
1465 is
( scalar @logs, 1, 'With BorrowerLogs, one detailed MODIFY action should be logged for the modification.' );
1467 t
::lib
::Mocks
::mock_preference
( 'TrackLastPatronActivity', 1 );
1468 $patron->track_login();
1469 @logs = $schema->resultset('ActionLog')->search( { module
=> 'MEMBERS', action
=> 'MODIFY', object
=> $patron->borrowernumber } );
1470 is
( scalar @logs, 1, 'With BorrowerLogs and TrackLastPatronActivity we should not spam the logs');
1473 $schema->storage->txn_rollback;
1475 subtest
'Test Koha::Patrons::merge' => sub {
1478 my $schema = Koha
::Database
->new()->schema();
1480 my $resultsets = $Koha::Patron
::RESULTSET_PATRON_ID_MAPPING
;
1482 $schema->storage->txn_begin;
1484 my $keeper = $builder->build_object({ class => 'Koha::Patrons' });
1485 my $loser_1 = $builder->build({ source
=> 'Borrower' })->{borrowernumber
};
1486 my $loser_2 = $builder->build({ source
=> 'Borrower' })->{borrowernumber
};
1488 while (my ($r, $field) = each(%$resultsets)) {
1489 $builder->build({ source
=> $r, value
=> { $field => $keeper->id } });
1490 $builder->build({ source
=> $r, value
=> { $field => $loser_1 } });
1491 $builder->build({ source
=> $r, value
=> { $field => $loser_2 } });
1494 $schema->resultset($r)->search( { $field => $keeper->id } );
1495 is
( $keeper_rs->count(), 1, "Found 1 $r rows for keeper" );
1498 $schema->resultset($r)->search( { $field => $loser_1 } );
1499 is
( $loser_1_rs->count(), 1, "Found 1 $r rows for loser_1" );
1502 $schema->resultset($r)->search( { $field => $loser_2 } );
1503 is
( $loser_2_rs->count(), 1, "Found 1 $r rows for loser_2" );
1506 my $results = $keeper->merge_with([ $loser_1, $loser_2 ]);
1508 while (my ($r, $field) = each(%$resultsets)) {
1510 $schema->resultset($r)->search( {$field => $keeper->id } );
1511 is
( $keeper_rs->count(), 3, "Found 2 $r rows for keeper" );
1514 is
( Koha
::Patrons
->find($loser_1), undef, 'Loser 1 has been deleted' );
1515 is
( Koha
::Patrons
->find($loser_2), undef, 'Loser 2 has been deleted' );
1517 $schema->storage->txn_rollback;
1520 subtest
'->store' => sub {
1522 my $schema = Koha
::Database
->new->schema;
1523 $schema->storage->txn_begin;
1525 my $print_error = $schema->storage->dbh->{PrintError
};
1526 $schema->storage->dbh->{PrintError
} = 0; ; # FIXME This does not longer work - because of the transaction in Koha::Patron->store?
1528 my $patron_1 = $builder->build_object({class=> 'Koha::Patrons'});
1529 my $patron_2 = $builder->build_object({class=> 'Koha::Patrons'});
1532 { $patron_2->userid($patron_1->userid)->store; }
1533 'Koha::Exceptions::Object::DuplicateID',
1534 'Koha::Patron->store raises an exception on duplicate ID';
1537 t
::lib
::Mocks
::mock_preference
( 'RequireStrongPassword', 0 );
1538 my $password = 'password';
1539 $patron_1->set_password({ password
=> $password });
1540 like
( $patron_1->password, qr
|^\
$2|, 'Password should be hashed using bcrypt (start with $2)' );
1541 my $digest = $patron_1->password;
1542 $patron_1->surname('xxx')->store;
1543 is
( $patron_1->password, $digest, 'Password should not have changed on ->store');
1545 $schema->storage->dbh->{PrintError
} = $print_error;
1546 $schema->storage->txn_rollback;
1549 subtest
'->set_password' => sub {
1553 $schema->storage->txn_begin;
1555 my $patron = $builder->build_object( { class => 'Koha::Patrons', value
=> { login_attempts
=> 3 } } );
1557 # Disable logging password changes for this tests
1558 t
::lib
::Mocks
::mock_preference
( 'BorrowersLog', 0 );
1560 # Password-length tests
1561 t
::lib
::Mocks
::mock_preference
( 'minPasswordLength', undef );
1562 throws_ok
{ $patron->set_password({ password
=> 'ab' }); }
1563 'Koha::Exceptions::Password::TooShort',
1564 'minPasswordLength is undef, fall back to 3, fail test';
1566 'Password length (2) is shorter than required (3)',
1567 'Exception parameters passed correctly'
1570 t
::lib
::Mocks
::mock_preference
( 'minPasswordLength', 2 );
1571 throws_ok
{ $patron->set_password({ password
=> 'ab' }); }
1572 'Koha::Exceptions::Password::TooShort',
1573 'minPasswordLength is 2, fall back to 3, fail test';
1575 t
::lib
::Mocks
::mock_preference
( 'minPasswordLength', 5 );
1576 throws_ok
{ $patron->set_password({ password
=> 'abcb' }); }
1577 'Koha::Exceptions::Password::TooShort',
1578 'minPasswordLength is 5, fail test';
1580 # Trailing spaces tests
1581 throws_ok
{ $patron->set_password({ password
=> 'abcD12d ' }); }
1582 'Koha::Exceptions::Password::WhitespaceCharacters',
1583 'Password contains trailing spaces, exception is thrown';
1585 # Require strong password tests
1586 t
::lib
::Mocks
::mock_preference
( 'RequireStrongPassword', 1 );
1587 throws_ok
{ $patron->set_password({ password
=> 'abcd a' }); }
1588 'Koha::Exceptions::Password::TooWeak',
1589 'Password is too weak, exception is thrown';
1591 # Refresh patron from DB, just to make sure
1592 $patron->discard_changes;
1593 is
( $patron->login_attempts, 3, 'Previous tests kept login attemps count' );
1595 $patron->set_password({ password
=> 'abcD12 34' });
1596 $patron->discard_changes;
1598 is
( $patron->login_attempts, 0, 'Changing the password resets the login attempts count' );
1600 lives_ok
{ $patron->set_password({ password
=> 'abcd a', skip_validation
=> 1 }) }
1601 'Password is weak, but skip_validation was passed, so no exception thrown';
1604 t
::lib
::Mocks
::mock_preference
( 'RequireStrongPassword', 0 );
1605 $patron->login_attempts(3)->store;
1606 my $old_digest = $patron->password;
1607 $patron->set_password({ password
=> 'abcd a' });
1608 $patron->discard_changes;
1610 isnt
( $patron->password, $old_digest, 'Password has been updated' );
1611 ok
( checkpw_hash
('abcd a', $patron->password), 'Password hash is correct' );
1612 is
( $patron->login_attempts, 0, 'Login attemps have been reset' );
1614 my $number_of_logs = $schema->resultset('ActionLog')->search( { module
=> 'MEMBERS', action
=> 'CHANGE PASS', object
=> $patron->borrowernumber } )->count;
1615 is
( $number_of_logs, 0, 'Without BorrowerLogs, Koha::Patron->set_password doesn\'t log password changes' );
1617 # Enable logging password changes
1618 t
::lib
::Mocks
::mock_preference
( 'BorrowersLog', 1 );
1619 $patron->set_password({ password
=> 'abcd b' });
1621 $number_of_logs = $schema->resultset('ActionLog')->search( { module
=> 'MEMBERS', action
=> 'CHANGE PASS', object
=> $patron->borrowernumber } )->count;
1622 is
( $number_of_logs, 1, 'With BorrowerLogs, Koha::Patron->set_password does log password changes' );
1624 $schema->storage->txn_rollback;