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
=> 29;
37 use Koha
::Patron
::Categories
;
40 use Koha
::Virtualshelves
;
42 use t
::lib
::TestBuilder
;
45 my $schema = Koha
::Database
->new->schema;
46 $schema->storage->txn_begin;
48 my $builder = t
::lib
::TestBuilder
->new;
49 my $library = $builder->build({source
=> 'Branch' });
50 my $category = $builder->build({source
=> 'Category' });
51 my $nb_of_patrons = Koha
::Patrons
->search->count;
52 my $new_patron_1 = Koha
::Patron
->new(
53 { cardnumber
=> 'test_cn_1',
54 branchcode
=> $library->{branchcode
},
55 categorycode
=> $category->{categorycode
},
56 surname
=> 'surname for patron1',
57 firstname
=> 'firstname for patron1',
58 userid
=> 'a_nonexistent_userid_1',
59 flags
=> 1, # Is superlibrarian
62 my $new_patron_2 = Koha
::Patron
->new(
63 { cardnumber
=> 'test_cn_2',
64 branchcode
=> $library->{branchcode
},
65 categorycode
=> $category->{categorycode
},
66 surname
=> 'surname for patron2',
67 firstname
=> 'firstname for patron2',
68 userid
=> 'a_nonexistent_userid_2',
72 C4
::Context
->_new_userenv('xxx');
73 set_logged_in_user
( $new_patron_1 );
75 is
( Koha
::Patrons
->search->count, $nb_of_patrons + 2, 'The 2 patrons should have been added' );
77 my $retrieved_patron_1 = Koha
::Patrons
->find( $new_patron_1->borrowernumber );
78 is
( $retrieved_patron_1->cardnumber, $new_patron_1->cardnumber, 'Find a patron by borrowernumber should return the correct patron' );
80 subtest
'library' => sub {
82 is
( $retrieved_patron_1->library->branchcode, $library->{branchcode
}, 'Koha::Patron->library should return the correct library' );
83 is
( ref($retrieved_patron_1->library), 'Koha::Library', 'Koha::Patron->library should return a Koha::Library object' );
86 subtest
'guarantees' => sub {
88 my $guarantees = $new_patron_1->guarantees;
89 is
( ref($guarantees), 'Koha::Patrons', 'Koha::Patron->guarantees should return a Koha::Patrons result set in a scalar context' );
90 is
( $guarantees->count, 0, 'new_patron_1 should have 0 guarantee' );
91 my @guarantees = $new_patron_1->guarantees;
92 is
( ref(\
@guarantees), 'ARRAY', 'Koha::Patron->guarantees should return an array in a list context' );
93 is
( scalar(@guarantees), 0, 'new_patron_1 should have 0 guarantee' );
95 my $guarantee_1 = $builder->build({ source
=> 'Borrower', value
=> { guarantorid
=> $new_patron_1->borrowernumber }});
96 my $guarantee_2 = $builder->build({ source
=> 'Borrower', value
=> { guarantorid
=> $new_patron_1->borrowernumber }});
98 $guarantees = $new_patron_1->guarantees;
99 is
( ref($guarantees), 'Koha::Patrons', 'Koha::Patron->guarantees should return a Koha::Patrons result set in a scalar context' );
100 is
( $guarantees->count, 2, 'new_patron_1 should have 2 guarantees' );
101 @guarantees = $new_patron_1->guarantees;
102 is
( ref(\
@guarantees), 'ARRAY', 'Koha::Patron->guarantees should return an array in a list context' );
103 is
( scalar(@guarantees), 2, 'new_patron_1 should have 2 guarantees' );
104 $_->delete for @guarantees;
107 subtest
'category' => sub {
109 my $patron_category = $new_patron_1->category;
110 is
( ref( $patron_category), 'Koha::Patron::Category', );
111 is
( $patron_category->categorycode, $category->{categorycode
}, );
114 subtest
'siblings' => sub {
116 my $siblings = $new_patron_1->siblings;
117 is
( $siblings, undef, 'Koha::Patron->siblings should not crashed if the patron has no guarantor' );
118 my $guarantee_1 = $builder->build( { source
=> 'Borrower', value
=> { guarantorid
=> $new_patron_1->borrowernumber } } );
119 my $retrieved_guarantee_1 = Koha
::Patrons
->find($guarantee_1);
120 $siblings = $retrieved_guarantee_1->siblings;
121 is
( ref($siblings), 'Koha::Patrons', 'Koha::Patron->siblings should return a Koha::Patrons result set in a scalar context' );
122 my @siblings = $retrieved_guarantee_1->siblings;
123 is
( ref( \
@siblings ), 'ARRAY', 'Koha::Patron->siblings should return an array in a list context' );
124 is
( $siblings->count, 0, 'guarantee_1 should not have siblings yet' );
125 my $guarantee_2 = $builder->build( { source
=> 'Borrower', value
=> { guarantorid
=> $new_patron_1->borrowernumber } } );
126 my $guarantee_3 = $builder->build( { source
=> 'Borrower', value
=> { guarantorid
=> $new_patron_1->borrowernumber } } );
127 $siblings = $retrieved_guarantee_1->siblings;
128 is
( $siblings->count, 2, 'guarantee_1 should have 2 siblings' );
129 is
( $guarantee_2->{borrowernumber
}, $siblings->next->borrowernumber, 'guarantee_2 should exist in the guarantees' );
130 is
( $guarantee_3->{borrowernumber
}, $siblings->next->borrowernumber, 'guarantee_3 should exist in the guarantees' );
131 $_->delete for $retrieved_guarantee_1->siblings;
132 $retrieved_guarantee_1->delete;
135 subtest
'has_overdues' => sub {
138 my $biblioitem_1 = $builder->build( { source
=> 'Biblioitem' } );
139 my $item_1 = $builder->build(
142 homebranch
=> $library->{branchcode
},
143 holdingbranch
=> $library->{branchcode
},
147 biblionumber
=> $biblioitem_1->{biblionumber
}
151 my $retrieved_patron = Koha
::Patrons
->find( $new_patron_1->borrowernumber );
152 is
( $retrieved_patron->has_overdues, 0, );
154 my $tomorrow = DateTime
->today( time_zone
=> C4
::Context
->tz() )->add( days
=> 1 );
155 my $issue = Koha
::Checkout
->new({ borrowernumber
=> $new_patron_1->id, itemnumber
=> $item_1->{itemnumber
}, date_due
=> $tomorrow, branchcode
=> $library->{branchcode
} })->store();
156 is
( $retrieved_patron->has_overdues, 0, );
158 my $yesterday = DateTime
->today(time_zone
=> C4
::Context
->tz())->add( days
=> -1 );
159 $issue = Koha
::Checkout
->new({ borrowernumber
=> $new_patron_1->id, itemnumber
=> $item_1->{itemnumber
}, date_due
=> $yesterday, branchcode
=> $library->{branchcode
} })->store();
160 $retrieved_patron = Koha
::Patrons
->find( $new_patron_1->borrowernumber );
161 is
( $retrieved_patron->has_overdues, 1, );
165 subtest
'update_password' => sub {
168 t
::lib
::Mocks
::mock_preference
( 'BorrowersLog', 1 );
169 my $original_userid = $new_patron_1->userid;
170 my $original_password = $new_patron_1->password;
171 warning_like
{ $retrieved_patron_1->update_password( $new_patron_2->userid, 'another_password' ) }
173 'Koha::Patron->update_password should warn if the userid is already used by another patron';
174 is
( Koha
::Patrons
->find( $new_patron_1->borrowernumber )->userid, $original_userid, 'Koha::Patron->update_password should not have updated the userid' );
175 is
( Koha
::Patrons
->find( $new_patron_1->borrowernumber )->password, $original_password, 'Koha::Patron->update_password should not have updated the userid' );
177 $retrieved_patron_1->update_password( 'another_nonexistent_userid_1', 'another_password' );
178 is
( Koha
::Patrons
->find( $new_patron_1->borrowernumber )->userid, 'another_nonexistent_userid_1', 'Koha::Patron->update_password should have updated the userid' );
179 is
( Koha
::Patrons
->find( $new_patron_1->borrowernumber )->password, 'another_password', 'Koha::Patron->update_password should have updated the password' );
181 my $number_of_logs = $schema->resultset('ActionLog')->search( { module
=> 'MEMBERS', action
=> 'CHANGE PASS', object
=> $new_patron_1->borrowernumber } )->count;
182 is
( $number_of_logs, 1, 'With BorrowerLogs, Koha::Patron->update_password should have logged' );
184 t
::lib
::Mocks
::mock_preference
( 'BorrowersLog', 0 );
185 $retrieved_patron_1->update_password( 'yet_another_nonexistent_userid_1', 'another_password' );
186 $number_of_logs = $schema->resultset('ActionLog')->search( { module
=> 'MEMBERS', action
=> 'CHANGE PASS', object
=> $new_patron_1->borrowernumber } )->count;
187 is
( $number_of_logs, 1, 'With BorrowerLogs, Koha::Patron->update_password should not have logged' );
190 subtest
'is_expired' => sub {
192 my $patron = $builder->build({ source
=> 'Borrower' });
193 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
194 $patron->dateexpiry( undef )->store->discard_changes;
195 is
( $patron->is_expired, 0, 'Patron should not be considered expired if dateexpiry is not set');
196 $patron->dateexpiry( dt_from_string
)->store->discard_changes;
197 is
( $patron->is_expired, 0, 'Patron should not be considered expired if dateexpiry is today');
198 $patron->dateexpiry( dt_from_string
->add( days
=> 1 ) )->store->discard_changes;
199 is
( $patron->is_expired, 0, 'Patron should not be considered expired if dateexpiry is tomorrow');
200 $patron->dateexpiry( dt_from_string
->add( days
=> -1 ) )->store->discard_changes;
201 is
( $patron->is_expired, 1, 'Patron should be considered expired if dateexpiry is yesterday');
206 subtest
'is_going_to_expire' => sub {
208 my $patron = $builder->build({ source
=> 'Borrower' });
209 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
210 $patron->dateexpiry( undef )->store->discard_changes;
211 is
( $patron->is_going_to_expire, 0, 'Patron should not be considered going to expire if dateexpiry is not set');
213 t
::lib
::Mocks
::mock_preference
('NotifyBorrowerDeparture', 0);
214 $patron->dateexpiry( dt_from_string
)->store->discard_changes;
215 is
( $patron->is_going_to_expire, 0, 'Patron should not be considered going to expire if dateexpiry is today');
217 $patron->dateexpiry( dt_from_string
)->store->discard_changes;
218 is
( $patron->is_going_to_expire, 0, 'Patron should not be considered going to expire if dateexpiry is today and pref is 0');
220 t
::lib
::Mocks
::mock_preference
('NotifyBorrowerDeparture', 10);
221 $patron->dateexpiry( dt_from_string
->add( days
=> 11 ) )->store->discard_changes;
222 is
( $patron->is_going_to_expire, 0, 'Patron should not be considered going to expire if dateexpiry is 11 days ahead and pref is 10');
224 t
::lib
::Mocks
::mock_preference
('NotifyBorrowerDeparture', 0);
225 $patron->dateexpiry( dt_from_string
->add( days
=> 10 ) )->store->discard_changes;
226 is
( $patron->is_going_to_expire, 0, 'Patron should not be considered going to expire if dateexpiry is 10 days ahead and pref is 0');
228 t
::lib
::Mocks
::mock_preference
('NotifyBorrowerDeparture', 10);
229 $patron->dateexpiry( dt_from_string
->add( days
=> 10 ) )->store->discard_changes;
230 is
( $patron->is_going_to_expire, 0, 'Patron should not be considered going to expire if dateexpiry is 10 days ahead and pref is 10');
233 t
::lib
::Mocks
::mock_preference
('NotifyBorrowerDeparture', 10);
234 $patron->dateexpiry( dt_from_string
->add( days
=> 20 ) )->store->discard_changes;
235 is
( $patron->is_going_to_expire, 0, 'Patron should not be considered going to expire if dateexpiry is 20 days ahead and pref is 10');
237 t
::lib
::Mocks
::mock_preference
('NotifyBorrowerDeparture', 20);
238 $patron->dateexpiry( dt_from_string
->add( days
=> 10 ) )->store->discard_changes;
239 is
( $patron->is_going_to_expire, 1, 'Patron should be considered going to expire if dateexpiry is 10 days ahead and pref is 20');
245 subtest
'renew_account' => sub {
248 for my $date ( '2016-03-31', '2016-11-30', dt_from_string
() ) {
249 my $dt = dt_from_string
( $date, 'iso' );
250 Time
::Fake
->offset( $dt->epoch );
251 my $a_month_ago = $dt->clone->subtract( months
=> 1, end_of_month
=> 'limit' )->truncate( to
=> 'day' );
252 my $a_year_later = $dt->clone->add( months
=> 12, end_of_month
=> 'limit' )->truncate( to
=> 'day' );
253 my $a_year_later_minus_a_month = $dt->clone->add( months
=> 11, end_of_month
=> 'limit' )->truncate( to
=> 'day' );
254 my $a_month_later = $dt->clone->add( months
=> 1 , end_of_month
=> 'limit' )->truncate( to
=> 'day' );
255 my $a_year_later_plus_a_month = $dt->clone->add( months
=> 13, end_of_month
=> 'limit' )->truncate( to
=> 'day' );
256 my $patron_category = $builder->build(
257 { source
=> 'Category',
259 enrolmentperiod
=> 12,
260 enrolmentperioddate
=> undef,
264 my $patron = $builder->build(
265 { source
=> 'Borrower',
267 dateexpiry
=> $a_month_ago,
268 categorycode
=> $patron_category->{categorycode
},
269 date_renewed
=> undef, # Force builder to not populate the column for new patron
273 my $patron_2 = $builder->build(
274 { source
=> 'Borrower',
276 dateexpiry
=> $a_month_ago,
277 categorycode
=> $patron_category->{categorycode
},
281 my $patron_3 = $builder->build(
282 { source
=> 'Borrower',
284 dateexpiry
=> $a_month_later,
285 categorycode
=> $patron_category->{categorycode
},
289 my $retrieved_patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
290 my $retrieved_patron_2 = Koha
::Patrons
->find( $patron_2->{borrowernumber
} );
291 my $retrieved_patron_3 = Koha
::Patrons
->find( $patron_3->{borrowernumber
} );
293 is
( $retrieved_patron->date_renewed, undef, "Date renewed is not set for patrons that have never been renewed" );
295 t
::lib
::Mocks
::mock_preference
( 'BorrowerRenewalPeriodBase', 'dateexpiry' );
296 t
::lib
::Mocks
::mock_preference
( 'BorrowersLog', 1 );
297 my $expiry_date = $retrieved_patron->renew_account;
298 is
( $expiry_date, $a_year_later_minus_a_month, "$a_month_ago + 12 months must be $a_year_later_minus_a_month" );
299 my $retrieved_expiry_date = Koha
::Patrons
->find( $patron->{borrowernumber
} )->dateexpiry;
300 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" );
301 my $number_of_logs = $schema->resultset('ActionLog')->search( { module
=> 'MEMBERS', action
=> 'RENEW', object
=> $retrieved_patron->borrowernumber } )->count;
302 is
( $number_of_logs, 1, 'With BorrowerLogs, Koha::Patron->renew_account should have logged' );
304 t
::lib
::Mocks
::mock_preference
( 'BorrowerRenewalPeriodBase', 'now' );
305 t
::lib
::Mocks
::mock_preference
( 'BorrowersLog', 0 );
306 $expiry_date = $retrieved_patron->renew_account;
307 is
( $expiry_date, $a_year_later, "today + 12 months must be $a_year_later" );
308 $retrieved_patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
309 is
( $retrieved_patron->date_renewed, output_pref
({ dt
=> $dt, dateformat
=> 'iso', dateonly
=> 1 }), "Date renewed is set when calling renew_account" );
310 $retrieved_expiry_date = $retrieved_patron->dateexpiry;
311 is
( dt_from_string
($retrieved_expiry_date), $a_year_later, "today + 12 months must be $a_year_later" );
312 $number_of_logs = $schema->resultset('ActionLog')->search( { module
=> 'MEMBERS', action
=> 'RENEW', object
=> $retrieved_patron->borrowernumber } )->count;
313 is
( $number_of_logs, 1, 'Without BorrowerLogs, Koha::Patron->renew_account should not have logged' );
315 t
::lib
::Mocks
::mock_preference
( 'BorrowerRenewalPeriodBase', 'combination' );
316 $expiry_date = $retrieved_patron_2->renew_account;
317 is
( $expiry_date, $a_year_later, "today + 12 months must be $a_year_later" );
318 $retrieved_expiry_date = Koha
::Patrons
->find( $patron_2->{borrowernumber
} )->dateexpiry;
319 is
( dt_from_string
($retrieved_expiry_date), $a_year_later, "today + 12 months must be $a_year_later" );
321 $expiry_date = $retrieved_patron_3->renew_account;
322 is
( $expiry_date, $a_year_later_plus_a_month, "$a_month_later + 12 months must be $a_year_later_plus_a_month" );
323 $retrieved_expiry_date = Koha
::Patrons
->find( $patron_3->{borrowernumber
} )->dateexpiry;
324 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" );
326 $retrieved_patron->delete;
327 $retrieved_patron_2->delete;
328 $retrieved_patron_3->delete;
333 subtest
"move_to_deleted" => sub {
335 my $originally_updated_on = '2016-01-01 12:12:12';
336 my $patron = $builder->build( { source
=> 'Borrower',value
=> { updated_on
=> $originally_updated_on } } );
337 my $retrieved_patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
338 is
( ref( $retrieved_patron->move_to_deleted ), 'Koha::Schema::Result::Deletedborrower', 'Koha::Patron->move_to_deleted should return the Deleted patron' )
339 ; # FIXME This should be Koha::Deleted::Patron
340 my $deleted_patron = $schema->resultset('Deletedborrower')
341 ->search( { borrowernumber
=> $patron->{borrowernumber
} }, { result_class
=> 'DBIx::Class::ResultClass::HashRefInflator' } )
343 ok
( $retrieved_patron->updated_on, 'updated_on should be set for borrowers table' );
344 ok
( $deleted_patron->{updated_on
}, 'updated_on should be set for deleted_borrowers table' );
345 isnt
( $deleted_patron->{updated_on
}, $retrieved_patron->updated_on, 'Koha::Patron->move_to_deleted should have correctly updated the updated_on column');
346 $deleted_patron->{updated_on
} = $originally_updated_on; #reset for simplicity in comparing all other fields
347 is_deeply
( $deleted_patron, $patron, 'Koha::Patron->move_to_deleted should have correctly moved the patron to the deleted table' );
348 $retrieved_patron->delete( $patron->{borrowernumber
} ); # Cleanup
351 subtest
"delete" => sub {
353 t
::lib
::Mocks
::mock_preference
( 'BorrowersLog', 1 );
354 my $patron = $builder->build( { source
=> 'Borrower' } );
355 my $retrieved_patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
356 my $hold = $builder->build(
357 { source
=> 'Reserve',
358 value
=> { borrowernumber
=> $patron->{borrowernumber
} }
361 my $list = $builder->build(
362 { source
=> 'Virtualshelve',
363 value
=> { owner
=> $patron->{borrowernumber
} }
367 my $deleted = $retrieved_patron->delete;
368 is
( $deleted, 1, 'Koha::Patron->delete should return 1 if the patron has been correctly deleted' );
370 is
( Koha
::Patrons
->find( $patron->{borrowernumber
} ), undef, 'Koha::Patron->delete should have deleted the patron' );
372 is
( Koha
::Holds
->search( { borrowernumber
=> $patron->{borrowernumber
} } )->count, 0, q
|Koha
::Patron
->delete should have deleted patron
's holds| );
374 is( Koha::Virtualshelves->search( { owner => $patron->{borrowernumber} } )->count, 0, q|Koha::Patron->delete should have deleted patron's lists
| );
376 my $number_of_logs = $schema->resultset('ActionLog')->search( { module
=> 'MEMBERS', action
=> 'DELETE', object
=> $retrieved_patron->borrowernumber } )->count;
377 is
( $number_of_logs, 1, 'With BorrowerLogs, Koha::Patron->delete should have logged' );
380 subtest
'add_enrolment_fee_if_needed' => sub {
383 my $enrolmentfees = { K
=> 5, J
=> 10, YA
=> 20 };
384 foreach( keys %{$enrolmentfees} ) {
385 ( Koha
::Patron
::Categories
->find( $_ ) // $builder->build_object({ class => 'Koha::Patron::Categories', value
=> { categorycode
=> $_ } }) )->enrolmentfee( $enrolmentfees->{$_} )->store;
387 my $enrolmentfee_K = $enrolmentfees->{K
};
388 my $enrolmentfee_J = $enrolmentfees->{J
};
389 my $enrolmentfee_YA = $enrolmentfees->{YA
};
391 my %borrower_data = (
392 firstname
=> 'my firstname',
393 surname
=> 'my surname',
395 branchcode
=> $library->{branchcode
},
398 my $borrowernumber = C4
::Members
::AddMember
(%borrower_data);
399 $borrower_data{borrowernumber
} = $borrowernumber;
401 my $patron = Koha
::Patrons
->find( $borrowernumber );
402 my $total = $patron->account->balance;
403 is
( int($total), int($enrolmentfee_K), "New kid pay $enrolmentfee_K" );
405 t
::lib
::Mocks
::mock_preference
( 'FeeOnChangePatronCategory', 0 );
406 $borrower_data{categorycode
} = 'J';
407 C4
::Members
::ModMember
(%borrower_data);
408 $total = $patron->account->balance;
409 is
( int($total), int($enrolmentfee_K), "Kid growing and become a juvenile, but shouldn't pay for the upgrade " );
411 $borrower_data{categorycode
} = 'K';
412 C4
::Members
::ModMember
(%borrower_data);
413 t
::lib
::Mocks
::mock_preference
( 'FeeOnChangePatronCategory', 1 );
415 $borrower_data{categorycode
} = 'J';
416 C4
::Members
::ModMember
(%borrower_data);
417 $total = $patron->account->balance;
418 is
( int($total), int($enrolmentfee_K + $enrolmentfee_J), "Kid growing and become a juvenile, they should pay " . ( $enrolmentfee_K + $enrolmentfee_J ) );
420 # Check with calling directly Koha::Patron->get_enrolment_fee_if_needed
421 $patron->categorycode('YA')->store;
422 my $fee = $patron->add_enrolment_fee_if_needed;
423 $total = $patron->account->balance;
425 int($enrolmentfee_K + $enrolmentfee_J + $enrolmentfee_YA),
426 "Juvenile growing and become an young adult, they should pay " . ( $enrolmentfee_K + $enrolmentfee_J + $enrolmentfee_YA )
432 subtest
'checkouts + pending_checkouts + get_overdues + old_checkouts' => sub {
435 my $library = $builder->build( { source
=> 'Branch' } );
436 my ($biblionumber_1) = AddBiblio
( MARC
::Record
->new, '' );
437 my $item_1 = $builder->build(
441 homebranch
=> $library->{branchcode
},
442 holdingbranch
=> $library->{branchcode
},
443 biblionumber
=> $biblionumber_1,
449 my $item_2 = $builder->build(
453 homebranch
=> $library->{branchcode
},
454 holdingbranch
=> $library->{branchcode
},
455 biblionumber
=> $biblionumber_1,
461 my ($biblionumber_2) = AddBiblio
( MARC
::Record
->new, '' );
462 my $item_3 = $builder->build(
466 homebranch
=> $library->{branchcode
},
467 holdingbranch
=> $library->{branchcode
},
468 biblionumber
=> $biblionumber_2,
474 my $patron = $builder->build(
476 source
=> 'Borrower',
477 value
=> { branchcode
=> $library->{branchcode
} }
481 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
482 my $checkouts = $patron->checkouts;
483 is
( $checkouts->count, 0, 'checkouts should not return any issues for that patron' );
484 is
( ref($checkouts), 'Koha::Checkouts', 'checkouts should return a Koha::Checkouts object' );
485 my $pending_checkouts = $patron->pending_checkouts;
486 is
( $pending_checkouts->count, 0, 'pending_checkouts should not return any issues for that patron' );
487 is
( ref($pending_checkouts), 'Koha::Checkouts', 'pending_checkouts should return a Koha::Checkouts object' );
488 my $old_checkouts = $patron->old_checkouts;
489 is
( $old_checkouts->count, 0, 'old_checkouts should not return any issues for that patron' );
490 is
( ref($old_checkouts), 'Koha::Old::Checkouts', 'old_checkouts should return a Koha::Old::Checkouts object' );
492 # Not sure how this is useful, but AddIssue pass this variable to different other subroutines
493 $patron = Koha
::Patrons
->find( $patron->borrowernumber )->unblessed;
495 my $module = new Test
::MockModule
('C4::Context');
496 $module->mock( 'userenv', sub { { branch
=> $library->{branchcode
} } } );
498 AddIssue
( $patron, $item_1->{barcode
}, DateTime
->now->subtract( days
=> 1 ) );
499 AddIssue
( $patron, $item_2->{barcode
}, DateTime
->now->subtract( days
=> 5 ) );
500 AddIssue
( $patron, $item_3->{barcode
} );
502 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
503 $checkouts = $patron->checkouts;
504 is
( $checkouts->count, 3, 'checkouts should return 3 issues for that patron' );
505 is
( ref($checkouts), 'Koha::Checkouts', 'checkouts should return a Koha::Checkouts object' );
506 $pending_checkouts = $patron->pending_checkouts;
507 is
( $pending_checkouts->count, 3, 'pending_checkouts should return 3 issues for that patron' );
508 is
( ref($pending_checkouts), 'Koha::Checkouts', 'pending_checkouts should return a Koha::Checkouts object' );
510 my $first_checkout = $pending_checkouts->next;
511 is
( $first_checkout->unblessed_all_relateds->{biblionumber
}, $item_3->{biblionumber
}, 'pending_checkouts should prefetch values from other tables (here biblio)' );
513 my $overdues = $patron->get_overdues;
514 is
( $overdues->count, 2, 'Patron should have 2 overdues');
515 is
( ref($overdues), 'Koha::Checkouts', 'Koha::Patron->get_overdues should return Koha::Checkouts' );
516 is
( $overdues->next->itemnumber, $item_1->{itemnumber
}, 'The issue should be returned in the same order as they have been done, first is correct' );
517 is
( $overdues->next->itemnumber, $item_2->{itemnumber
}, 'The issue should be returned in the same order as they have been done, second is correct' );
520 C4
::Circulation
::AddReturn
( $item_1->{barcode
} );
521 C4
::Circulation
::AddReturn
( $item_2->{barcode
} );
522 $old_checkouts = $patron->old_checkouts;
523 is
( $old_checkouts->count, 2, 'old_checkouts should return 2 old checkouts that patron' );
524 is
( ref($old_checkouts), 'Koha::Old::Checkouts', 'old_checkouts should return a Koha::Old::Checkouts object' );
527 Koha
::Checkouts
->search( { borrowernumber
=> $patron->borrowernumber } )->delete;
529 $module->unmock('userenv');
532 subtest
'get_age' => sub {
535 my $patron = $builder->build( { source
=> 'Borrower' } );
536 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
538 my $today = dt_from_string
;
540 $patron->dateofbirth( undef );
541 is
( $patron->get_age, undef, 'get_age should return undef if no dateofbirth is defined' );
542 $patron->dateofbirth( $today->clone->add( years
=> -12, months
=> -6, days
=> -1, end_of_month
=> 'limit' ) );
543 is
( $patron->get_age, 12, 'Patron should be 12' );
544 $patron->dateofbirth( $today->clone->add( years
=> -18, months
=> 0, days
=> 1, end_of_month
=> 'limit' ) );
545 is
( $patron->get_age, 17, 'Patron should be 17, happy birthday tomorrow!' );
546 $patron->dateofbirth( $today->clone->add( years
=> -18, months
=> 0, days
=> 0, end_of_month
=> 'limit' ) );
547 is
( $patron->get_age, 18, 'Patron should be 18' );
548 $patron->dateofbirth( $today->clone->add( years
=> -18, months
=> -12, days
=> -31, end_of_month
=> 'limit' ) );
549 is
( $patron->get_age, 19, 'Patron should be 19' );
550 $patron->dateofbirth( $today->clone->add( years
=> -18, months
=> -12, days
=> -30, end_of_month
=> 'limit' ) );
551 is
( $patron->get_age, 19, 'Patron should be 19 again' );
552 $patron->dateofbirth( $today->clone->add( years
=> 0, months
=> -1, days
=> -1, end_of_month
=> 'limit' ) );
553 is
( $patron->get_age, 0, 'Patron is a newborn child' );
558 subtest
'account' => sub {
561 my $patron = $builder->build({source
=> 'Borrower'});
563 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
564 my $account = $patron->account;
565 is
( ref($account), 'Koha::Account', 'account should return a Koha::Account object' );
570 subtest
'search_upcoming_membership_expires' => sub {
573 my $expiry_days = 15;
574 t
::lib
::Mocks
::mock_preference
( 'MembershipExpiryDaysNotice', $expiry_days );
575 my $nb_of_days_before = 1;
576 my $nb_of_days_after = 2;
578 my $builder = t
::lib
::TestBuilder
->new();
580 my $library = $builder->build({ source
=> 'Branch' });
582 # before we add borrowers to this branch, add the expires we have now
583 # note that this pertains to the current mocked setting of the pref
584 # for this reason we add the new branchcode to most of the tests
585 my $nb_of_expires = Koha
::Patrons
->search_upcoming_membership_expires->count;
587 my $patron_1 = $builder->build({
588 source
=> 'Borrower',
590 branchcode
=> $library->{branchcode
},
591 dateexpiry
=> dt_from_string
->add( days
=> $expiry_days )
595 my $patron_2 = $builder->build({
596 source
=> 'Borrower',
598 branchcode
=> $library->{branchcode
},
599 dateexpiry
=> dt_from_string
->add( days
=> $expiry_days - $nb_of_days_before )
603 my $patron_3 = $builder->build({
604 source
=> 'Borrower',
606 branchcode
=> $library->{branchcode
},
607 dateexpiry
=> dt_from_string
->add( days
=> $expiry_days + $nb_of_days_after )
611 # Test without extra parameters
612 my $upcoming_mem_expires = Koha
::Patrons
->search_upcoming_membership_expires();
613 is
( $upcoming_mem_expires->count, $nb_of_expires + 1, 'Get upcoming membership expires should return one new borrower.' );
616 $upcoming_mem_expires = Koha
::Patrons
->search_upcoming_membership_expires({ 'me.branchcode' => $library->{branchcode
} });
617 is
( $upcoming_mem_expires->count, 1, 'Test with branch parameter' );
618 my $expired = $upcoming_mem_expires->next;
619 is
( $expired->surname, $patron_1->{surname
}, 'Get upcoming membership expires should return the correct patron.' );
620 is
( $expired->library->branchemail, $library->{branchemail
}, 'Get upcoming membership expires should return the correct patron.' );
621 is
( $expired->branchcode, $patron_1->{branchcode
}, 'Get upcoming membership expires should return the correct patron.' );
623 t
::lib
::Mocks
::mock_preference
( 'MembershipExpiryDaysNotice', 0 );
624 $upcoming_mem_expires = Koha
::Patrons
->search_upcoming_membership_expires({ 'me.branchcode' => $library->{branchcode
} });
625 is
( $upcoming_mem_expires->count, 0, 'Get upcoming membership expires with MembershipExpiryDaysNotice==0 should not return new records.' );
627 # Test MembershipExpiryDaysNotice == undef
628 t
::lib
::Mocks
::mock_preference
( 'MembershipExpiryDaysNotice', undef );
629 $upcoming_mem_expires = Koha
::Patrons
->search_upcoming_membership_expires({ 'me.branchcode' => $library->{branchcode
} });
630 is
( $upcoming_mem_expires->count, 0, 'Get upcoming membership expires without MembershipExpiryDaysNotice should not return new records.' );
632 # Test the before parameter
633 t
::lib
::Mocks
::mock_preference
( 'MembershipExpiryDaysNotice', 15 );
634 $upcoming_mem_expires = Koha
::Patrons
->search_upcoming_membership_expires({ 'me.branchcode' => $library->{branchcode
}, before
=> $nb_of_days_before });
635 is
( $upcoming_mem_expires->count, 2, 'Expect two results for before');
636 # Test after parameter also
637 $upcoming_mem_expires = Koha
::Patrons
->search_upcoming_membership_expires({ 'me.branchcode' => $library->{branchcode
}, before
=> $nb_of_days_before, after
=> $nb_of_days_after });
638 is
( $upcoming_mem_expires->count, 3, 'Expect three results when adding after' );
639 Koha
::Patrons
->search({ borrowernumber
=> { in => [ $patron_1->{borrowernumber
}, $patron_2->{borrowernumber
}, $patron_3->{borrowernumber
} ] } })->delete;
642 subtest
'holds and old_holds' => sub {
645 my $library = $builder->build( { source
=> 'Branch' } );
646 my ($biblionumber_1) = AddBiblio
( MARC
::Record
->new, '' );
647 my $item_1 = $builder->build(
651 homebranch
=> $library->{branchcode
},
652 holdingbranch
=> $library->{branchcode
},
653 biblionumber
=> $biblionumber_1
657 my $item_2 = $builder->build(
661 homebranch
=> $library->{branchcode
},
662 holdingbranch
=> $library->{branchcode
},
663 biblionumber
=> $biblionumber_1
667 my ($biblionumber_2) = AddBiblio
( MARC
::Record
->new, '' );
668 my $item_3 = $builder->build(
672 homebranch
=> $library->{branchcode
},
673 holdingbranch
=> $library->{branchcode
},
674 biblionumber
=> $biblionumber_2
678 my $patron = $builder->build(
680 source
=> 'Borrower',
681 value
=> { branchcode
=> $library->{branchcode
} }
685 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
686 my $holds = $patron->holds;
687 is
( ref($holds), 'Koha::Holds',
688 'Koha::Patron->holds should return a Koha::Holds objects' );
689 is
( $holds->count, 0, 'There should not be holds placed by this patron yet' );
691 C4
::Reserves
::AddReserve
( $library->{branchcode
},
692 $patron->borrowernumber, $biblionumber_1 );
694 C4
::Reserves
::AddReserve
( $library->{branchcode
},
695 $patron->borrowernumber, $biblionumber_2, undef, undef, dt_from_string
->add( days
=> 2 ) );
697 $holds = $patron->holds;
698 is
( $holds->count, 2, 'There should be 2 holds placed by this patron' );
700 my $old_holds = $patron->old_holds;
701 is
( ref($old_holds), 'Koha::Old::Holds',
702 'Koha::Patron->old_holds should return a Koha::Old::Holds objects' );
703 is
( $old_holds->count, 0, 'There should not be any old holds yet');
705 my $hold = $holds->next;
708 $old_holds = $patron->old_holds;
709 is
( $old_holds->count, 1, 'There should be 1 old (cancelled) hold');
716 subtest
'notice_email_address' => sub {
719 my $patron = $builder->build_object({ class => 'Koha::Patrons' });
721 t
::lib
::Mocks
::mock_preference
( 'AutoEmailPrimaryAddress', 'OFF' );
722 is
($patron->notice_email_address, $patron->email, "Koha::Patron->notice_email_address returns correct value when AutoEmailPrimaryAddress is off");
724 t
::lib
::Mocks
::mock_preference
( 'AutoEmailPrimaryAddress', 'emailpro' );
725 is
($patron->notice_email_address, $patron->emailpro, "Koha::Patron->notice_email_address returns correct value when AutoEmailPrimaryAddress is emailpro");
730 subtest
'search_patrons_to_anonymise & anonymise_issue_history' => sub {
733 # TODO create a subroutine in t::lib::Mocks
734 my $branch = $builder->build({ source
=> 'Branch' });
735 my $userenv_patron = $builder->build({
736 source
=> 'Borrower',
737 value
=> { branchcode
=> $branch->{branchcode
} },
739 C4
::Context
->_new_userenv('DUMMY SESSION');
740 C4
::Context
->set_userenv(
741 $userenv_patron->{borrowernumber
},
742 $userenv_patron->{userid
},
743 'usercnum', 'First name', 'Surname',
744 $branch->{branchcode
},
745 $branch->{branchname
},
748 my $anonymous = $builder->build( { source
=> 'Borrower', }, );
750 t
::lib
::Mocks
::mock_preference
( 'AnonymousPatron', $anonymous->{borrowernumber
} );
752 subtest
'patron privacy is 1 (default)' => sub {
755 t
::lib
::Mocks
::mock_preference
('IndependentBranches', 0);
756 my $patron = $builder->build(
757 { source
=> 'Borrower',
758 value
=> { privacy
=> 1, }
761 my $item_1 = $builder->build(
769 my $issue_1 = $builder->build(
772 borrowernumber
=> $patron->{borrowernumber
},
773 itemnumber
=> $item_1->{itemnumber
},
777 my $item_2 = $builder->build(
785 my $issue_2 = $builder->build(
788 borrowernumber
=> $patron->{borrowernumber
},
789 itemnumber
=> $item_2->{itemnumber
},
794 my ( $returned_1, undef, undef ) = C4
::Circulation
::AddReturn
( $item_1->{barcode
}, undef, undef, undef, '2010-10-10' );
795 my ( $returned_2, undef, undef ) = C4
::Circulation
::AddReturn
( $item_2->{barcode
}, undef, undef, undef, '2011-11-11' );
796 is
( $returned_1 && $returned_2, 1, 'The items should have been returned' );
798 my $patrons_to_anonymise = Koha
::Patrons
->search_patrons_to_anonymise( { before
=> '2010-10-11' } )->search( { 'me.borrowernumber' => $patron->{borrowernumber
} } );
799 is
( ref($patrons_to_anonymise), 'Koha::Patrons', 'search_patrons_to_anonymise should return Koha::Patrons' );
801 my $rows_affected = Koha
::Patrons
->search_patrons_to_anonymise( { before
=> '2011-11-12' } )->anonymise_issue_history( { before
=> '2010-10-11' } );
802 ok
( $rows_affected > 0, 'AnonymiseIssueHistory should affect at least 1 row' );
804 my $dbh = C4
::Context
->dbh;
805 my $sth = $dbh->prepare(q
|SELECT borrowernumber FROM old_issues where itemnumber
= ?
|);
806 $sth->execute($item_1->{itemnumber
});
807 my ($borrowernumber_used_to_anonymised) = $sth->fetchrow_array;
808 is
( $borrowernumber_used_to_anonymised, $anonymous->{borrowernumber
}, 'With privacy=1, the issue should have been anonymised' );
809 $sth->execute($item_2->{itemnumber
});
810 ($borrowernumber_used_to_anonymised) = $sth->fetchrow_array;
811 is
( $borrowernumber_used_to_anonymised, $patron->{borrowernumber
}, 'The issue should not have been anonymised, the returned date is later' );
813 $rows_affected = Koha
::Patrons
->search_patrons_to_anonymise( { before
=> '2011-11-12' } )->anonymise_issue_history;
814 $sth->execute($item_2->{itemnumber
});
815 ($borrowernumber_used_to_anonymised) = $sth->fetchrow_array;
816 is
( $borrowernumber_used_to_anonymised, $anonymous->{borrowernumber
}, 'The issue should have been anonymised, the returned date is before' );
818 my $sth_reset = $dbh->prepare(q
|UPDATE old_issues SET borrowernumber
= ? WHERE itemnumber
= ?
|);
819 $sth_reset->execute( $patron->{borrowernumber
}, $item_1->{itemnumber
} );
820 $sth_reset->execute( $patron->{borrowernumber
}, $item_2->{itemnumber
} );
821 $rows_affected = Koha
::Patrons
->search_patrons_to_anonymise->anonymise_issue_history;
822 $sth->execute($item_1->{itemnumber
});
823 ($borrowernumber_used_to_anonymised) = $sth->fetchrow_array;
824 is
( $borrowernumber_used_to_anonymised, $anonymous->{borrowernumber
}, 'The issue 1 should have been anonymised, before parameter was not passed' );
825 $sth->execute($item_2->{itemnumber
});
826 ($borrowernumber_used_to_anonymised) = $sth->fetchrow_array;
827 is
( $borrowernumber_used_to_anonymised, $anonymous->{borrowernumber
}, 'The issue 2 should have been anonymised, before parameter was not passed' );
829 Koha
::Patrons
->find( $patron->{borrowernumber
})->delete;
832 subtest
'patron privacy is 0 (forever)' => sub {
835 t
::lib
::Mocks
::mock_preference
('IndependentBranches', 0);
836 my $patron = $builder->build(
837 { source
=> 'Borrower',
838 value
=> { privacy
=> 0, }
841 my $item = $builder->build(
849 my $issue = $builder->build(
852 borrowernumber
=> $patron->{borrowernumber
},
853 itemnumber
=> $item->{itemnumber
},
858 my ( $returned, undef, undef ) = C4
::Circulation
::AddReturn
( $item->{barcode
}, undef, undef, undef, '2010-10-10' );
859 is
( $returned, 1, 'The item should have been returned' );
860 my $rows_affected = Koha
::Patrons
->search_patrons_to_anonymise( { before
=> '2010-10-11' } )->anonymise_issue_history( { before
=> '2010-10-11' } );
861 ok
( $rows_affected > 0, 'AnonymiseIssueHistory should not return any error if success' );
863 my $dbh = C4
::Context
->dbh;
864 my ($borrowernumber_used_to_anonymised) = $dbh->selectrow_array(q
|
865 SELECT borrowernumber FROM old_issues where itemnumber
= ?
866 |, undef, $item->{itemnumber
});
867 is
( $borrowernumber_used_to_anonymised, $patron->{borrowernumber
}, 'With privacy=0, the issue should not be anonymised' );
868 Koha
::Patrons
->find( $patron->{borrowernumber
})->delete;
871 t
::lib
::Mocks
::mock_preference
( 'AnonymousPatron', '' );
873 subtest
'AnonymousPatron is not defined' => sub {
876 t
::lib
::Mocks
::mock_preference
('IndependentBranches', 0);
877 my $patron = $builder->build(
878 { source
=> 'Borrower',
879 value
=> { privacy
=> 1, }
882 my $item = $builder->build(
890 my $issue = $builder->build(
893 borrowernumber
=> $patron->{borrowernumber
},
894 itemnumber
=> $item->{itemnumber
},
899 my ( $returned, undef, undef ) = C4
::Circulation
::AddReturn
( $item->{barcode
}, undef, undef, undef, '2010-10-10' );
900 is
( $returned, 1, 'The item should have been returned' );
901 my $rows_affected = Koha
::Patrons
->search_patrons_to_anonymise( { before
=> '2010-10-11' } )->anonymise_issue_history( { before
=> '2010-10-11' } );
902 ok
( $rows_affected > 0, 'AnonymiseIssueHistory should affect at least 1 row' );
904 my $dbh = C4
::Context
->dbh;
905 my ($borrowernumber_used_to_anonymised) = $dbh->selectrow_array(q
|
906 SELECT borrowernumber FROM old_issues where itemnumber
= ?
907 |, undef, $item->{itemnumber
});
908 is
( $borrowernumber_used_to_anonymised, undef, 'With AnonymousPatron is not defined, the issue should have been anonymised anyway' );
909 Koha
::Patrons
->find( $patron->{borrowernumber
})->delete;
912 subtest
'Logged in librarian is not superlibrarian & IndependentBranches' => sub {
914 t
::lib
::Mocks
::mock_preference
( 'IndependentBranches', 1 );
915 my $patron = $builder->build(
916 { source
=> 'Borrower',
917 value
=> { privacy
=> 1 } # Another branchcode than the logged in librarian
920 my $item = $builder->build(
928 my $issue = $builder->build(
931 borrowernumber
=> $patron->{borrowernumber
},
932 itemnumber
=> $item->{itemnumber
},
937 my ( $returned, undef, undef ) = C4
::Circulation
::AddReturn
( $item->{barcode
}, undef, undef, undef, '2010-10-10' );
938 is
( Koha
::Patrons
->search_patrons_to_anonymise( { before
=> '2010-10-11' } )->count, 0 );
939 Koha
::Patrons
->find( $patron->{borrowernumber
})->delete;
942 Koha
::Patrons
->find( $anonymous->{borrowernumber
})->delete;
943 Koha
::Patrons
->find( $userenv_patron->{borrowernumber
})->delete;
945 # Reset IndependentBranches for further tests
946 t
::lib
::Mocks
::mock_preference
('IndependentBranches', 0);
949 subtest
'libraries_where_can_see_patrons + can_see_patron_infos + search_limited' => sub {
957 my $group_1 = Koha
::Library
::Group
->new( { title
=> 'TEST Group 1', ft_hide_patron_info
=> 1 } )->store;
958 my $group_2 = Koha
::Library
::Group
->new( { title
=> 'TEST Group 2', ft_hide_patron_info
=> 1 } )->store;
959 my $library_11 = $builder->build( { source
=> 'Branch' } );
960 my $library_12 = $builder->build( { source
=> 'Branch' } );
961 my $library_21 = $builder->build( { source
=> 'Branch' } );
962 $library_11 = Koha
::Libraries
->find( $library_11->{branchcode
} );
963 $library_12 = Koha
::Libraries
->find( $library_12->{branchcode
} );
964 $library_21 = Koha
::Libraries
->find( $library_21->{branchcode
} );
965 Koha
::Library
::Group
->new(
966 { branchcode
=> $library_11->branchcode, parent_id
=> $group_1->id } )->store;
967 Koha
::Library
::Group
->new(
968 { branchcode
=> $library_12->branchcode, parent_id
=> $group_1->id } )->store;
969 Koha
::Library
::Group
->new(
970 { branchcode
=> $library_21->branchcode, parent_id
=> $group_2->id } )->store;
972 my $sth = C4
::Context
->dbh->prepare(q
|INSERT INTO user_permissions
( borrowernumber
, module_bit
, code
) VALUES
(?
, 4, ?
)|); # 4 for borrowers
973 # 2 patrons from library_11 (group1)
974 # patron_11_1 see patron's infos from outside its group
975 # Setting flags => undef to not be considered as superlibrarian
976 my $patron_11_1 = $builder->build({ source
=> 'Borrower', value
=> { branchcode
=> $library_11->branchcode, flags
=> undef, }});
977 $patron_11_1 = Koha
::Patrons
->find( $patron_11_1->{borrowernumber
} );
978 $sth->execute( $patron_11_1->borrowernumber, 'edit_borrowers' );
979 $sth->execute( $patron_11_1->borrowernumber, 'view_borrower_infos_from_any_libraries' );
980 # patron_11_2 can only see patron's info from its group
981 my $patron_11_2 = $builder->build({ source
=> 'Borrower', value
=> { branchcode
=> $library_11->branchcode, flags
=> undef, }});
982 $patron_11_2 = Koha
::Patrons
->find( $patron_11_2->{borrowernumber
} );
983 $sth->execute( $patron_11_2->borrowernumber, 'edit_borrowers' );
984 # 1 patron from library_12 (group1)
985 my $patron_12 = $builder->build({ source
=> 'Borrower', value
=> { branchcode
=> $library_12->branchcode, flags
=> undef, }});
986 $patron_12 = Koha
::Patrons
->find( $patron_12->{borrowernumber
} );
987 # 1 patron from library_21 (group2) can only see patron's info from its group
988 my $patron_21 = $builder->build({ source
=> 'Borrower', value
=> { branchcode
=> $library_21->branchcode, flags
=> undef, }});
989 $patron_21 = Koha
::Patrons
->find( $patron_21->{borrowernumber
} );
990 $sth->execute( $patron_21->borrowernumber, 'edit_borrowers' );
992 # Pfiou, we can start now!
993 subtest
'libraries_where_can_see_patrons' => sub {
998 set_logged_in_user
( $patron_11_1 );
999 @branchcodes = $patron_11_1->libraries_where_can_see_patrons;
1000 is_deeply
( \
@branchcodes, [], q
|patron_11_1 has view_borrower_infos_from_any_libraries
=> No restriction
| );
1002 set_logged_in_user
( $patron_11_2 );
1003 @branchcodes = $patron_11_2->libraries_where_can_see_patrons;
1004 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| );
1006 set_logged_in_user( $patron_21 );
1007 @branchcodes = $patron_21->libraries_where_can_see_patrons;
1008 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
| );
1010 subtest
'can_see_patron_infos' => sub {
1013 set_logged_in_user
( $patron_11_1 );
1014 is
( $patron_11_1->can_see_patron_infos( $patron_11_2 ), 1, q
|patron_11_1 can see patron_11_2
, from its library
| );
1015 is
( $patron_11_1->can_see_patron_infos( $patron_12 ), 1, q
|patron_11_1 can see patron_12
, from its group
| );
1016 is
( $patron_11_1->can_see_patron_infos( $patron_21 ), 1, q
|patron_11_1 can see patron_11_2
, from another group
| );
1018 set_logged_in_user
( $patron_11_2 );
1019 is
( $patron_11_2->can_see_patron_infos( $patron_11_1 ), 1, q
|patron_11_2 can see patron_11_1
, from its library
| );
1020 is
( $patron_11_2->can_see_patron_infos( $patron_12 ), 1, q
|patron_11_2 can see patron_12
, from its group
| );
1021 is
( $patron_11_2->can_see_patron_infos( $patron_21 ), 0, q
|patron_11_2 can NOT see patron_21
, from another group
| );
1023 subtest
'search_limited' => sub {
1026 set_logged_in_user
( $patron_11_1 );
1027 my $total_number_of_patrons = $nb_of_patrons + 6; # 2 created before + 4 for these subtests
1028 is
( Koha
::Patrons
->search->count, $total_number_of_patrons, 'Non-limited search should return all patrons');
1029 is
( Koha
::Patrons
->search_limited->count, $total_number_of_patrons, 'patron_11_1 is allowed to see all patrons' );
1031 set_logged_in_user
( $patron_11_2 );
1032 is
( Koha
::Patrons
->search->count, $total_number_of_patrons, 'Non-limited search should return all patrons');
1033 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' );
1035 set_logged_in_user
( $patron_21 );
1036 is
( Koha
::Patrons
->search->count, $total_number_of_patrons, 'Non-limited search should return all patrons');
1037 is
( Koha
::Patrons
->search_limited->count, 1, 'patron_21 is not allowed to see patrons from other groups, only himself' );
1039 $patron_11_1->delete;
1040 $patron_11_2->delete;
1045 subtest
'account_locked' => sub {
1047 my $patron = $builder->build({ source
=> 'Borrower', value
=> { login_attempts
=> 0 } });
1048 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
1049 for my $value ( undef, '', 0 ) {
1050 t
::lib
::Mocks
::mock_preference
('FailedloginAttempts', $value);
1051 is
( $patron->account_locked, 0, 'Feature is disabled, patron account should not be considered locked' );
1052 $patron->login_attempts(1)->store;
1053 is
( $patron->account_locked, 0, 'Feature is disabled, patron account should not be considered locked' );
1056 t
::lib
::Mocks
::mock_preference
('FailedloginAttempts', 3);
1057 $patron->login_attempts(2)->store;
1058 is
( $patron->account_locked, 0, 'Patron has 2 failed attempts, account should not be considered locked yet' );
1059 $patron->login_attempts(3)->store;
1060 is
( $patron->account_locked, 1, 'Patron has 3 failed attempts, account should be considered locked yet' );
1065 subtest
'is_child | is_adult' => sub {
1067 my $category = $builder->build_object(
1069 class => 'Koha::Patron::Categories',
1070 value
=> { category_type
=> 'A' }
1073 my $patron_adult = $builder->build_object(
1075 class => 'Koha::Patrons',
1076 value
=> { categorycode
=> $category->categorycode }
1079 $category = $builder->build_object(
1081 class => 'Koha::Patron::Categories',
1082 value
=> { category_type
=> 'I' }
1085 my $patron_adult_i = $builder->build_object(
1087 class => 'Koha::Patrons',
1088 value
=> { categorycode
=> $category->categorycode }
1091 $category = $builder->build_object(
1093 class => 'Koha::Patron::Categories',
1094 value
=> { category_type
=> 'C' }
1097 my $patron_child = $builder->build_object(
1099 class => 'Koha::Patrons',
1100 value
=> { categorycode
=> $category->categorycode }
1103 $category = $builder->build_object(
1105 class => 'Koha::Patron::Categories',
1106 value
=> { category_type
=> 'O' }
1109 my $patron_other = $builder->build_object(
1111 class => 'Koha::Patrons',
1112 value
=> { categorycode
=> $category->categorycode }
1115 is
( $patron_adult->is_adult, 1, 'Patron from category A should be considered adult' );
1116 is
( $patron_adult_i->is_adult, 1, 'Patron from category I should be considered adult' );
1117 is
( $patron_child->is_adult, 0, 'Patron from category C should not be considered adult' );
1118 is
( $patron_other->is_adult, 0, 'Patron from category O should not be considered adult' );
1120 is
( $patron_adult->is_child, 0, 'Patron from category A should be considered child' );
1121 is
( $patron_adult_i->is_child, 0, 'Patron from category I should be considered child' );
1122 is
( $patron_child->is_child, 1, 'Patron from category C should not be considered child' );
1123 is
( $patron_other->is_child, 0, 'Patron from category O should not be considered child' );
1126 $patron_adult->delete;
1127 $patron_adult_i->delete;
1128 $patron_child->delete;
1129 $patron_other->delete;
1132 subtest
'get_overdues' => sub {
1135 my $library = $builder->build( { source
=> 'Branch' } );
1136 my ($biblionumber_1) = AddBiblio
( MARC
::Record
->new, '' );
1137 my $item_1 = $builder->build(
1141 homebranch
=> $library->{branchcode
},
1142 holdingbranch
=> $library->{branchcode
},
1143 biblionumber
=> $biblionumber_1
1147 my $item_2 = $builder->build(
1151 homebranch
=> $library->{branchcode
},
1152 holdingbranch
=> $library->{branchcode
},
1153 biblionumber
=> $biblionumber_1
1157 my ($biblionumber_2) = AddBiblio
( MARC
::Record
->new, '' );
1158 my $item_3 = $builder->build(
1162 homebranch
=> $library->{branchcode
},
1163 holdingbranch
=> $library->{branchcode
},
1164 biblionumber
=> $biblionumber_2
1168 my $patron = $builder->build(
1170 source
=> 'Borrower',
1171 value
=> { branchcode
=> $library->{branchcode
} }
1175 my $module = new Test
::MockModule
('C4::Context');
1176 $module->mock( 'userenv', sub { { branch
=> $library->{branchcode
} } } );
1178 AddIssue
( $patron, $item_1->{barcode
}, DateTime
->now->subtract( days
=> 1 ) );
1179 AddIssue
( $patron, $item_2->{barcode
}, DateTime
->now->subtract( days
=> 5 ) );
1180 AddIssue
( $patron, $item_3->{barcode
} );
1182 $patron = Koha
::Patrons
->find( $patron->{borrowernumber
} );
1183 my $overdues = $patron->get_overdues;
1184 is
( $overdues->count, 2, 'Patron should have 2 overdues');
1185 is
( $overdues->next->itemnumber, $item_1->{itemnumber
}, 'The issue should be returned in the same order as they have been done, first is correct' );
1186 is
( $overdues->next->itemnumber, $item_2->{itemnumber
}, 'The issue should be returned in the same order as they have been done, second is correct' );
1188 my $o = $overdues->reset->next;
1189 my $unblessed_overdue = $o->unblessed_all_relateds;
1190 is
( exists( $unblessed_overdue->{issuedate
} ), 1, 'Fields from the issues table should be filled' );
1191 is
( exists( $unblessed_overdue->{itemcallnumber
} ), 1, 'Fields from the items table should be filled' );
1192 is
( exists( $unblessed_overdue->{title
} ), 1, 'Fields from the biblio table should be filled' );
1193 is
( exists( $unblessed_overdue->{itemtype
} ), 1, 'Fields from the biblioitems table should be filled' );
1196 $patron->checkouts->delete;
1200 subtest
'userid_is_valid' => sub {
1203 my $library = $builder->build_object( { class => 'Koha::Libraries' } );
1204 my $patron_category = $builder->build_object(
1206 class => 'Koha::Patron::Categories',
1207 value
=> { category_type
=> 'P', enrolmentfee
=> 0 }
1211 cardnumber
=> "123456789",
1212 firstname
=> "Tomasito",
1214 categorycode
=> $patron_category->categorycode,
1215 branchcode
=> $library->branchcode,
1218 my $expected_userid_patron_1 = 'tomasito.none';
1219 my $borrowernumber = AddMember
(%data);
1220 my $patron_1 = Koha
::Patrons
->find($borrowernumber);
1221 is
( $patron_1->userid, $expected_userid_patron_1, 'The userid generated should be the one we expect' );
1223 $patron_1->userid( 'tomasito.non' );
1224 is
( $patron_1->has_valid_userid, # FIXME Joubu: What is the difference with the next test?
1225 1, 'recently created userid -> unique (borrowernumber passed)' );
1227 $patron_1->userid( 'tomasitoxxx' );
1228 is
( $patron_1->has_valid_userid,
1229 1, 'non-existent userid -> unique (borrowernumber passed)' );
1230 $patron_1->discard_changes; # We compare with the original userid later
1232 my $patron_not_in_storage = Koha
::Patron
->new( { userid
=> '' } );
1233 is
( $patron_not_in_storage->has_valid_userid,
1234 0, 'userid exists for another patron, patron is not in storage yet' );
1236 $patron_not_in_storage = Koha
::Patron
->new( { userid
=> 'tomasitoxxx' } );
1237 is
( $patron_not_in_storage->has_valid_userid,
1238 1, 'non-existent userid, patron is not in storage yet' );
1240 # Regression tests for BZ12226
1241 my $db_patron = Koha
::Patron
->new( { userid
=> C4
::Context
->config('user') } );
1242 is
( $db_patron->has_valid_userid,
1243 0, 'Koha::Patron->has_valid_userid should return 0 for the DB user (Bug 12226)' );
1245 # Add a new borrower with the same userid but different cardnumber
1246 $data{cardnumber
} = "987654321";
1247 my $new_borrowernumber = AddMember
(%data);
1248 my $patron_2 = Koha
::Patrons
->find($new_borrowernumber);
1249 $patron_2->userid($patron_1->userid);
1250 is
( $patron_2->has_valid_userid,
1251 0, 'The userid is already in used, it cannot be used for another patron' );
1253 my $new_userid = 'a_user_id';
1254 $data{cardnumber
} = "234567890";
1255 $data{userid
} = 'a_user_id';
1256 $borrowernumber = AddMember
(%data);
1257 my $patron_3 = Koha
::Patrons
->find($borrowernumber);
1258 is
( $patron_3->userid, $new_userid,
1259 'AddMember should insert the given userid' );
1267 subtest
'generate_userid' => sub {
1270 my $library = $builder->build_object( { class => 'Koha::Libraries' } );
1271 my $patron_category = $builder->build_object(
1273 class => 'Koha::Patron::Categories',
1274 value
=> { category_type
=> 'P', enrolmentfee
=> 0 }
1278 cardnumber
=> "123456789",
1279 firstname
=> "Tomasito",
1281 categorycode
=> $patron_category->categorycode,
1282 branchcode
=> $library->branchcode,
1285 my $expected_userid_patron_1 = 'tomasito.none';
1286 my $userid = C4
::Members
::Generate_Userid
( undef, $data{firstname
}, $data{surname
} );
1287 is
( $userid, $expected_userid_patron_1, 'Generate_Userid should generate the userid we expect' );
1288 my $borrowernumber = AddMember
(%data);
1289 my $patron_1 = Koha
::Patrons
->find($borrowernumber);
1290 is
( $patron_1->userid, $expected_userid_patron_1, 'The userid generated should be the one we expect' );
1292 $userid = C4
::Members
::Generate_Userid
( $borrowernumber, $data{firstname
}, $data{surname
} );
1293 is
( $userid, $expected_userid_patron_1 . '1', 'Generate_Userid should generate the userid we expect' );
1294 $data{cardnumber
} = '987654321';
1295 my $new_borrowernumber = AddMember
(%data);
1296 my $patron_2 = Koha
::Patrons
->find($new_borrowernumber);
1297 isnt
( $patron_2->userid, 'tomasito',
1298 "Patron with duplicate userid has new userid generated" );
1299 is
( $patron_2->userid, $expected_userid_patron_1 . '1', # TODO we could make that configurable
1300 "Patron with duplicate userid has new userid generated (1 is appened" );
1302 $userid = C4
::Members
::Generate_Userid
( $borrowernumber, $data{firstname
}, $data{surname
} );
1303 is
( $userid, $expected_userid_patron_1 . '2', 'Generate_Userid should generate the userid we expect' );
1311 $retrieved_patron_1->delete;
1312 is
( Koha
::Patrons
->search->count, $nb_of_patrons + 1, 'Delete should have deleted the patron' );
1314 subtest
'Log cardnumber change' => sub {
1317 t
::lib
::Mocks
::mock_preference
( 'BorrowersLog', 1 );
1318 my $patron = $builder->build( { source
=> 'Borrower' } );
1320 my $cardnumber = $patron->{cardnumber
};
1321 $patron->{cardnumber
} = 'TESTCARDNUMBER';
1322 ModMember
(%$patron);
1324 my @logs = $schema->resultset('ActionLog')->search( { module
=> 'MEMBERS', action
=> 'MODIFY', object
=> $patron->{borrowernumber
} } );
1325 my $log_info = from_json
( $logs[0]->info );
1326 is
( $log_info->{cardnumber_replaced
}->{new_cardnumber
}, 'TESTCARDNUMBER', 'Got correct new cardnumber' );
1327 is
( $log_info->{cardnumber_replaced
}->{previous_cardnumber
}, $cardnumber, 'Got correct old cardnumber' );
1328 is
( scalar @logs, 2, 'With BorrowerLogs, Change in cardnumber should be logged, as well as general alert of patron mod.' );
1332 $schema->storage->txn_rollback;
1334 # TODO Move to t::lib::Mocks and reuse it!
1335 sub set_logged_in_user
{
1337 C4
::Context
->set_userenv(
1338 $patron->borrowernumber, $patron->userid,
1339 $patron->cardnumber, 'firstname',
1340 'surname', $patron->library->branchcode,
1341 'Midway Public Library', $patron->flags,