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
=> 26;
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 C4
::Context
->_new_userenv('xxx');
72 set_logged_in_user
( $new_patron_1 );
74 is
( Koha
::Patrons
->search->count, $nb_of_patrons + 2, 'The 2 patrons should have been added' );
76 my $retrieved_patron_1 = Koha
::Patrons
->find( $new_patron_1->borrowernumber );
77 is
( $retrieved_patron_1->cardnumber, $new_patron_1->cardnumber, 'Find a patron by borrowernumber should return the correct patron' );
79 subtest
'library' => sub {
81 is
( $retrieved_patron_1->library->branchcode, $library->{branchcode
}, 'Koha::Patron->library should return the correct library' );
82 is
( ref($retrieved_patron_1->library), 'Koha::Library', 'Koha::Patron->library should return a Koha::Library object' );
85 subtest
'guarantees' => sub {
87 my $guarantees = $new_patron_1->guarantees;
88 is
( ref($guarantees), 'Koha::Patrons', 'Koha::Patron->guarantees should return a Koha::Patrons result set in a scalar context' );
89 is
( $guarantees->count, 0, 'new_patron_1 should have 0 guarantee' );
90 my @guarantees = $new_patron_1->guarantees;
91 is
( ref(\
@guarantees), 'ARRAY', 'Koha::Patron->guarantees should return an array in a list context' );
92 is
( scalar(@guarantees), 0, 'new_patron_1 should have 0 guarantee' );
94 my $guarantee_1 = $builder->build({ source
=> 'Borrower', value
=> { guarantorid
=> $new_patron_1->borrowernumber }});
95 my $guarantee_2 = $builder->build({ source
=> 'Borrower', value
=> { guarantorid
=> $new_patron_1->borrowernumber }});
97 $guarantees = $new_patron_1->guarantees;
98 is
( ref($guarantees), 'Koha::Patrons', 'Koha::Patron->guarantees should return a Koha::Patrons result set in a scalar context' );
99 is
( $guarantees->count, 2, 'new_patron_1 should have 2 guarantees' );
100 @guarantees = $new_patron_1->guarantees;
101 is
( ref(\
@guarantees), 'ARRAY', 'Koha::Patron->guarantees should return an array in a list context' );
102 is
( scalar(@guarantees), 2, 'new_patron_1 should have 2 guarantees' );
103 $_->delete for @guarantees;
106 subtest
'category' => sub {
108 my $patron_category = $new_patron_1->category;
109 is
( ref( $patron_category), 'Koha::Patron::Category', );
110 is
( $patron_category->categorycode, $category->{categorycode
}, );
113 subtest
'siblings' => sub {
115 my $siblings = $new_patron_1->siblings;
116 is
( $siblings, undef, 'Koha::Patron->siblings should not crashed if the patron has no guarantor' );
117 my $guarantee_1 = $builder->build( { source
=> 'Borrower', value
=> { guarantorid
=> $new_patron_1->borrowernumber } } );
118 my $retrieved_guarantee_1 = Koha
::Patrons
->find($guarantee_1);
119 $siblings = $retrieved_guarantee_1->siblings;
120 is
( ref($siblings), 'Koha::Patrons', 'Koha::Patron->siblings should return a Koha::Patrons result set in a scalar context' );
121 my @siblings = $retrieved_guarantee_1->siblings;
122 is
( ref( \
@siblings ), 'ARRAY', 'Koha::Patron->siblings should return an array in a list context' );
123 is
( $siblings->count, 0, 'guarantee_1 should not have siblings yet' );
124 my $guarantee_2 = $builder->build( { source
=> 'Borrower', value
=> { guarantorid
=> $new_patron_1->borrowernumber } } );
125 my $guarantee_3 = $builder->build( { source
=> 'Borrower', value
=> { guarantorid
=> $new_patron_1->borrowernumber } } );
126 $siblings = $retrieved_guarantee_1->siblings;
127 is
( $siblings->count, 2, 'guarantee_1 should have 2 siblings' );
128 is
( $guarantee_2->{borrowernumber
}, $siblings->next->borrowernumber, 'guarantee_2 should exist in the guarantees' );
129 is
( $guarantee_3->{borrowernumber
}, $siblings->next->borrowernumber, 'guarantee_3 should exist in the guarantees' );
130 $_->delete for $retrieved_guarantee_1->siblings;
131 $retrieved_guarantee_1->delete;
134 subtest
'has_overdues' => sub {
137 my $biblioitem_1 = $builder->build( { source
=> 'Biblioitem' } );
138 my $item_1 = $builder->build(
141 homebranch
=> $library->{branchcode
},
142 holdingbranch
=> $library->{branchcode
},
146 biblionumber
=> $biblioitem_1->{biblionumber
}
150 my $retrieved_patron = Koha
::Patrons
->find( $new_patron_1->borrowernumber );
151 is
( $retrieved_patron->has_overdues, 0, );
153 my $tomorrow = DateTime
->today( time_zone
=> C4
::Context
->tz() )->add( days
=> 1 );
154 my $issue = Koha
::Checkout
->new({ borrowernumber
=> $new_patron_1->id, itemnumber
=> $item_1->{itemnumber
}, date_due
=> $tomorrow, branchcode
=> $library->{branchcode
} })->store();
155 is
( $retrieved_patron->has_overdues, 0, );
157 my $yesterday = DateTime
->today(time_zone
=> C4
::Context
->tz())->add( days
=> -1 );
158 $issue = Koha
::Checkout
->new({ borrowernumber
=> $new_patron_1->id, itemnumber
=> $item_1->{itemnumber
}, date_due
=> $yesterday, branchcode
=> $library->{branchcode
} })->store();
159 $retrieved_patron = Koha
::Patrons
->find( $new_patron_1->borrowernumber );
160 is
( $retrieved_patron->has_overdues, 1, );
164 subtest
'update_password' => sub {
167 t
::lib
::Mocks
::mock_preference
( 'BorrowersLog', 1 );
168 my $original_userid = $new_patron_1->userid;
169 my $original_password = $new_patron_1->password;
170 warning_like
{ $retrieved_patron_1->update_password( $new_patron_2->userid, 'another_password' ) }
172 'Koha::Patron->update_password should warn if the userid is already used by another patron';
173 is
( Koha
::Patrons
->find( $new_patron_1->borrowernumber )->userid, $original_userid, 'Koha::Patron->update_password should not have updated the userid' );
174 is
( Koha
::Patrons
->find( $new_patron_1->borrowernumber )->password, $original_password, 'Koha::Patron->update_password should not have updated the userid' );
176 $retrieved_patron_1->update_password( 'another_nonexistent_userid_1', 'another_password' );
177 is
( Koha
::Patrons
->find( $new_patron_1->borrowernumber )->userid, 'another_nonexistent_userid_1', 'Koha::Patron->update_password should have updated the userid' );
178 is
( Koha
::Patrons
->find( $new_patron_1->borrowernumber )->password, 'another_password', 'Koha::Patron->update_password should have updated the password' );
180 my $number_of_logs = $schema->resultset('ActionLog')->search( { module
=> 'MEMBERS', action
=> 'CHANGE PASS', object
=> $new_patron_1->borrowernumber } )->count;
181 is
( $number_of_logs, 1, 'With BorrowerLogs, Koha::Patron->update_password should have logged' );
183 t
::lib
::Mocks
::mock_preference
( 'BorrowersLog', 0 );
184 $retrieved_patron_1->update_password( 'yet_another_nonexistent_userid_1', 'another_password' );
185 $number_of_logs = $schema->resultset('ActionLog')->search( { module
=> 'MEMBERS', action
=> 'CHANGE PASS', object
=> $new_patron_1->borrowernumber } )->count;
186 is
( $number_of_logs, 1, 'With BorrowerLogs, Koha::Patron->update_password should not have logged' );
189 subtest
'is_expired' => sub {
191 my $patron = $builder->build({ source
=> 'Borrower' });
192 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
193 $patron->dateexpiry( undef )->store->discard_changes;
194 is
( $patron->is_expired, 0, 'Patron should not be considered expired if dateexpiry is not set');
195 $patron->dateexpiry( dt_from_string
)->store->discard_changes;
196 is
( $patron->is_expired, 0, 'Patron should not be considered expired if dateexpiry is today');
197 $patron->dateexpiry( dt_from_string
->add( days
=> 1 ) )->store->discard_changes;
198 is
( $patron->is_expired, 0, 'Patron should not be considered expired if dateexpiry is tomorrow');
199 $patron->dateexpiry( dt_from_string
->add( days
=> -1 ) )->store->discard_changes;
200 is
( $patron->is_expired, 1, 'Patron should be considered expired if dateexpiry is yesterday');
205 subtest
'is_going_to_expire' => sub {
207 my $patron = $builder->build({ source
=> 'Borrower' });
208 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
209 $patron->dateexpiry( undef )->store->discard_changes;
210 is
( $patron->is_going_to_expire, 0, 'Patron should not be considered going to expire if dateexpiry is not set');
212 t
::lib
::Mocks
::mock_preference
('NotifyBorrowerDeparture', 0);
213 $patron->dateexpiry( dt_from_string
)->store->discard_changes;
214 is
( $patron->is_going_to_expire, 0, 'Patron should not be considered going to expire if dateexpiry is today');
216 $patron->dateexpiry( dt_from_string
)->store->discard_changes;
217 is
( $patron->is_going_to_expire, 0, 'Patron should not be considered going to expire if dateexpiry is today and pref is 0');
219 t
::lib
::Mocks
::mock_preference
('NotifyBorrowerDeparture', 10);
220 $patron->dateexpiry( dt_from_string
->add( days
=> 11 ) )->store->discard_changes;
221 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');
223 t
::lib
::Mocks
::mock_preference
('NotifyBorrowerDeparture', 0);
224 $patron->dateexpiry( dt_from_string
->add( days
=> 10 ) )->store->discard_changes;
225 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');
227 t
::lib
::Mocks
::mock_preference
('NotifyBorrowerDeparture', 10);
228 $patron->dateexpiry( dt_from_string
->add( days
=> 10 ) )->store->discard_changes;
229 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');
232 t
::lib
::Mocks
::mock_preference
('NotifyBorrowerDeparture', 10);
233 $patron->dateexpiry( dt_from_string
->add( days
=> 20 ) )->store->discard_changes;
234 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');
236 t
::lib
::Mocks
::mock_preference
('NotifyBorrowerDeparture', 20);
237 $patron->dateexpiry( dt_from_string
->add( days
=> 10 ) )->store->discard_changes;
238 is
( $patron->is_going_to_expire, 1, 'Patron should be considered going to expire if dateexpiry is 10 days ahead and pref is 20');
244 subtest
'renew_account' => sub {
247 for my $date ( '2016-03-31', '2016-11-30', dt_from_string
() ) {
248 my $dt = dt_from_string
( $date, 'iso' );
249 Time
::Fake
->offset( $dt->epoch );
250 my $a_month_ago = $dt->clone->subtract( months
=> 1, end_of_month
=> 'limit' )->truncate( to
=> 'day' );
251 my $a_year_later = $dt->clone->add( months
=> 12, end_of_month
=> 'limit' )->truncate( to
=> 'day' );
252 my $a_year_later_minus_a_month = $dt->clone->add( months
=> 11, end_of_month
=> 'limit' )->truncate( to
=> 'day' );
253 my $a_month_later = $dt->clone->add( months
=> 1 , end_of_month
=> 'limit' )->truncate( to
=> 'day' );
254 my $a_year_later_plus_a_month = $dt->clone->add( months
=> 13, end_of_month
=> 'limit' )->truncate( to
=> 'day' );
255 my $patron_category = $builder->build(
256 { source
=> 'Category',
258 enrolmentperiod
=> 12,
259 enrolmentperioddate
=> undef,
263 my $patron = $builder->build(
264 { source
=> 'Borrower',
266 dateexpiry
=> $a_month_ago,
267 categorycode
=> $patron_category->{categorycode
},
268 date_renewed
=> undef, # Force builder to not populate the column for new patron
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 is
( $retrieved_patron->date_renewed, undef, "Date renewed is not set for patrons that have never been renewed" );
294 t
::lib
::Mocks
::mock_preference
( 'BorrowerRenewalPeriodBase', 'dateexpiry' );
295 t
::lib
::Mocks
::mock_preference
( 'BorrowersLog', 1 );
296 my $expiry_date = $retrieved_patron->renew_account;
297 is
( $expiry_date, $a_year_later_minus_a_month, "$a_month_ago + 12 months must be $a_year_later_minus_a_month" );
298 my $retrieved_expiry_date = Koha
::Patrons
->find( $patron->{borrowernumber
} )->dateexpiry;
299 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" );
300 my $number_of_logs = $schema->resultset('ActionLog')->search( { module
=> 'MEMBERS', action
=> 'RENEW', object
=> $retrieved_patron->borrowernumber } )->count;
301 is
( $number_of_logs, 1, 'With BorrowerLogs, Koha::Patron->renew_account should have logged' );
303 t
::lib
::Mocks
::mock_preference
( 'BorrowerRenewalPeriodBase', 'now' );
304 t
::lib
::Mocks
::mock_preference
( 'BorrowersLog', 0 );
305 $expiry_date = $retrieved_patron->renew_account;
306 is
( $expiry_date, $a_year_later, "today + 12 months must be $a_year_later" );
307 $retrieved_patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
308 is
( $retrieved_patron->date_renewed, output_pref
({ dt
=> $dt, dateformat
=> 'iso', dateonly
=> 1 }), "Date renewed is set when calling renew_account" );
309 $retrieved_expiry_date = $retrieved_patron->dateexpiry;
310 is
( dt_from_string
($retrieved_expiry_date), $a_year_later, "today + 12 months must be $a_year_later" );
311 $number_of_logs = $schema->resultset('ActionLog')->search( { module
=> 'MEMBERS', action
=> 'RENEW', object
=> $retrieved_patron->borrowernumber } )->count;
312 is
( $number_of_logs, 1, 'Without BorrowerLogs, Koha::Patron->renew_account should not have logged' );
314 t
::lib
::Mocks
::mock_preference
( 'BorrowerRenewalPeriodBase', 'combination' );
315 $expiry_date = $retrieved_patron_2->renew_account;
316 is
( $expiry_date, $a_year_later, "today + 12 months must be $a_year_later" );
317 $retrieved_expiry_date = Koha
::Patrons
->find( $patron_2->{borrowernumber
} )->dateexpiry;
318 is
( dt_from_string
($retrieved_expiry_date), $a_year_later, "today + 12 months must be $a_year_later" );
320 $expiry_date = $retrieved_patron_3->renew_account;
321 is
( $expiry_date, $a_year_later_plus_a_month, "$a_month_later + 12 months must be $a_year_later_plus_a_month" );
322 $retrieved_expiry_date = Koha
::Patrons
->find( $patron_3->{borrowernumber
} )->dateexpiry;
323 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" );
325 $retrieved_patron->delete;
326 $retrieved_patron_2->delete;
327 $retrieved_patron_3->delete;
332 subtest
"move_to_deleted" => sub {
334 my $originally_updated_on = '2016-01-01 12:12:12';
335 my $patron = $builder->build( { source
=> 'Borrower',value
=> { updated_on
=> $originally_updated_on } } );
336 my $retrieved_patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
337 is
( ref( $retrieved_patron->move_to_deleted ), 'Koha::Schema::Result::Deletedborrower', 'Koha::Patron->move_to_deleted should return the Deleted patron' )
338 ; # FIXME This should be Koha::Deleted::Patron
339 my $deleted_patron = $schema->resultset('Deletedborrower')
340 ->search( { borrowernumber
=> $patron->{borrowernumber
} }, { result_class
=> 'DBIx::Class::ResultClass::HashRefInflator' } )
342 ok
( $retrieved_patron->updated_on, 'updated_on should be set for borrowers table' );
343 ok
( $deleted_patron->{updated_on
}, 'updated_on should be set for deleted_borrowers table' );
344 isnt
( $deleted_patron->{updated_on
}, $retrieved_patron->updated_on, 'Koha::Patron->move_to_deleted should have correctly updated the updated_on column');
345 $deleted_patron->{updated_on
} = $originally_updated_on; #reset for simplicity in comparing all other fields
346 is_deeply
( $deleted_patron, $patron, 'Koha::Patron->move_to_deleted should have correctly moved the patron to the deleted table' );
347 $retrieved_patron->delete( $patron->{borrowernumber
} ); # Cleanup
350 subtest
"delete" => sub {
352 t
::lib
::Mocks
::mock_preference
( 'BorrowersLog', 1 );
353 my $patron = $builder->build( { source
=> 'Borrower' } );
354 my $retrieved_patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
355 my $hold = $builder->build(
356 { source
=> 'Reserve',
357 value
=> { borrowernumber
=> $patron->{borrowernumber
} }
360 my $list = $builder->build(
361 { source
=> 'Virtualshelve',
362 value
=> { owner
=> $patron->{borrowernumber
} }
366 my $deleted = $retrieved_patron->delete;
367 is
( $deleted, 1, 'Koha::Patron->delete should return 1 if the patron has been correctly deleted' );
369 is
( Koha
::Patrons
->find( $patron->{borrowernumber
} ), undef, 'Koha::Patron->delete should have deleted the patron' );
371 is
( Koha
::Holds
->search( { borrowernumber
=> $patron->{borrowernumber
} } )->count, 0, q
|Koha
::Patron
->delete should have deleted patron
's holds| );
373 is( Koha::Virtualshelves->search( { owner => $patron->{borrowernumber} } )->count, 0, q|Koha::Patron->delete should have deleted patron's lists
| );
375 my $number_of_logs = $schema->resultset('ActionLog')->search( { module
=> 'MEMBERS', action
=> 'DELETE', object
=> $retrieved_patron->borrowernumber } )->count;
376 is
( $number_of_logs, 1, 'With BorrowerLogs, Koha::Patron->delete should have logged' );
379 subtest
'add_enrolment_fee_if_needed' => sub {
382 my $enrolmentfees = { K
=> 5, J
=> 10, YA
=> 20 };
383 foreach( keys %{$enrolmentfees} ) {
384 ( Koha
::Patron
::Categories
->find( $_ ) // $builder->build_object({ class => 'Koha::Patron::Categories', value
=> { categorycode
=> $_ } }) )->enrolmentfee( $enrolmentfees->{$_} )->store;
386 my $enrolmentfee_K = $enrolmentfees->{K
};
387 my $enrolmentfee_J = $enrolmentfees->{J
};
388 my $enrolmentfee_YA = $enrolmentfees->{YA
};
390 my %borrower_data = (
391 firstname
=> 'my firstname',
392 surname
=> 'my surname',
394 branchcode
=> $library->{branchcode
},
397 my $borrowernumber = C4
::Members
::AddMember
(%borrower_data);
398 $borrower_data{borrowernumber
} = $borrowernumber;
400 my $patron = Koha
::Patrons
->find( $borrowernumber );
401 my $total = $patron->account->balance;
402 is
( int($total), int($enrolmentfee_K), "New kid pay $enrolmentfee_K" );
404 t
::lib
::Mocks
::mock_preference
( 'FeeOnChangePatronCategory', 0 );
405 $borrower_data{categorycode
} = 'J';
406 C4
::Members
::ModMember
(%borrower_data);
407 $total = $patron->account->balance;
408 is
( int($total), int($enrolmentfee_K), "Kid growing and become a juvenile, but shouldn't pay for the upgrade " );
410 $borrower_data{categorycode
} = 'K';
411 C4
::Members
::ModMember
(%borrower_data);
412 t
::lib
::Mocks
::mock_preference
( 'FeeOnChangePatronCategory', 1 );
414 $borrower_data{categorycode
} = 'J';
415 C4
::Members
::ModMember
(%borrower_data);
416 $total = $patron->account->balance;
417 is
( int($total), int($enrolmentfee_K + $enrolmentfee_J), "Kid growing and become a juvenile, they should pay " . ( $enrolmentfee_K + $enrolmentfee_J ) );
419 # Check with calling directly Koha::Patron->get_enrolment_fee_if_needed
420 $patron->categorycode('YA')->store;
421 my $fee = $patron->add_enrolment_fee_if_needed;
422 $total = $patron->account->balance;
424 int($enrolmentfee_K + $enrolmentfee_J + $enrolmentfee_YA),
425 "Juvenile growing and become an young adult, they should pay " . ( $enrolmentfee_K + $enrolmentfee_J + $enrolmentfee_YA )
431 subtest
'checkouts + get_overdues + old_checkouts' => sub {
434 my $library = $builder->build( { source
=> 'Branch' } );
435 my ($biblionumber_1) = AddBiblio
( MARC
::Record
->new, '' );
436 my $item_1 = $builder->build(
440 homebranch
=> $library->{branchcode
},
441 holdingbranch
=> $library->{branchcode
},
442 biblionumber
=> $biblionumber_1,
448 my $item_2 = $builder->build(
452 homebranch
=> $library->{branchcode
},
453 holdingbranch
=> $library->{branchcode
},
454 biblionumber
=> $biblionumber_1,
460 my ($biblionumber_2) = AddBiblio
( MARC
::Record
->new, '' );
461 my $item_3 = $builder->build(
465 homebranch
=> $library->{branchcode
},
466 holdingbranch
=> $library->{branchcode
},
467 biblionumber
=> $biblionumber_2,
473 my $patron = $builder->build(
475 source
=> 'Borrower',
476 value
=> { branchcode
=> $library->{branchcode
} }
480 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
481 my $checkouts = $patron->checkouts;
482 is
( $checkouts->count, 0, 'checkouts should not return any issues for that patron' );
483 is
( ref($checkouts), 'Koha::Checkouts', 'checkouts should return a Koha::Checkouts object' );
484 my $old_checkouts = $patron->old_checkouts;
485 is
( $old_checkouts->count, 0, 'old_checkouts should not return any issues for that patron' );
486 is
( ref($old_checkouts), 'Koha::Old::Checkouts', 'old_checkouts should return a Koha::Old::Checkouts object' );
488 # Not sure how this is useful, but AddIssue pass this variable to different other subroutines
489 $patron = Koha
::Patrons
->find( $patron->borrowernumber )->unblessed;
491 my $module = new Test
::MockModule
('C4::Context');
492 $module->mock( 'userenv', sub { { branch
=> $library->{branchcode
} } } );
494 AddIssue
( $patron, $item_1->{barcode
}, DateTime
->now->subtract( days
=> 1 ) );
495 AddIssue
( $patron, $item_2->{barcode
}, DateTime
->now->subtract( days
=> 5 ) );
496 AddIssue
( $patron, $item_3->{barcode
} );
498 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
499 $checkouts = $patron->checkouts;
500 is
( $checkouts->count, 3, 'checkouts should return 3 issues for that patron' );
501 is
( ref($checkouts), 'Koha::Checkouts', 'checkouts should return a Koha::Checkouts object' );
503 my $overdues = $patron->get_overdues;
504 is
( $overdues->count, 2, 'Patron should have 2 overdues');
505 is
( ref($overdues), 'Koha::Checkouts', 'Koha::Patron->get_overdues should return Koha::Checkouts' );
506 is
( $overdues->next->itemnumber, $item_1->{itemnumber
}, 'The issue should be returned in the same order as they have been done, first is correct' );
507 is
( $overdues->next->itemnumber, $item_2->{itemnumber
}, 'The issue should be returned in the same order as they have been done, second is correct' );
510 C4
::Circulation
::AddReturn
( $item_1->{barcode
} );
511 C4
::Circulation
::AddReturn
( $item_2->{barcode
} );
512 $old_checkouts = $patron->old_checkouts;
513 is
( $old_checkouts->count, 2, 'old_checkouts should return 2 old checkouts that patron' );
514 is
( ref($old_checkouts), 'Koha::Old::Checkouts', 'old_checkouts should return a Koha::Old::Checkouts object' );
517 Koha
::Checkouts
->search( { borrowernumber
=> $patron->borrowernumber } )->delete;
519 $module->unmock('userenv');
522 subtest
'get_age' => sub {
525 my $patron = $builder->build( { source
=> 'Borrower' } );
526 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
528 my $today = dt_from_string
;
530 $patron->dateofbirth( undef );
531 is
( $patron->get_age, undef, 'get_age should return undef if no dateofbirth is defined' );
532 $patron->dateofbirth( $today->clone->add( years
=> -12, months
=> -6, days
=> -1, end_of_month
=> 'limit' ) );
533 is
( $patron->get_age, 12, 'Patron should be 12' );
534 $patron->dateofbirth( $today->clone->add( years
=> -18, months
=> 0, days
=> 1, end_of_month
=> 'limit' ) );
535 is
( $patron->get_age, 17, 'Patron should be 17, happy birthday tomorrow!' );
536 $patron->dateofbirth( $today->clone->add( years
=> -18, months
=> 0, days
=> 0, end_of_month
=> 'limit' ) );
537 is
( $patron->get_age, 18, 'Patron should be 18' );
538 $patron->dateofbirth( $today->clone->add( years
=> -18, months
=> -12, days
=> -31, end_of_month
=> 'limit' ) );
539 is
( $patron->get_age, 19, 'Patron should be 19' );
540 $patron->dateofbirth( $today->clone->add( years
=> -18, months
=> -12, days
=> -30, end_of_month
=> 'limit' ) );
541 is
( $patron->get_age, 19, 'Patron should be 19 again' );
542 $patron->dateofbirth( $today->clone->add( years
=> 0, months
=> -1, days
=> -1, end_of_month
=> 'limit' ) );
543 is
( $patron->get_age, 0, 'Patron is a newborn child' );
548 subtest
'account' => sub {
551 my $patron = $builder->build({source
=> 'Borrower'});
553 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
554 my $account = $patron->account;
555 is
( ref($account), 'Koha::Account', 'account should return a Koha::Account object' );
560 subtest
'search_upcoming_membership_expires' => sub {
563 my $expiry_days = 15;
564 t
::lib
::Mocks
::mock_preference
( 'MembershipExpiryDaysNotice', $expiry_days );
565 my $nb_of_days_before = 1;
566 my $nb_of_days_after = 2;
568 my $builder = t
::lib
::TestBuilder
->new();
570 my $library = $builder->build({ source
=> 'Branch' });
572 # before we add borrowers to this branch, add the expires we have now
573 # note that this pertains to the current mocked setting of the pref
574 # for this reason we add the new branchcode to most of the tests
575 my $nb_of_expires = Koha
::Patrons
->search_upcoming_membership_expires->count;
577 my $patron_1 = $builder->build({
578 source
=> 'Borrower',
580 branchcode
=> $library->{branchcode
},
581 dateexpiry
=> dt_from_string
->add( days
=> $expiry_days )
585 my $patron_2 = $builder->build({
586 source
=> 'Borrower',
588 branchcode
=> $library->{branchcode
},
589 dateexpiry
=> dt_from_string
->add( days
=> $expiry_days - $nb_of_days_before )
593 my $patron_3 = $builder->build({
594 source
=> 'Borrower',
596 branchcode
=> $library->{branchcode
},
597 dateexpiry
=> dt_from_string
->add( days
=> $expiry_days + $nb_of_days_after )
601 # Test without extra parameters
602 my $upcoming_mem_expires = Koha
::Patrons
->search_upcoming_membership_expires();
603 is
( $upcoming_mem_expires->count, $nb_of_expires + 1, 'Get upcoming membership expires should return one new borrower.' );
606 $upcoming_mem_expires = Koha
::Patrons
->search_upcoming_membership_expires({ 'me.branchcode' => $library->{branchcode
} });
607 is
( $upcoming_mem_expires->count, 1, 'Test with branch parameter' );
608 my $expired = $upcoming_mem_expires->next;
609 is
( $expired->surname, $patron_1->{surname
}, 'Get upcoming membership expires should return the correct patron.' );
610 is
( $expired->library->branchemail, $library->{branchemail
}, 'Get upcoming membership expires should return the correct patron.' );
611 is
( $expired->branchcode, $patron_1->{branchcode
}, 'Get upcoming membership expires should return the correct patron.' );
613 t
::lib
::Mocks
::mock_preference
( 'MembershipExpiryDaysNotice', 0 );
614 $upcoming_mem_expires = Koha
::Patrons
->search_upcoming_membership_expires({ 'me.branchcode' => $library->{branchcode
} });
615 is
( $upcoming_mem_expires->count, 0, 'Get upcoming membership expires with MembershipExpiryDaysNotice==0 should not return new records.' );
617 # Test MembershipExpiryDaysNotice == undef
618 t
::lib
::Mocks
::mock_preference
( 'MembershipExpiryDaysNotice', undef );
619 $upcoming_mem_expires = Koha
::Patrons
->search_upcoming_membership_expires({ 'me.branchcode' => $library->{branchcode
} });
620 is
( $upcoming_mem_expires->count, 0, 'Get upcoming membership expires without MembershipExpiryDaysNotice should not return new records.' );
622 # Test the before parameter
623 t
::lib
::Mocks
::mock_preference
( 'MembershipExpiryDaysNotice', 15 );
624 $upcoming_mem_expires = Koha
::Patrons
->search_upcoming_membership_expires({ 'me.branchcode' => $library->{branchcode
}, before
=> $nb_of_days_before });
625 is
( $upcoming_mem_expires->count, 2, 'Expect two results for before');
626 # Test after parameter also
627 $upcoming_mem_expires = Koha
::Patrons
->search_upcoming_membership_expires({ 'me.branchcode' => $library->{branchcode
}, before
=> $nb_of_days_before, after
=> $nb_of_days_after });
628 is
( $upcoming_mem_expires->count, 3, 'Expect three results when adding after' );
629 Koha
::Patrons
->search({ borrowernumber
=> { in => [ $patron_1->{borrowernumber
}, $patron_2->{borrowernumber
}, $patron_3->{borrowernumber
} ] } })->delete;
632 subtest
'holds and old_holds' => sub {
635 my $library = $builder->build( { source
=> 'Branch' } );
636 my ($biblionumber_1) = AddBiblio
( MARC
::Record
->new, '' );
637 my $item_1 = $builder->build(
641 homebranch
=> $library->{branchcode
},
642 holdingbranch
=> $library->{branchcode
},
643 biblionumber
=> $biblionumber_1
647 my $item_2 = $builder->build(
651 homebranch
=> $library->{branchcode
},
652 holdingbranch
=> $library->{branchcode
},
653 biblionumber
=> $biblionumber_1
657 my ($biblionumber_2) = AddBiblio
( MARC
::Record
->new, '' );
658 my $item_3 = $builder->build(
662 homebranch
=> $library->{branchcode
},
663 holdingbranch
=> $library->{branchcode
},
664 biblionumber
=> $biblionumber_2
668 my $patron = $builder->build(
670 source
=> 'Borrower',
671 value
=> { branchcode
=> $library->{branchcode
} }
675 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
676 my $holds = $patron->holds;
677 is
( ref($holds), 'Koha::Holds',
678 'Koha::Patron->holds should return a Koha::Holds objects' );
679 is
( $holds->count, 0, 'There should not be holds placed by this patron yet' );
681 C4
::Reserves
::AddReserve
( $library->{branchcode
},
682 $patron->borrowernumber, $biblionumber_1 );
684 C4
::Reserves
::AddReserve
( $library->{branchcode
},
685 $patron->borrowernumber, $biblionumber_2, undef, undef, dt_from_string
->add( days
=> 2 ) );
687 $holds = $patron->holds;
688 is
( $holds->count, 2, 'There should be 2 holds placed by this patron' );
690 my $old_holds = $patron->old_holds;
691 is
( ref($old_holds), 'Koha::Old::Holds',
692 'Koha::Patron->old_holds should return a Koha::Old::Holds objects' );
693 is
( $old_holds->count, 0, 'There should not be any old holds yet');
695 my $hold = $holds->next;
698 $old_holds = $patron->old_holds;
699 is
( $old_holds->count, 1, 'There should be 1 old (cancelled) hold');
706 subtest
'notice_email_address' => sub {
709 my $patron = $builder->build_object({ class => 'Koha::Patrons' });
711 t
::lib
::Mocks
::mock_preference
( 'AutoEmailPrimaryAddress', 'OFF' );
712 is
($patron->notice_email_address, $patron->email, "Koha::Patron->notice_email_address returns correct value when AutoEmailPrimaryAddress is off");
714 t
::lib
::Mocks
::mock_preference
( 'AutoEmailPrimaryAddress', 'emailpro' );
715 is
($patron->notice_email_address, $patron->emailpro, "Koha::Patron->notice_email_address returns correct value when AutoEmailPrimaryAddress is emailpro");
720 subtest
'search_patrons_to_anonymise & anonymise_issue_history' => sub {
723 # TODO create a subroutine in t::lib::Mocks
724 my $branch = $builder->build({ source
=> 'Branch' });
725 my $userenv_patron = $builder->build({
726 source
=> 'Borrower',
727 value
=> { branchcode
=> $branch->{branchcode
} },
729 C4
::Context
->_new_userenv('DUMMY SESSION');
730 C4
::Context
->set_userenv(
731 $userenv_patron->{borrowernumber
},
732 $userenv_patron->{userid
},
733 'usercnum', 'First name', 'Surname',
734 $branch->{branchcode
},
735 $branch->{branchname
},
738 my $anonymous = $builder->build( { source
=> 'Borrower', }, );
740 t
::lib
::Mocks
::mock_preference
( 'AnonymousPatron', $anonymous->{borrowernumber
} );
742 subtest
'patron privacy is 1 (default)' => sub {
745 t
::lib
::Mocks
::mock_preference
('IndependentBranches', 0);
746 my $patron = $builder->build(
747 { source
=> 'Borrower',
748 value
=> { privacy
=> 1, }
751 my $item_1 = $builder->build(
759 my $issue_1 = $builder->build(
762 borrowernumber
=> $patron->{borrowernumber
},
763 itemnumber
=> $item_1->{itemnumber
},
767 my $item_2 = $builder->build(
775 my $issue_2 = $builder->build(
778 borrowernumber
=> $patron->{borrowernumber
},
779 itemnumber
=> $item_2->{itemnumber
},
784 my ( $returned_1, undef, undef ) = C4
::Circulation
::AddReturn
( $item_1->{barcode
}, undef, undef, undef, '2010-10-10' );
785 my ( $returned_2, undef, undef ) = C4
::Circulation
::AddReturn
( $item_2->{barcode
}, undef, undef, undef, '2011-11-11' );
786 is
( $returned_1 && $returned_2, 1, 'The items should have been returned' );
788 my $patrons_to_anonymise = Koha
::Patrons
->search_patrons_to_anonymise( { before
=> '2010-10-11' } )->search( { 'me.borrowernumber' => $patron->{borrowernumber
} } );
789 is
( ref($patrons_to_anonymise), 'Koha::Patrons', 'search_patrons_to_anonymise should return Koha::Patrons' );
791 my $rows_affected = Koha
::Patrons
->search_patrons_to_anonymise( { before
=> '2011-11-12' } )->anonymise_issue_history( { before
=> '2010-10-11' } );
792 ok
( $rows_affected > 0, 'AnonymiseIssueHistory should affect at least 1 row' );
794 my $dbh = C4
::Context
->dbh;
795 my $sth = $dbh->prepare(q
|SELECT borrowernumber FROM old_issues where itemnumber
= ?
|);
796 $sth->execute($item_1->{itemnumber
});
797 my ($borrowernumber_used_to_anonymised) = $sth->fetchrow_array;
798 is
( $borrowernumber_used_to_anonymised, $anonymous->{borrowernumber
}, 'With privacy=1, the issue should have been anonymised' );
799 $sth->execute($item_2->{itemnumber
});
800 ($borrowernumber_used_to_anonymised) = $sth->fetchrow_array;
801 is
( $borrowernumber_used_to_anonymised, $patron->{borrowernumber
}, 'The issue should not have been anonymised, the returned date is later' );
803 $rows_affected = Koha
::Patrons
->search_patrons_to_anonymise( { before
=> '2011-11-12' } )->anonymise_issue_history;
804 $sth->execute($item_2->{itemnumber
});
805 ($borrowernumber_used_to_anonymised) = $sth->fetchrow_array;
806 is
( $borrowernumber_used_to_anonymised, $anonymous->{borrowernumber
}, 'The issue should have been anonymised, the returned date is before' );
808 my $sth_reset = $dbh->prepare(q
|UPDATE old_issues SET borrowernumber
= ? WHERE itemnumber
= ?
|);
809 $sth_reset->execute( $patron->{borrowernumber
}, $item_1->{itemnumber
} );
810 $sth_reset->execute( $patron->{borrowernumber
}, $item_2->{itemnumber
} );
811 $rows_affected = Koha
::Patrons
->search_patrons_to_anonymise->anonymise_issue_history;
812 $sth->execute($item_1->{itemnumber
});
813 ($borrowernumber_used_to_anonymised) = $sth->fetchrow_array;
814 is
( $borrowernumber_used_to_anonymised, $anonymous->{borrowernumber
}, 'The issue 1 should have been anonymised, before parameter was not passed' );
815 $sth->execute($item_2->{itemnumber
});
816 ($borrowernumber_used_to_anonymised) = $sth->fetchrow_array;
817 is
( $borrowernumber_used_to_anonymised, $anonymous->{borrowernumber
}, 'The issue 2 should have been anonymised, before parameter was not passed' );
819 Koha
::Patrons
->find( $patron->{borrowernumber
})->delete;
822 subtest
'patron privacy is 0 (forever)' => sub {
825 t
::lib
::Mocks
::mock_preference
('IndependentBranches', 0);
826 my $patron = $builder->build(
827 { source
=> 'Borrower',
828 value
=> { privacy
=> 0, }
831 my $item = $builder->build(
839 my $issue = $builder->build(
842 borrowernumber
=> $patron->{borrowernumber
},
843 itemnumber
=> $item->{itemnumber
},
848 my ( $returned, undef, undef ) = C4
::Circulation
::AddReturn
( $item->{barcode
}, undef, undef, undef, '2010-10-10' );
849 is
( $returned, 1, 'The item should have been returned' );
850 my $rows_affected = Koha
::Patrons
->search_patrons_to_anonymise( { before
=> '2010-10-11' } )->anonymise_issue_history( { before
=> '2010-10-11' } );
851 ok
( $rows_affected > 0, 'AnonymiseIssueHistory should not return any error if success' );
853 my $dbh = C4
::Context
->dbh;
854 my ($borrowernumber_used_to_anonymised) = $dbh->selectrow_array(q
|
855 SELECT borrowernumber FROM old_issues where itemnumber
= ?
856 |, undef, $item->{itemnumber
});
857 is
( $borrowernumber_used_to_anonymised, $patron->{borrowernumber
}, 'With privacy=0, the issue should not be anonymised' );
858 Koha
::Patrons
->find( $patron->{borrowernumber
})->delete;
861 t
::lib
::Mocks
::mock_preference
( 'AnonymousPatron', '' );
863 subtest
'AnonymousPatron is not defined' => sub {
866 t
::lib
::Mocks
::mock_preference
('IndependentBranches', 0);
867 my $patron = $builder->build(
868 { source
=> 'Borrower',
869 value
=> { privacy
=> 1, }
872 my $item = $builder->build(
880 my $issue = $builder->build(
883 borrowernumber
=> $patron->{borrowernumber
},
884 itemnumber
=> $item->{itemnumber
},
889 my ( $returned, undef, undef ) = C4
::Circulation
::AddReturn
( $item->{barcode
}, undef, undef, undef, '2010-10-10' );
890 is
( $returned, 1, 'The item should have been returned' );
891 my $rows_affected = Koha
::Patrons
->search_patrons_to_anonymise( { before
=> '2010-10-11' } )->anonymise_issue_history( { before
=> '2010-10-11' } );
892 ok
( $rows_affected > 0, 'AnonymiseIssueHistory should affect at least 1 row' );
894 my $dbh = C4
::Context
->dbh;
895 my ($borrowernumber_used_to_anonymised) = $dbh->selectrow_array(q
|
896 SELECT borrowernumber FROM old_issues where itemnumber
= ?
897 |, undef, $item->{itemnumber
});
898 is
( $borrowernumber_used_to_anonymised, undef, 'With AnonymousPatron is not defined, the issue should have been anonymised anyway' );
899 Koha
::Patrons
->find( $patron->{borrowernumber
})->delete;
902 subtest
'Logged in librarian is not superlibrarian & IndependentBranches' => sub {
904 t
::lib
::Mocks
::mock_preference
( 'IndependentBranches', 1 );
905 my $patron = $builder->build(
906 { source
=> 'Borrower',
907 value
=> { privacy
=> 1 } # Another branchcode than the logged in librarian
910 my $item = $builder->build(
918 my $issue = $builder->build(
921 borrowernumber
=> $patron->{borrowernumber
},
922 itemnumber
=> $item->{itemnumber
},
927 my ( $returned, undef, undef ) = C4
::Circulation
::AddReturn
( $item->{barcode
}, undef, undef, undef, '2010-10-10' );
928 is
( Koha
::Patrons
->search_patrons_to_anonymise( { before
=> '2010-10-11' } )->count, 0 );
929 Koha
::Patrons
->find( $patron->{borrowernumber
})->delete;
932 Koha
::Patrons
->find( $anonymous->{borrowernumber
})->delete;
933 Koha
::Patrons
->find( $userenv_patron->{borrowernumber
})->delete;
935 # Reset IndependentBranches for further tests
936 t
::lib
::Mocks
::mock_preference
('IndependentBranches', 0);
939 subtest
'libraries_where_can_see_patrons + can_see_patron_infos + search_limited' => sub {
947 my $group_1 = Koha
::Library
::Group
->new( { title
=> 'TEST Group 1', ft_hide_patron_info
=> 1 } )->store;
948 my $group_2 = Koha
::Library
::Group
->new( { title
=> 'TEST Group 2', ft_hide_patron_info
=> 1 } )->store;
949 my $library_11 = $builder->build( { source
=> 'Branch' } );
950 my $library_12 = $builder->build( { source
=> 'Branch' } );
951 my $library_21 = $builder->build( { source
=> 'Branch' } );
952 $library_11 = Koha
::Libraries
->find( $library_11->{branchcode
} );
953 $library_12 = Koha
::Libraries
->find( $library_12->{branchcode
} );
954 $library_21 = Koha
::Libraries
->find( $library_21->{branchcode
} );
955 Koha
::Library
::Group
->new(
956 { branchcode
=> $library_11->branchcode, parent_id
=> $group_1->id } )->store;
957 Koha
::Library
::Group
->new(
958 { branchcode
=> $library_12->branchcode, parent_id
=> $group_1->id } )->store;
959 Koha
::Library
::Group
->new(
960 { branchcode
=> $library_21->branchcode, parent_id
=> $group_2->id } )->store;
962 my $sth = C4
::Context
->dbh->prepare(q
|INSERT INTO user_permissions
( borrowernumber
, module_bit
, code
) VALUES
(?
, 4, ?
)|); # 4 for borrowers
963 # 2 patrons from library_11 (group1)
964 # patron_11_1 see patron's infos from outside its group
965 # Setting flags => undef to not be considered as superlibrarian
966 my $patron_11_1 = $builder->build({ source
=> 'Borrower', value
=> { branchcode
=> $library_11->branchcode, flags
=> undef, }});
967 $patron_11_1 = Koha
::Patrons
->find( $patron_11_1->{borrowernumber
} );
968 $sth->execute( $patron_11_1->borrowernumber, 'edit_borrowers' );
969 $sth->execute( $patron_11_1->borrowernumber, 'view_borrower_infos_from_any_libraries' );
970 # patron_11_2 can only see patron's info from its group
971 my $patron_11_2 = $builder->build({ source
=> 'Borrower', value
=> { branchcode
=> $library_11->branchcode, flags
=> undef, }});
972 $patron_11_2 = Koha
::Patrons
->find( $patron_11_2->{borrowernumber
} );
973 $sth->execute( $patron_11_2->borrowernumber, 'edit_borrowers' );
974 # 1 patron from library_12 (group1)
975 my $patron_12 = $builder->build({ source
=> 'Borrower', value
=> { branchcode
=> $library_12->branchcode, flags
=> undef, }});
976 $patron_12 = Koha
::Patrons
->find( $patron_12->{borrowernumber
} );
977 # 1 patron from library_21 (group2) can only see patron's info from its group
978 my $patron_21 = $builder->build({ source
=> 'Borrower', value
=> { branchcode
=> $library_21->branchcode, flags
=> undef, }});
979 $patron_21 = Koha
::Patrons
->find( $patron_21->{borrowernumber
} );
980 $sth->execute( $patron_21->borrowernumber, 'edit_borrowers' );
982 # Pfiou, we can start now!
983 subtest
'libraries_where_can_see_patrons' => sub {
988 set_logged_in_user
( $patron_11_1 );
989 @branchcodes = $patron_11_1->libraries_where_can_see_patrons;
990 is_deeply
( \
@branchcodes, [], q
|patron_11_1 has view_borrower_infos_from_any_libraries
=> No restriction
| );
992 set_logged_in_user
( $patron_11_2 );
993 @branchcodes = $patron_11_2->libraries_where_can_see_patrons;
994 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| );
996 set_logged_in_user( $patron_21 );
997 @branchcodes = $patron_21->libraries_where_can_see_patrons;
998 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
| );
1000 subtest
'can_see_patron_infos' => sub {
1003 set_logged_in_user
( $patron_11_1 );
1004 is
( $patron_11_1->can_see_patron_infos( $patron_11_2 ), 1, q
|patron_11_1 can see patron_11_2
, from its library
| );
1005 is
( $patron_11_1->can_see_patron_infos( $patron_12 ), 1, q
|patron_11_1 can see patron_12
, from its group
| );
1006 is
( $patron_11_1->can_see_patron_infos( $patron_21 ), 1, q
|patron_11_1 can see patron_11_2
, from another group
| );
1008 set_logged_in_user
( $patron_11_2 );
1009 is
( $patron_11_2->can_see_patron_infos( $patron_11_1 ), 1, q
|patron_11_2 can see patron_11_1
, from its library
| );
1010 is
( $patron_11_2->can_see_patron_infos( $patron_12 ), 1, q
|patron_11_2 can see patron_12
, from its group
| );
1011 is
( $patron_11_2->can_see_patron_infos( $patron_21 ), 0, q
|patron_11_2 can NOT see patron_21
, from another group
| );
1013 subtest
'search_limited' => sub {
1016 set_logged_in_user
( $patron_11_1 );
1017 my $total_number_of_patrons = $nb_of_patrons + 6; # 2 created before + 4 for these subtests
1018 is
( Koha
::Patrons
->search->count, $total_number_of_patrons, 'Non-limited search should return all patrons');
1019 is
( Koha
::Patrons
->search_limited->count, $total_number_of_patrons, 'patron_11_1 is allowed to see all patrons' );
1021 set_logged_in_user
( $patron_11_2 );
1022 is
( Koha
::Patrons
->search->count, $total_number_of_patrons, 'Non-limited search should return all patrons');
1023 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' );
1025 set_logged_in_user
( $patron_21 );
1026 is
( Koha
::Patrons
->search->count, $total_number_of_patrons, 'Non-limited search should return all patrons');
1027 is
( Koha
::Patrons
->search_limited->count, 1, 'patron_21 is not allowed to see patrons from other groups, only himself' );
1029 $patron_11_1->delete;
1030 $patron_11_2->delete;
1035 subtest
'account_locked' => sub {
1037 my $patron = $builder->build({ source
=> 'Borrower', value
=> { login_attempts
=> 0 } });
1038 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
1039 for my $value ( undef, '', 0 ) {
1040 t
::lib
::Mocks
::mock_preference
('FailedloginAttempts', $value);
1041 is
( $patron->account_locked, 0, 'Feature is disabled, patron account should not be considered locked' );
1042 $patron->login_attempts(1)->store;
1043 is
( $patron->account_locked, 0, 'Feature is disabled, patron account should not be considered locked' );
1046 t
::lib
::Mocks
::mock_preference
('FailedloginAttempts', 3);
1047 $patron->login_attempts(2)->store;
1048 is
( $patron->account_locked, 0, 'Patron has 2 failed attempts, account should not be considered locked yet' );
1049 $patron->login_attempts(3)->store;
1050 is
( $patron->account_locked, 1, 'Patron has 3 failed attempts, account should be considered locked yet' );
1055 subtest
'is_child | is_adult' => sub {
1057 my $category = $builder->build_object(
1059 class => 'Koha::Patron::Categories',
1060 value
=> { category_type
=> 'A' }
1063 my $patron_adult = $builder->build_object(
1065 class => 'Koha::Patrons',
1066 value
=> { categorycode
=> $category->categorycode }
1069 $category = $builder->build_object(
1071 class => 'Koha::Patron::Categories',
1072 value
=> { category_type
=> 'I' }
1075 my $patron_adult_i = $builder->build_object(
1077 class => 'Koha::Patrons',
1078 value
=> { categorycode
=> $category->categorycode }
1081 $category = $builder->build_object(
1083 class => 'Koha::Patron::Categories',
1084 value
=> { category_type
=> 'C' }
1087 my $patron_child = $builder->build_object(
1089 class => 'Koha::Patrons',
1090 value
=> { categorycode
=> $category->categorycode }
1093 $category = $builder->build_object(
1095 class => 'Koha::Patron::Categories',
1096 value
=> { category_type
=> 'O' }
1099 my $patron_other = $builder->build_object(
1101 class => 'Koha::Patrons',
1102 value
=> { categorycode
=> $category->categorycode }
1105 is
( $patron_adult->is_adult, 1, 'Patron from category A should be considered adult' );
1106 is
( $patron_adult_i->is_adult, 1, 'Patron from category I should be considered adult' );
1107 is
( $patron_child->is_adult, 0, 'Patron from category C should not be considered adult' );
1108 is
( $patron_other->is_adult, 0, 'Patron from category O should not be considered adult' );
1110 is
( $patron_adult->is_child, 0, 'Patron from category A should be considered child' );
1111 is
( $patron_adult_i->is_child, 0, 'Patron from category I should be considered child' );
1112 is
( $patron_child->is_child, 1, 'Patron from category C should not be considered child' );
1113 is
( $patron_other->is_child, 0, 'Patron from category O should not be considered child' );
1116 $patron_adult->delete;
1117 $patron_adult_i->delete;
1118 $patron_child->delete;
1119 $patron_other->delete;
1122 $retrieved_patron_1->delete;
1123 is
( Koha
::Patrons
->search->count, $nb_of_patrons + 1, 'Delete should have deleted the patron' );
1125 subtest
'Log cardnumber change' => sub {
1128 t
::lib
::Mocks
::mock_preference
( 'BorrowersLog', 1 );
1129 my $patron = $builder->build( { source
=> 'Borrower' } );
1131 my $cardnumber = $patron->{cardnumber
};
1132 $patron->{cardnumber
} = 'TESTCARDNUMBER';
1133 ModMember
(%$patron);
1135 my @logs = $schema->resultset('ActionLog')->search( { module
=> 'MEMBERS', action
=> 'MODIFY', object
=> $patron->{borrowernumber
} } );
1136 my $log_info = from_json
( $logs[0]->info );
1137 is
( $log_info->{cardnumber_replaced
}->{new_cardnumber
}, 'TESTCARDNUMBER', 'Got correct new cardnumber' );
1138 is
( $log_info->{cardnumber_replaced
}->{previous_cardnumber
}, $cardnumber, 'Got correct old cardnumber' );
1139 is
( scalar @logs, 2, 'With BorrowerLogs, Change in cardnumber should be logged, as well as general alert of patron mod.' );
1143 $schema->storage->txn_rollback;
1145 # TODO Move to t::lib::Mocks and reuse it!
1146 sub set_logged_in_user
{
1148 C4
::Context
->set_userenv(
1149 $patron->borrowernumber, $patron->userid,
1150 $patron->cardnumber, 'firstname',
1151 'surname', $patron->library->branchcode,
1152 'Midway Public Library', $patron->flags,