Bug 18072: Add Koha::Biblio->can_be_transferred
[koha.git] / Koha / Patron.pm
1 package Koha::Patron;
2
3 # Copyright ByWater Solutions 2014
4 # Copyright PTFS Europe 2016
5 #
6 # This file is part of Koha.
7 #
8 # Koha is free software; you can redistribute it and/or modify it under the
9 # terms of the GNU General Public License as published by the Free Software
10 # Foundation; either version 3 of the License, or (at your option) any later
11 # version.
12 #
13 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
14 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
15 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
16 #
17 # You should have received a copy of the GNU General Public License along
18 # with Koha; if not, write to the Free Software Foundation, Inc.,
19 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
20
21 use Modern::Perl;
22
23 use Carp;
24 use List::MoreUtils qw( uniq );
25 use JSON qw( to_json );
26 use Module::Load::Conditional qw( can_load );
27 use Text::Unaccent qw( unac_string );
28
29 use C4::Context;
30 use C4::Log;
31 use Koha::Checkouts;
32 use Koha::Database;
33 use Koha::DateUtils;
34 use Koha::Holds;
35 use Koha::Old::Checkouts;
36 use Koha::Patron::Categories;
37 use Koha::Patron::HouseboundProfile;
38 use Koha::Patron::HouseboundRole;
39 use Koha::Patron::Images;
40 use Koha::Patrons;
41 use Koha::Virtualshelves;
42 use Koha::Club::Enrollments;
43 use Koha::Account;
44 use Koha::Subscription::Routinglists;
45
46 if ( ! can_load( modules => { 'Koha::NorwegianPatronDB' => undef } ) ) {
47    warn "Unable to load Koha::NorwegianPatronDB";
48 }
49
50 use base qw(Koha::Object);
51
52 our $RESULTSET_PATRON_ID_MAPPING = {
53     Accountline          => 'borrowernumber',
54     Aqbasketuser         => 'borrowernumber',
55     Aqbudget             => 'budget_owner_id',
56     Aqbudgetborrower     => 'borrowernumber',
57     ArticleRequest       => 'borrowernumber',
58     BorrowerAttribute    => 'borrowernumber',
59     BorrowerDebarment    => 'borrowernumber',
60     BorrowerFile         => 'borrowernumber',
61     BorrowerModification => 'borrowernumber',
62     ClubEnrollment       => 'borrowernumber',
63     Issue                => 'borrowernumber',
64     ItemsLastBorrower    => 'borrowernumber',
65     Linktracker          => 'borrowernumber',
66     Message              => 'borrowernumber',
67     MessageQueue         => 'borrowernumber',
68     OldIssue             => 'borrowernumber',
69     OldReserve           => 'borrowernumber',
70     Rating               => 'borrowernumber',
71     Reserve              => 'borrowernumber',
72     Review               => 'borrowernumber',
73     SearchHistory        => 'userid',
74     Statistic            => 'borrowernumber',
75     Suggestion           => 'suggestedby',
76     TagAll               => 'borrowernumber',
77     Virtualshelfcontent  => 'borrowernumber',
78     Virtualshelfshare    => 'borrowernumber',
79     Virtualshelve        => 'owner',
80 };
81
82 =head1 NAME
83
84 Koha::Patron - Koha Patron Object class
85
86 =head1 API
87
88 =head2 Class Methods
89
90 =cut
91
92 =head3 new
93
94 =cut
95
96 sub new {
97     my ( $class, $params ) = @_;
98
99     return $class->SUPER::new($params);
100 }
101
102 =head3 fixup_cardnumber
103
104 Autogenerate next cardnumber from highest value found in database
105
106 =cut
107
108 sub fixup_cardnumber {
109     my ( $self ) = @_;
110     my $max = Koha::Patrons->search({
111         cardnumber => {-regexp => '^-?[0-9]+$'}
112     }, {
113         select => \'CAST(cardnumber AS SIGNED)',
114         as => ['cast_cardnumber']
115     })->_resultset->get_column('cast_cardnumber')->max;
116     $self->cardnumber(($max || 0) +1);
117 }
118
119 =head3 trim_whitespace
120
121 trim whitespace from data which has some non-whitespace in it.
122 Could be moved to Koha::Object if need to be reused
123
124 =cut
125
126 sub trim_whitespaces {
127     my( $self ) = @_;
128
129     my $schema  = Koha::Database->new->schema;
130     my @columns = $schema->source($self->_type)->columns;
131
132     for my $column( @columns ) {
133         my $value = $self->$column;
134         if ( defined $value ) {
135             $value =~ s/^\s*|\s*$//g;
136             $self->$column($value);
137         }
138     }
139     return $self;
140 }
141
142 =head3 plain_text_password
143
144 $patron->plain_text_password( $password );
145
146 stores a copy of the unencrypted password in the object
147 for use in code before encrypting for db
148
149 =cut
150
151 sub plain_text_password {
152     my ( $self, $password ) = @_;
153     if ( $password ) {
154         $self->{_plain_text_password} = $password;
155         return $self;
156     }
157     return $self->{_plain_text_password}
158         if $self->{_plain_text_password};
159
160     return;
161 }
162
163 =head3 store
164
165 Patron specific store method to cleanup record
166 and do other necessary things before saving
167 to db
168
169 =cut
170
171 sub store {
172     my ($self) = @_;
173
174     $self->_result->result_source->schema->txn_do(
175         sub {
176             if (
177                 C4::Context->preference("autoMemberNum")
178                 and ( not defined $self->cardnumber
179                     or $self->cardnumber eq '' )
180               )
181             {
182                 # Warning: The caller is responsible for locking the members table in write
183                 # mode, to avoid database corruption.
184                 # We are in a transaction but the table is not locked
185                 $self->fixup_cardnumber;
186             }
187
188             unless( $self->category->in_storage ) {
189                 Koha::Exceptions::Object::FKConstraint->throw(
190                     broken_fk => 'categorycode',
191                     value     => $self->categorycode,
192                 );
193             }
194
195             $self->trim_whitespaces;
196
197             # We don't want invalid dates in the db (mysql has a bad habit of inserting 0000-00-00)
198             $self->dateofbirth(undef) unless $self->dateofbirth;
199             $self->debarred(undef)    unless $self->debarred;
200
201             # Set default values if not set
202             $self->sms_provider_id(undef) unless $self->sms_provider_id;
203             $self->guarantorid(undef)     unless $self->guarantorid;
204
205             unless ( $self->in_storage ) {    #AddMember
206
207                 # Generate a valid userid/login if needed
208                 $self->generate_userid
209                   if not $self->userid or not $self->has_valid_userid;
210
211                 # Add expiration date if it isn't already there
212                 unless ( $self->dateexpiry ) {
213                     $self->dateexpiry( $self->category->get_expiry_date );
214                 }
215
216                 # Add enrollment date if it isn't already there
217                 unless ( $self->dateenrolled ) {
218                     $self->dateenrolled(dt_from_string);
219                 }
220
221                 # Set the privacy depending on the patron's category
222                 my $default_privacy = $self->category->default_privacy || q{};
223                 $default_privacy =
224                     $default_privacy eq 'default' ? 1
225                   : $default_privacy eq 'never'   ? 2
226                   : $default_privacy eq 'forever' ? 0
227                   :                                                   undef;
228                 $self->privacy($default_privacy);
229
230                 unless ( defined $self->privacy_guarantor_checkouts ) {
231                     $self->privacy_guarantor_checkouts(0);
232                 }
233
234                 # Make a copy of the plain text password for later use
235                 $self->plain_text_password( $self->password );
236
237                 # Create a disabled account if no password provided
238                 $self->password( $self->password
239                     ? Koha::AuthUtils::hash_password( $self->password )
240                     : '!' );
241
242                 $self->borrowernumber(undef);
243
244                 $self = $self->SUPER::store;
245
246                 # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
247                 # cronjob will use for syncing with NL
248                 if (   C4::Context->preference('NorwegianPatronDBEnable')
249                     && C4::Context->preference('NorwegianPatronDBEnable') == 1 )
250                 {
251                     Koha::Database->new->schema->resultset('BorrowerSync')
252                       ->create(
253                         {
254                             'borrowernumber' => $self->borrowernumber,
255                             'synctype'       => 'norwegianpatrondb',
256                             'sync'           => 1,
257                             'syncstatus'     => 'new',
258                             'hashed_pin' =>
259                               Koha::NorwegianPatronDB::NLEncryptPIN($self->plain_text_password),
260                         }
261                       );
262                 }
263
264                 $self->add_enrolment_fee_if_needed;
265
266                 logaction( "MEMBERS", "CREATE", $self->borrowernumber, "" )
267                   if C4::Context->preference("BorrowersLog");
268             }
269             else {    #ModMember
270                 # test to know if you must update or not the borrower password
271                 if ( defined $self->password ) {
272                     if ( $self->password eq '****' or $self->password eq '' ) {
273                         $self->password(undef);
274                     } else {
275                         if ( C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
276                             # Update the hashed PIN in borrower_sync.hashed_pin, before Koha hashes it
277                             Koha::NorwegianPatronDB::NLUpdateHashedPIN( $self->borrowernumber, $self->password );
278                         }
279                         $self->password(Koha::AuthUtils::hash_password($self->password));
280                     }
281                 }
282
283                  # Come from ModMember, but should not be possible (?)
284                 $self->dateenrolled(undef) unless $self->dateenrolled;
285                 $self->dateexpiry(undef)   unless $self->dateexpiry;
286
287                 # FIXME We should not deal with that here, callers have to do this job
288                 # Moved from ModMember to prevent regressions
289                 unless ( $self->userid ) {
290                     my $stored_userid = $self->get_from_storage->userid;
291                     $self->userid($stored_userid);
292                 }
293
294                 if ( C4::Context->preference('FeeOnChangePatronCategory')
295                     and $self->category->categorycode ne
296                     $self->get_from_storage->category->categorycode )
297                 {
298                     $self->add_enrolment_fee_if_needed;
299                 }
300
301                 # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
302                 # cronjob will use for syncing with NL
303                 if (   C4::Context->preference('NorwegianPatronDBEnable')
304                     && C4::Context->preference('NorwegianPatronDBEnable') == 1 )
305                 {
306                     my $borrowersync = Koha::Database->new->schema->resultset('BorrowerSync')->find({
307                         'synctype'       => 'norwegianpatrondb',
308                         'borrowernumber' => $self->borrowernumber,
309                     });
310                     # Do not set to "edited" if syncstatus is "new". We need to sync as new before
311                     # we can sync as changed. And the "new sync" will pick up all changes since
312                     # the patron was created anyway.
313                     if ( $borrowersync->syncstatus ne 'new' && $borrowersync->syncstatus ne 'delete' ) {
314                         $borrowersync->update( { 'syncstatus' => 'edited' } );
315                     }
316                     # Set the value of 'sync'
317                     # FIXME THIS IS BROKEN # $borrowersync->update( { 'sync' => $data{'sync'} } );
318
319                     # Try to do the live sync
320                     Koha::NorwegianPatronDB::NLSync({ 'borrowernumber' => $self->borrowernumber });
321                 }
322
323                 my $borrowers_log = C4::Context->preference("BorrowersLog");
324                 my $previous_cardnumber = $self->get_from_storage->cardnumber;
325                 if ($borrowers_log
326                     && ( !defined $previous_cardnumber
327                         || $previous_cardnumber ne $self->cardnumber )
328                     )
329                 {
330                     logaction(
331                         "MEMBERS",
332                         "MODIFY",
333                         $self->borrowernumber,
334                         to_json(
335                             {
336                                 cardnumber_replaced => {
337                                     previous_cardnumber => $previous_cardnumber,
338                                     new_cardnumber      => $self->cardnumber,
339                                 }
340                             },
341                             { utf8 => 1, pretty => 1 }
342                         )
343                     );
344                 }
345
346                 logaction( "MEMBERS", "MODIFY", $self->borrowernumber,
347                     "UPDATE (executed w/ arg: " . $self->borrowernumber . ")" )
348                   if $borrowers_log;
349
350                 $self = $self->SUPER::store;
351             }
352         }
353     );
354     return $self;
355 }
356
357 =head3 delete
358
359 $patron->delete
360
361 Delete patron's holds, lists and finally the patron.
362
363 Lists owned by the borrower are deleted, but entries from the borrower to
364 other lists are kept.
365
366 =cut
367
368 sub delete {
369     my ($self) = @_;
370
371     my $deleted;
372     $self->_result->result_source->schema->txn_do(
373         sub {
374             # Delete Patron's holds
375             $self->holds->delete;
376
377             # Delete all lists and all shares of this borrower
378             # Consistent with the approach Koha uses on deleting individual lists
379             # Note that entries in virtualshelfcontents added by this borrower to
380             # lists of others will be handled by a table constraint: the borrower
381             # is set to NULL in those entries.
382             # NOTE:
383             # We could handle the above deletes via a constraint too.
384             # But a new BZ report 11889 has been opened to discuss another approach.
385             # Instead of deleting we could also disown lists (based on a pref).
386             # In that way we could save shared and public lists.
387             # The current table constraints support that idea now.
388             # This pref should then govern the results of other routines/methods such as
389             # Koha::Virtualshelf->new->delete too.
390             # FIXME Could be $patron->get_lists
391             $_->delete for Koha::Virtualshelves->search( { owner => $self->borrowernumber } );
392
393             $deleted = $self->SUPER::delete;
394
395             logaction( "MEMBERS", "DELETE", $self->borrowernumber, "" ) if C4::Context->preference("BorrowersLog");
396         }
397     );
398     return $deleted;
399 }
400
401
402 =head3 category
403
404 my $patron_category = $patron->category
405
406 Return the patron category for this patron
407
408 =cut
409
410 sub category {
411     my ( $self ) = @_;
412     return Koha::Patron::Category->_new_from_dbic( $self->_result->categorycode );
413 }
414
415 =head3 guarantor
416
417 Returns a Koha::Patron object for this patron's guarantor
418
419 =cut
420
421 sub guarantor {
422     my ( $self ) = @_;
423
424     return unless $self->guarantorid();
425
426     return Koha::Patrons->find( $self->guarantorid() );
427 }
428
429 sub image {
430     my ( $self ) = @_;
431
432     return scalar Koha::Patron::Images->find( $self->borrowernumber );
433 }
434
435 sub library {
436     my ( $self ) = @_;
437     return Koha::Library->_new_from_dbic($self->_result->branchcode);
438 }
439
440 =head3 guarantees
441
442 Returns the guarantees (list of Koha::Patron) of this patron
443
444 =cut
445
446 sub guarantees {
447     my ( $self ) = @_;
448
449     return Koha::Patrons->search( { guarantorid => $self->borrowernumber } );
450 }
451
452 =head3 housebound_profile
453
454 Returns the HouseboundProfile associated with this patron.
455
456 =cut
457
458 sub housebound_profile {
459     my ( $self ) = @_;
460     my $profile = $self->_result->housebound_profile;
461     return Koha::Patron::HouseboundProfile->_new_from_dbic($profile)
462         if ( $profile );
463     return;
464 }
465
466 =head3 housebound_role
467
468 Returns the HouseboundRole associated with this patron.
469
470 =cut
471
472 sub housebound_role {
473     my ( $self ) = @_;
474
475     my $role = $self->_result->housebound_role;
476     return Koha::Patron::HouseboundRole->_new_from_dbic($role) if ( $role );
477     return;
478 }
479
480 =head3 siblings
481
482 Returns the siblings of this patron.
483
484 =cut
485
486 sub siblings {
487     my ( $self ) = @_;
488
489     my $guarantor = $self->guarantor;
490
491     return unless $guarantor;
492
493     return Koha::Patrons->search(
494         {
495             guarantorid => {
496                 '!=' => undef,
497                 '=' => $guarantor->id,
498             },
499             borrowernumber => {
500                 '!=' => $self->borrowernumber,
501             }
502         }
503     );
504 }
505
506 =head3 merge_with
507
508     my $patron = Koha::Patrons->find($id);
509     $patron->merge_with( \@patron_ids );
510
511     This subroutine merges a list of patrons into the patron record. This is accomplished by finding
512     all related patron ids for the patrons to be merged in other tables and changing the ids to be that
513     of the keeper patron.
514
515 =cut
516
517 sub merge_with {
518     my ( $self, $patron_ids ) = @_;
519
520     my @patron_ids = @{ $patron_ids };
521
522     # Ensure the keeper isn't in the list of patrons to merge
523     @patron_ids = grep { $_ ne $self->id } @patron_ids;
524
525     my $schema = Koha::Database->new()->schema();
526
527     my $results;
528
529     $self->_result->result_source->schema->txn_do( sub {
530         foreach my $patron_id (@patron_ids) {
531             my $patron = Koha::Patrons->find( $patron_id );
532
533             next unless $patron;
534
535             # Unbless for safety, the patron will end up being deleted
536             $results->{merged}->{$patron_id}->{patron} = $patron->unblessed;
537
538             while (my ($r, $field) = each(%$RESULTSET_PATRON_ID_MAPPING)) {
539                 my $rs = $schema->resultset($r)->search({ $field => $patron_id });
540                 $results->{merged}->{ $patron_id }->{updated}->{$r} = $rs->count();
541                 $rs->update({ $field => $self->id });
542             }
543
544             $patron->move_to_deleted();
545             $patron->delete();
546         }
547     });
548
549     return $results;
550 }
551
552
553
554 =head3 wants_check_for_previous_checkout
555
556     $wants_check = $patron->wants_check_for_previous_checkout;
557
558 Return 1 if Koha needs to perform PrevIssue checking, else 0.
559
560 =cut
561
562 sub wants_check_for_previous_checkout {
563     my ( $self ) = @_;
564     my $syspref = C4::Context->preference("checkPrevCheckout");
565
566     # Simple cases
567     ## Hard syspref trumps all
568     return 1 if ($syspref eq 'hardyes');
569     return 0 if ($syspref eq 'hardno');
570     ## Now, patron pref trumps all
571     return 1 if ($self->checkprevcheckout eq 'yes');
572     return 0 if ($self->checkprevcheckout eq 'no');
573
574     # More complex: patron inherits -> determine category preference
575     my $checkPrevCheckoutByCat = $self->category->checkprevcheckout;
576     return 1 if ($checkPrevCheckoutByCat eq 'yes');
577     return 0 if ($checkPrevCheckoutByCat eq 'no');
578
579     # Finally: category preference is inherit, default to 0
580     if ($syspref eq 'softyes') {
581         return 1;
582     } else {
583         return 0;
584     }
585 }
586
587 =head3 do_check_for_previous_checkout
588
589     $do_check = $patron->do_check_for_previous_checkout($item);
590
591 Return 1 if the bib associated with $ITEM has previously been checked out to
592 $PATRON, 0 otherwise.
593
594 =cut
595
596 sub do_check_for_previous_checkout {
597     my ( $self, $item ) = @_;
598
599     # Find all items for bib and extract item numbers.
600     my @items = Koha::Items->search({biblionumber => $item->{biblionumber}});
601     my @item_nos;
602     foreach my $item (@items) {
603         push @item_nos, $item->itemnumber;
604     }
605
606     # Create (old)issues search criteria
607     my $criteria = {
608         borrowernumber => $self->borrowernumber,
609         itemnumber => \@item_nos,
610     };
611
612     # Check current issues table
613     my $issues = Koha::Checkouts->search($criteria);
614     return 1 if $issues->count; # 0 || N
615
616     # Check old issues table
617     my $old_issues = Koha::Old::Checkouts->search($criteria);
618     return $old_issues->count;  # 0 || N
619 }
620
621 =head3 is_debarred
622
623 my $debarment_expiration = $patron->is_debarred;
624
625 Returns the date a patron debarment will expire, or undef if the patron is not
626 debarred
627
628 =cut
629
630 sub is_debarred {
631     my ($self) = @_;
632
633     return unless $self->debarred;
634     return $self->debarred
635       if $self->debarred =~ '^9999'
636       or dt_from_string( $self->debarred ) > dt_from_string;
637     return;
638 }
639
640 =head3 is_expired
641
642 my $is_expired = $patron->is_expired;
643
644 Returns 1 if the patron is expired or 0;
645
646 =cut
647
648 sub is_expired {
649     my ($self) = @_;
650     return 0 unless $self->dateexpiry;
651     return 0 if $self->dateexpiry =~ '^9999';
652     return 1 if dt_from_string( $self->dateexpiry ) < dt_from_string->truncate( to => 'day' );
653     return 0;
654 }
655
656 =head3 is_going_to_expire
657
658 my $is_going_to_expire = $patron->is_going_to_expire;
659
660 Returns 1 if the patron is going to expired, depending on the NotifyBorrowerDeparture pref or 0
661
662 =cut
663
664 sub is_going_to_expire {
665     my ($self) = @_;
666
667     my $delay = C4::Context->preference('NotifyBorrowerDeparture') || 0;
668
669     return 0 unless $delay;
670     return 0 unless $self->dateexpiry;
671     return 0 if $self->dateexpiry =~ '^9999';
672     return 1 if dt_from_string( $self->dateexpiry )->subtract( days => $delay ) < dt_from_string->truncate( to => 'day' );
673     return 0;
674 }
675
676 =head3 update_password
677
678 my $updated = $patron->update_password( $userid, $password );
679
680 Update the userid and the password of a patron.
681 If the userid already exists, returns and let DBIx::Class warns
682 This will add an entry to action_logs if BorrowersLog is set.
683
684 =cut
685
686 sub update_password {
687     my ( $self, $userid, $password ) = @_;
688     eval { $self->userid($userid)->store; };
689     return if $@; # Make sure the userid is not already in used by another patron
690     $self->update(
691         {
692             password       => $password,
693             login_attempts => 0,
694         }
695     );
696     logaction( "MEMBERS", "CHANGE PASS", $self->borrowernumber, "" ) if C4::Context->preference("BorrowersLog");
697     return 1;
698 }
699
700 =head3 renew_account
701
702 my $new_expiry_date = $patron->renew_account
703
704 Extending the subscription to the expiry date.
705
706 =cut
707
708 sub renew_account {
709     my ($self) = @_;
710     my $date;
711     if ( C4::Context->preference('BorrowerRenewalPeriodBase') eq 'combination' ) {
712         $date = ( dt_from_string gt dt_from_string( $self->dateexpiry ) ) ? dt_from_string : dt_from_string( $self->dateexpiry );
713     } else {
714         $date =
715             C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry'
716             ? dt_from_string( $self->dateexpiry )
717             : dt_from_string;
718     }
719     my $expiry_date = $self->category->get_expiry_date($date);
720
721     $self->dateexpiry($expiry_date);
722     $self->date_renewed( dt_from_string() );
723     $self->store();
724
725     $self->add_enrolment_fee_if_needed;
726
727     logaction( "MEMBERS", "RENEW", $self->borrowernumber, "Membership renewed" ) if C4::Context->preference("BorrowersLog");
728     return dt_from_string( $expiry_date )->truncate( to => 'day' );
729 }
730
731 =head3 has_overdues
732
733 my $has_overdues = $patron->has_overdues;
734
735 Returns the number of patron's overdues
736
737 =cut
738
739 sub has_overdues {
740     my ($self) = @_;
741     my $dtf = Koha::Database->new->schema->storage->datetime_parser;
742     return $self->_result->issues->search({ date_due => { '<' => $dtf->format_datetime( dt_from_string() ) } })->count;
743 }
744
745 =head3 track_login
746
747     $patron->track_login;
748     $patron->track_login({ force => 1 });
749
750     Tracks a (successful) login attempt.
751     The preference TrackLastPatronActivity must be enabled. Or you
752     should pass the force parameter.
753
754 =cut
755
756 sub track_login {
757     my ( $self, $params ) = @_;
758     return if
759         !$params->{force} &&
760         !C4::Context->preference('TrackLastPatronActivity');
761     $self->lastseen( dt_from_string() )->store;
762 }
763
764 =head3 move_to_deleted
765
766 my $is_moved = $patron->move_to_deleted;
767
768 Move a patron to the deletedborrowers table.
769 This can be done before deleting a patron, to make sure the data are not completely deleted.
770
771 =cut
772
773 sub move_to_deleted {
774     my ($self) = @_;
775     my $patron_infos = $self->unblessed;
776     delete $patron_infos->{updated_on}; #This ensures the updated_on date in deletedborrowers will be set to the current timestamp
777     return Koha::Database->new->schema->resultset('Deletedborrower')->create($patron_infos);
778 }
779
780 =head3 article_requests
781
782 my @requests = $borrower->article_requests();
783 my $requests = $borrower->article_requests();
784
785 Returns either a list of ArticleRequests objects,
786 or an ArtitleRequests object, depending on the
787 calling context.
788
789 =cut
790
791 sub article_requests {
792     my ( $self ) = @_;
793
794     $self->{_article_requests} ||= Koha::ArticleRequests->search({ borrowernumber => $self->borrowernumber() });
795
796     return $self->{_article_requests};
797 }
798
799 =head3 article_requests_current
800
801 my @requests = $patron->article_requests_current
802
803 Returns the article requests associated with this patron that are incomplete
804
805 =cut
806
807 sub article_requests_current {
808     my ( $self ) = @_;
809
810     $self->{_article_requests_current} ||= Koha::ArticleRequests->search(
811         {
812             borrowernumber => $self->id(),
813             -or          => [
814                 { status => Koha::ArticleRequest::Status::Pending },
815                 { status => Koha::ArticleRequest::Status::Processing }
816             ]
817         }
818     );
819
820     return $self->{_article_requests_current};
821 }
822
823 =head3 article_requests_finished
824
825 my @requests = $biblio->article_requests_finished
826
827 Returns the article requests associated with this patron that are completed
828
829 =cut
830
831 sub article_requests_finished {
832     my ( $self, $borrower ) = @_;
833
834     $self->{_article_requests_finished} ||= Koha::ArticleRequests->search(
835         {
836             borrowernumber => $self->id(),
837             -or          => [
838                 { status => Koha::ArticleRequest::Status::Completed },
839                 { status => Koha::ArticleRequest::Status::Canceled }
840             ]
841         }
842     );
843
844     return $self->{_article_requests_finished};
845 }
846
847 =head3 add_enrolment_fee_if_needed
848
849 my $enrolment_fee = $patron->add_enrolment_fee_if_needed;
850
851 Add enrolment fee for a patron if needed.
852
853 =cut
854
855 sub add_enrolment_fee_if_needed {
856     my ($self) = @_;
857     my $enrolment_fee = $self->category->enrolmentfee;
858     if ( $enrolment_fee && $enrolment_fee > 0 ) {
859         # insert fee in patron debts
860         C4::Accounts::manualinvoice( $self->borrowernumber, '', '', 'A', $enrolment_fee );
861     }
862     return $enrolment_fee || 0;
863 }
864
865 =head3 checkouts
866
867 my $checkouts = $patron->checkouts
868
869 =cut
870
871 sub checkouts {
872     my ($self) = @_;
873     my $checkouts = $self->_result->issues;
874     return Koha::Checkouts->_new_from_dbic( $checkouts );
875 }
876
877 =head3 pending_checkouts
878
879 my $pending_checkouts = $patron->pending_checkouts
880
881 This method will return the same as $self->checkouts, but with a prefetch on
882 items, biblio and biblioitems.
883
884 It has been introduced to replaced the C4::Members::GetPendingIssues subroutine
885
886 It should not be used directly, prefer to access fields you need instead of
887 retrieving all these fields in one go.
888
889
890 =cut
891
892 sub pending_checkouts {
893     my( $self ) = @_;
894     my $checkouts = $self->_result->issues->search(
895         {},
896         {
897             order_by => [
898                 { -desc => 'me.timestamp' },
899                 { -desc => 'issuedate' },
900                 { -desc => 'issue_id' }, # Sort by issue_id should be enough
901             ],
902             prefetch => { item => { biblio => 'biblioitems' } },
903         }
904     );
905     return Koha::Checkouts->_new_from_dbic( $checkouts );
906 }
907
908 =head3 old_checkouts
909
910 my $old_checkouts = $patron->old_checkouts
911
912 =cut
913
914 sub old_checkouts {
915     my ($self) = @_;
916     my $old_checkouts = $self->_result->old_issues;
917     return Koha::Old::Checkouts->_new_from_dbic( $old_checkouts );
918 }
919
920 =head3 get_overdues
921
922 my $overdue_items = $patron->get_overdues
923
924 Return the overdue items
925
926 =cut
927
928 sub get_overdues {
929     my ($self) = @_;
930     my $dtf = Koha::Database->new->schema->storage->datetime_parser;
931     return $self->checkouts->search(
932         {
933             'me.date_due' => { '<' => $dtf->format_datetime(dt_from_string) },
934         },
935         {
936             prefetch => { item => { biblio => 'biblioitems' } },
937         }
938     );
939 }
940
941 =head3 get_routing_lists
942
943 my @routinglists = $patron->get_routing_lists
944
945 Returns the routing lists a patron is subscribed to.
946
947 =cut
948
949 sub get_routing_lists {
950     my ($self) = @_;
951     my $routing_list_rs = $self->_result->subscriptionroutinglists;
952     return Koha::Subscription::Routinglists->_new_from_dbic($routing_list_rs);
953 }
954
955 =head3 get_age
956
957 my $age = $patron->get_age
958
959 Return the age of the patron
960
961 =cut
962
963 sub get_age {
964     my ($self)    = @_;
965     my $today_str = dt_from_string->strftime("%Y-%m-%d");
966     return unless $self->dateofbirth;
967     my $dob_str   = dt_from_string( $self->dateofbirth )->strftime("%Y-%m-%d");
968
969     my ( $dob_y,   $dob_m,   $dob_d )   = split /-/, $dob_str;
970     my ( $today_y, $today_m, $today_d ) = split /-/, $today_str;
971
972     my $age = $today_y - $dob_y;
973     if ( $dob_m . $dob_d > $today_m . $today_d ) {
974         $age--;
975     }
976
977     return $age;
978 }
979
980 =head3 account
981
982 my $account = $patron->account
983
984 =cut
985
986 sub account {
987     my ($self) = @_;
988     return Koha::Account->new( { patron_id => $self->borrowernumber } );
989 }
990
991 =head3 holds
992
993 my $holds = $patron->holds
994
995 Return all the holds placed by this patron
996
997 =cut
998
999 sub holds {
1000     my ($self) = @_;
1001     my $holds_rs = $self->_result->reserves->search( {}, { order_by => 'reservedate' } );
1002     return Koha::Holds->_new_from_dbic($holds_rs);
1003 }
1004
1005 =head3 old_holds
1006
1007 my $old_holds = $patron->old_holds
1008
1009 Return all the historical holds for this patron
1010
1011 =cut
1012
1013 sub old_holds {
1014     my ($self) = @_;
1015     my $old_holds_rs = $self->_result->old_reserves->search( {}, { order_by => 'reservedate' } );
1016     return Koha::Old::Holds->_new_from_dbic($old_holds_rs);
1017 }
1018
1019 =head3 notice_email_address
1020
1021   my $email = $patron->notice_email_address;
1022
1023 Return the email address of patron used for notices.
1024 Returns the empty string if no email address.
1025
1026 =cut
1027
1028 sub notice_email_address{
1029     my ( $self ) = @_;
1030
1031     my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
1032     # if syspref is set to 'first valid' (value == OFF), look up email address
1033     if ( $which_address eq 'OFF' ) {
1034         return $self->first_valid_email_address;
1035     }
1036
1037     return $self->$which_address || '';
1038 }
1039
1040 =head3 first_valid_email_address
1041
1042 my $first_valid_email_address = $patron->first_valid_email_address
1043
1044 Return the first valid email address for a patron.
1045 For now, the order  is defined as email, emailpro, B_email.
1046 Returns the empty string if the borrower has no email addresses.
1047
1048 =cut
1049
1050 sub first_valid_email_address {
1051     my ($self) = @_;
1052
1053     return $self->email() || $self->emailpro() || $self->B_email() || q{};
1054 }
1055
1056 =head3 get_club_enrollments
1057
1058 =cut
1059
1060 sub get_club_enrollments {
1061     my ( $self, $return_scalar ) = @_;
1062
1063     my $e = Koha::Club::Enrollments->search( { borrowernumber => $self->borrowernumber(), date_canceled => undef } );
1064
1065     return $e if $return_scalar;
1066
1067     return wantarray ? $e->as_list : $e;
1068 }
1069
1070 =head3 get_enrollable_clubs
1071
1072 =cut
1073
1074 sub get_enrollable_clubs {
1075     my ( $self, $is_enrollable_from_opac, $return_scalar ) = @_;
1076
1077     my $params;
1078     $params->{is_enrollable_from_opac} = $is_enrollable_from_opac
1079       if $is_enrollable_from_opac;
1080     $params->{is_email_required} = 0 unless $self->first_valid_email_address();
1081
1082     $params->{borrower} = $self;
1083
1084     my $e = Koha::Clubs->get_enrollable($params);
1085
1086     return $e if $return_scalar;
1087
1088     return wantarray ? $e->as_list : $e;
1089 }
1090
1091 =head3 account_locked
1092
1093 my $is_locked = $patron->account_locked
1094
1095 Return true if the patron has reach the maximum number of login attempts (see pref FailedLoginAttempts).
1096 Otherwise return false.
1097 If the pref is not set (empty string, null or 0), the feature is considered as disabled.
1098
1099 =cut
1100
1101 sub account_locked {
1102     my ($self) = @_;
1103     my $FailedLoginAttempts = C4::Context->preference('FailedLoginAttempts');
1104     return ( $FailedLoginAttempts
1105           and $self->login_attempts
1106           and $self->login_attempts >= $FailedLoginAttempts )? 1 : 0;
1107 }
1108
1109 =head3 can_see_patron_infos
1110
1111 my $can_see = $patron->can_see_patron_infos( $patron );
1112
1113 Return true if the patron (usually the logged in user) can see the patron's infos for a given patron
1114
1115 =cut
1116
1117 sub can_see_patron_infos {
1118     my ( $self, $patron ) = @_;
1119     return $self->can_see_patrons_from( $patron->library->branchcode );
1120 }
1121
1122 =head3 can_see_patrons_from
1123
1124 my $can_see = $patron->can_see_patrons_from( $branchcode );
1125
1126 Return true if the patron (usually the logged in user) can see the patron's infos from a given library
1127
1128 =cut
1129
1130 sub can_see_patrons_from {
1131     my ( $self, $branchcode ) = @_;
1132     my $can = 0;
1133     if ( $self->branchcode eq $branchcode ) {
1134         $can = 1;
1135     } elsif ( $self->has_permission( { borrowers => 'view_borrower_infos_from_any_libraries' } ) ) {
1136         $can = 1;
1137     } elsif ( my $library_groups = $self->library->library_groups ) {
1138         while ( my $library_group = $library_groups->next ) {
1139             if ( $library_group->parent->has_child( $branchcode ) ) {
1140                 $can = 1;
1141                 last;
1142             }
1143         }
1144     }
1145     return $can;
1146 }
1147
1148 =head3 libraries_where_can_see_patrons
1149
1150 my $libraries = $patron-libraries_where_can_see_patrons;
1151
1152 Return the list of branchcodes(!) of libraries the patron is allowed to see other patron's infos.
1153 The branchcodes are arbitrarily returned sorted.
1154 We are supposing here that the object is related to the logged in patron (use of C4::Context::only_my_library)
1155
1156 An empty array means no restriction, the patron can see patron's infos from any libraries.
1157
1158 =cut
1159
1160 sub libraries_where_can_see_patrons {
1161     my ( $self ) = @_;
1162     my $userenv = C4::Context->userenv;
1163
1164     return () unless $userenv; # For tests, but userenv should be defined in tests...
1165
1166     my @restricted_branchcodes;
1167     if (C4::Context::only_my_library) {
1168         push @restricted_branchcodes, $self->branchcode;
1169     }
1170     else {
1171         unless (
1172             $self->has_permission(
1173                 { borrowers => 'view_borrower_infos_from_any_libraries' }
1174             )
1175           )
1176         {
1177             my $library_groups = $self->library->library_groups({ ft_hide_patron_info => 1 });
1178             if ( $library_groups->count )
1179             {
1180                 while ( my $library_group = $library_groups->next ) {
1181                     my $parent = $library_group->parent;
1182                     if ( $parent->has_child( $self->branchcode ) ) {
1183                         push @restricted_branchcodes, $parent->children->get_column('branchcode');
1184                     }
1185                 }
1186             }
1187
1188             @restricted_branchcodes = ( $self->branchcode ) unless @restricted_branchcodes;
1189         }
1190     }
1191
1192     @restricted_branchcodes = grep { defined $_ } @restricted_branchcodes;
1193     @restricted_branchcodes = uniq(@restricted_branchcodes);
1194     @restricted_branchcodes = sort(@restricted_branchcodes);
1195     return @restricted_branchcodes;
1196 }
1197
1198 sub has_permission {
1199     my ( $self, $flagsrequired ) = @_;
1200     return unless $self->userid;
1201     # TODO code from haspermission needs to be moved here!
1202     return C4::Auth::haspermission( $self->userid, $flagsrequired );
1203 }
1204
1205 =head3 is_adult
1206
1207 my $is_adult = $patron->is_adult
1208
1209 Return true if the patron has a category with a type Adult (A) or Organization (I)
1210
1211 =cut
1212
1213 sub is_adult {
1214     my ( $self ) = @_;
1215     return $self->category->category_type =~ /^(A|I)$/ ? 1 : 0;
1216 }
1217
1218 =head3 is_child
1219
1220 my $is_child = $patron->is_child
1221
1222 Return true if the patron has a category with a type Child (C)
1223
1224 =cut
1225 sub is_child {
1226     my( $self ) = @_;
1227     return $self->category->category_type eq 'C' ? 1 : 0;
1228 }
1229
1230 =head3 has_valid_userid
1231
1232 my $patron = Koha::Patrons->find(42);
1233 $patron->userid( $new_userid );
1234 my $has_a_valid_userid = $patron->has_valid_userid
1235
1236 my $patron = Koha::Patron->new( $params );
1237 my $has_a_valid_userid = $patron->has_valid_userid
1238
1239 Return true if the current userid of this patron is valid/unique, otherwise false.
1240
1241 Note that this should be done in $self->store instead and raise an exception if needed.
1242
1243 =cut
1244
1245 sub has_valid_userid {
1246     my ($self) = @_;
1247
1248     return 0 unless $self->userid;
1249
1250     return 0 if ( $self->userid eq C4::Context->config('user') );    # DB user
1251
1252     my $already_exists = Koha::Patrons->search(
1253         {
1254             userid => $self->userid,
1255             (
1256                 $self->in_storage
1257                 ? ( borrowernumber => { '!=' => $self->borrowernumber } )
1258                 : ()
1259             ),
1260         }
1261     )->count;
1262     return $already_exists ? 0 : 1;
1263 }
1264
1265 =head3 generate_userid
1266
1267 my $patron = Koha::Patron->new( $params );
1268 $patron->generate_userid
1269
1270 Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
1271
1272 Set a generated userid ($firstname.$surname if there is a $firstname, or $surname if there is no value in $firstname) plus offset (0 if the $userid is unique, or a higher numeric value if not unique).
1273
1274 =cut
1275
1276 sub generate_userid {
1277     my ($self) = @_;
1278     my $offset = 0;
1279     my $firstname = $self->firstname // q{};
1280     my $surname = $self->surname // q{};
1281     #The script will "do" the following code and increment the $offset until the generated userid is unique
1282     do {
1283       $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1284       $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
1285       my $userid = lc(($firstname)? "$firstname.$surname" : $surname);
1286       $userid = unac_string('utf-8',$userid);
1287       $userid .= $offset unless $offset == 0;
1288       $self->userid( $userid );
1289       $offset++;
1290      } while (! $self->has_valid_userid );
1291
1292      return $self;
1293
1294 }
1295
1296 =head2 Internal methods
1297
1298 =head3 _type
1299
1300 =cut
1301
1302 sub _type {
1303     return 'Borrower';
1304 }
1305
1306 =head1 AUTHOR
1307
1308 Kyle M Hall <kyle@bywatersolutions.com>
1309 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>
1310
1311 =cut
1312
1313 1;