Bug 14834: Make membership_expiry cronjob more flexible
[koha.git] / C4 / Members.pm
1 package C4::Members;
2
3 # Copyright 2000-2003 Katipo Communications
4 # Copyright 2010 BibLibre
5 # Parts Copyright 2010 Catalyst IT
6 #
7 # This file is part of Koha.
8 #
9 # Koha is free software; you can redistribute it and/or modify it
10 # under the terms of the GNU General Public License as published by
11 # the Free Software Foundation; either version 3 of the License, or
12 # (at your option) any later version.
13 #
14 # Koha is distributed in the hope that it will be useful, but
15 # WITHOUT ANY WARRANTY; without even the implied warranty of
16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 # GNU General Public License for more details.
18 #
19 # You should have received a copy of the GNU General Public License
20 # along with Koha; if not, see <http://www.gnu.org/licenses>.
21
22
23 use strict;
24 #use warnings; FIXME - Bug 2505
25 use C4::Context;
26 use String::Random qw( random_string );
27 use Scalar::Util qw( looks_like_number );
28 use Date::Calc qw/Today Add_Delta_YM check_date Date_to_Days/;
29 use C4::Log; # logaction
30 use C4::Overdues;
31 use C4::Reserves;
32 use C4::Accounts;
33 use C4::Biblio;
34 use C4::Letters;
35 use C4::Members::Attributes qw(SearchIdMatchingAttribute UpdateBorrowerAttribute);
36 use C4::NewsChannels; #get slip news
37 use DateTime;
38 use Koha::Database;
39 use Koha::DateUtils;
40 use Koha::Patron::Debarments qw(IsDebarred);
41 use Text::Unaccent qw( unac_string );
42 use Koha::AuthUtils qw(hash_password);
43 use Koha::Database;
44 use Koha::List::Patron;
45
46 our (@ISA,@EXPORT,@EXPORT_OK,$debug);
47
48 use Module::Load::Conditional qw( can_load );
49 if ( ! can_load( modules => { 'Koha::NorwegianPatronDB' => undef } ) ) {
50    $debug && warn "Unable to load Koha::NorwegianPatronDB";
51 }
52
53
54 BEGIN {
55     $debug = $ENV{DEBUG} || 0;
56     require Exporter;
57     @ISA = qw(Exporter);
58     #Get data
59     push @EXPORT, qw(
60         &Search
61         &GetMemberDetails
62         &GetMemberRelatives
63         &GetMember
64
65         &GetMemberIssuesAndFines
66         &GetPendingIssues
67         &GetAllIssues
68
69         &GetFirstValidEmailAddress
70         &GetNoticeEmailAddress
71
72         &GetAge
73         &GetSortDetails
74         &GetTitles
75
76         &GetHideLostItemsPreference
77
78         &IsMemberBlocked
79         &GetMemberAccountRecords
80         &GetBorNotifyAcctRecord
81
82         &GetborCatFromCatType
83         &GetBorrowercategory
84         GetBorrowerCategorycode
85         &GetBorrowercategoryList
86
87         &GetBorrowersToExpunge
88         &GetBorrowersWhoHaveNeverBorrowed
89         &GetBorrowersWithIssuesHistoryOlderThan
90
91         &GetExpiryDate
92         &GetUpcomingMembershipExpires
93
94         &IssueSlip
95         GetBorrowersWithEmail
96
97         HasOverdues
98         GetOverduesForPatron
99     );
100
101     #Modify data
102     push @EXPORT, qw(
103         &ModMember
104         &changepassword
105     );
106
107     #Delete data
108     push @EXPORT, qw(
109         &DelMember
110     );
111
112     #Insert data
113     push @EXPORT, qw(
114         &AddMember
115         &AddMember_Opac
116         &MoveMemberToDeleted
117         &ExtendMemberSubscriptionTo
118     );
119
120     #Check data
121     push @EXPORT, qw(
122         &checkuniquemember
123         &checkuserpassword
124         &Check_Userid
125         &Generate_Userid
126         &fixup_cardnumber
127         &checkcardnumber
128     );
129 }
130
131 =head1 NAME
132
133 C4::Members - Perl Module containing convenience functions for member handling
134
135 =head1 SYNOPSIS
136
137 use C4::Members;
138
139 =head1 DESCRIPTION
140
141 This module contains routines for adding, modifying and deleting members/patrons/borrowers 
142
143 =head1 FUNCTIONS
144
145 =head2 GetMemberDetails
146
147 ($borrower) = &GetMemberDetails($borrowernumber, $cardnumber);
148
149 Looks up a patron and returns information about him or her. If
150 C<$borrowernumber> is true (nonzero), C<&GetMemberDetails> looks
151 up the borrower by number; otherwise, it looks up the borrower by card
152 number.
153
154 C<$borrower> is a reference-to-hash whose keys are the fields of the
155 borrowers table in the Koha database. In addition,
156 C<$borrower-E<gt>{flags}> is a hash giving more detailed information
157 about the patron. Its keys act as flags :
158
159     if $borrower->{flags}->{LOST} {
160         # Patron's card was reported lost
161     }
162
163 If the state of a flag means that the patron should not be
164 allowed to borrow any more books, then it will have a C<noissues> key
165 with a true value.
166
167 See patronflags for more details.
168
169 C<$borrower-E<gt>{authflags}> is a hash giving more detailed information
170 about the top-level permissions flags set for the borrower.  For example,
171 if a user has the "editcatalogue" permission,
172 C<$borrower-E<gt>{authflags}-E<gt>{editcatalogue}> will exist and have
173 the value "1".
174
175 =cut
176
177 sub GetMemberDetails {
178     my ( $borrowernumber, $cardnumber ) = @_;
179     my $dbh = C4::Context->dbh;
180     my $query;
181     my $sth;
182     if ($borrowernumber) {
183         $sth = $dbh->prepare("
184             SELECT borrowers.*,
185                    category_type,
186                    categories.description,
187                    categories.BlockExpiredPatronOpacActions,
188                    reservefee,
189                    enrolmentperiod
190             FROM borrowers
191             LEFT JOIN categories ON borrowers.categorycode=categories.categorycode
192             WHERE borrowernumber = ?
193         ");
194         $sth->execute($borrowernumber);
195     }
196     elsif ($cardnumber) {
197         $sth = $dbh->prepare("
198             SELECT borrowers.*,
199                    category_type,
200                    categories.description,
201                    categories.BlockExpiredPatronOpacActions,
202                    reservefee,
203                    enrolmentperiod
204             FROM borrowers
205             LEFT JOIN categories ON borrowers.categorycode = categories.categorycode
206             WHERE cardnumber = ?
207         ");
208         $sth->execute($cardnumber);
209     }
210     else {
211         return;
212     }
213     my $borrower = $sth->fetchrow_hashref;
214     return unless $borrower;
215     my ($amount) = GetMemberAccountRecords($borrower->{borrowernumber});
216     $borrower->{'amountoutstanding'} = $amount;
217     # FIXME - patronflags calls GetMemberAccountRecords... just have patronflags return $amount
218     my $flags = patronflags( $borrower);
219     my $accessflagshash;
220
221     $sth = $dbh->prepare("select bit,flag from userflags");
222     $sth->execute;
223     while ( my ( $bit, $flag ) = $sth->fetchrow ) {
224         if ( $borrower->{'flags'} && $borrower->{'flags'} & 2**$bit ) {
225             $accessflagshash->{$flag} = 1;
226         }
227     }
228     $borrower->{'flags'}     = $flags;
229     $borrower->{'authflags'} = $accessflagshash;
230
231     # Handle setting the true behavior for BlockExpiredPatronOpacActions
232     $borrower->{'BlockExpiredPatronOpacActions'} =
233       C4::Context->preference('BlockExpiredPatronOpacActions')
234       if ( $borrower->{'BlockExpiredPatronOpacActions'} == -1 );
235
236     $borrower->{'is_expired'} = 0;
237     $borrower->{'is_expired'} = 1 if
238       defined($borrower->{dateexpiry}) &&
239       $borrower->{'dateexpiry'} ne '0000-00-00' &&
240       Date_to_Days( Today() ) >
241       Date_to_Days( split /-/, $borrower->{'dateexpiry'} );
242
243     return ($borrower);    #, $flags, $accessflagshash);
244 }
245
246 =head2 patronflags
247
248  $flags = &patronflags($patron);
249
250 This function is not exported.
251
252 The following will be set where applicable:
253  $flags->{CHARGES}->{amount}        Amount of debt
254  $flags->{CHARGES}->{noissues}      Set if debt amount >$5.00 (or syspref noissuescharge)
255  $flags->{CHARGES}->{message}       Message -- deprecated
256
257  $flags->{CREDITS}->{amount}        Amount of credit
258  $flags->{CREDITS}->{message}       Message -- deprecated
259
260  $flags->{  GNA  }                  Patron has no valid address
261  $flags->{  GNA  }->{noissues}      Set for each GNA
262  $flags->{  GNA  }->{message}       "Borrower has no valid address" -- deprecated
263
264  $flags->{ LOST  }                  Patron's card reported lost
265  $flags->{ LOST  }->{noissues}      Set for each LOST
266  $flags->{ LOST  }->{message}       Message -- deprecated
267
268  $flags->{DBARRED}                  Set if patron debarred, no access
269  $flags->{DBARRED}->{noissues}      Set for each DBARRED
270  $flags->{DBARRED}->{message}       Message -- deprecated
271
272  $flags->{ NOTES }
273  $flags->{ NOTES }->{message}       The note itself.  NOT deprecated
274
275  $flags->{ ODUES }                  Set if patron has overdue books.
276  $flags->{ ODUES }->{message}       "Yes"  -- deprecated
277  $flags->{ ODUES }->{itemlist}      ref-to-array: list of overdue books
278  $flags->{ ODUES }->{itemlisttext}  Text list of overdue items -- deprecated
279
280  $flags->{WAITING}                  Set if any of patron's reserves are available
281  $flags->{WAITING}->{message}       Message -- deprecated
282  $flags->{WAITING}->{itemlist}      ref-to-array: list of available items
283
284 =over 
285
286 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the
287 overdue items. Its elements are references-to-hash, each describing an
288 overdue item. The keys are selected fields from the issues, biblio,
289 biblioitems, and items tables of the Koha database.
290
291 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlisttext}> is a string giving a text listing of
292 the overdue items, one per line.  Deprecated.
293
294 =item C<$flags-E<gt>{WAITING}-E<gt>{itemlist}> is a reference-to-array listing the
295 available items. Each element is a reference-to-hash whose keys are
296 fields from the reserves table of the Koha database.
297
298 =back
299
300 All the "message" fields that include language generated in this function are deprecated, 
301 because such strings belong properly in the display layer.
302
303 The "message" field that comes from the DB is OK.
304
305 =cut
306
307 # TODO: use {anonymous => hashes} instead of a dozen %flaginfo
308 # FIXME rename this function.
309 sub patronflags {
310     my %flags;
311     my ( $patroninformation) = @_;
312     my $dbh=C4::Context->dbh;
313     my ($balance, $owing) = GetMemberAccountBalance( $patroninformation->{'borrowernumber'});
314     if ( $owing > 0 ) {
315         my %flaginfo;
316         my $noissuescharge = C4::Context->preference("noissuescharge") || 5;
317         $flaginfo{'message'} = sprintf 'Patron owes %.02f', $owing;
318         $flaginfo{'amount'}  = sprintf "%.02f", $owing;
319         if ( $owing > $noissuescharge && !C4::Context->preference("AllowFineOverride") ) {
320             $flaginfo{'noissues'} = 1;
321         }
322         $flags{'CHARGES'} = \%flaginfo;
323     }
324     elsif ( $balance < 0 ) {
325         my %flaginfo;
326         $flaginfo{'message'} = sprintf 'Patron has credit of %.02f', -$balance;
327         $flaginfo{'amount'}  = sprintf "%.02f", $balance;
328         $flags{'CREDITS'} = \%flaginfo;
329     }
330
331     # Check the debt of the guarntees of this patron
332     my $no_issues_charge_guarantees = C4::Context->preference("NoIssuesChargeGuarantees");
333     $no_issues_charge_guarantees = undef unless looks_like_number( $no_issues_charge_guarantees );
334     if ( defined $no_issues_charge_guarantees ) {
335         my $p = Koha::Patrons->find( $patroninformation->{borrowernumber} );
336         my @guarantees = $p->guarantees();
337         my $guarantees_non_issues_charges;
338         foreach my $g ( @guarantees ) {
339             my ( $b, $n, $o ) = C4::Members::GetMemberAccountBalance( $g->id );
340             $guarantees_non_issues_charges += $n;
341         }
342
343         if ( $guarantees_non_issues_charges > $no_issues_charge_guarantees ) {
344             my %flaginfo;
345             $flaginfo{'message'} = sprintf 'patron guarantees owe %.02f', $guarantees_non_issues_charges;
346             $flaginfo{'amount'}  = $guarantees_non_issues_charges;
347             $flaginfo{'noissues'} = 1 unless C4::Context->preference("allowfineoverride");
348             $flags{'CHARGES_GUARANTEES'} = \%flaginfo;
349         }
350     }
351
352     if (   $patroninformation->{'gonenoaddress'}
353         && $patroninformation->{'gonenoaddress'} == 1 )
354     {
355         my %flaginfo;
356         $flaginfo{'message'}  = 'Borrower has no valid address.';
357         $flaginfo{'noissues'} = 1;
358         $flags{'GNA'}         = \%flaginfo;
359     }
360     if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
361         my %flaginfo;
362         $flaginfo{'message'}  = 'Borrower\'s card reported lost.';
363         $flaginfo{'noissues'} = 1;
364         $flags{'LOST'}        = \%flaginfo;
365     }
366     if ( $patroninformation->{'debarred'} && check_date( split( /-/, $patroninformation->{'debarred'} ) ) ) {
367         if ( Date_to_Days(Date::Calc::Today) < Date_to_Days( split( /-/, $patroninformation->{'debarred'} ) ) ) {
368             my %flaginfo;
369             $flaginfo{'debarredcomment'} = $patroninformation->{'debarredcomment'};
370             $flaginfo{'message'}         = $patroninformation->{'debarredcomment'};
371             $flaginfo{'noissues'}        = 1;
372             $flaginfo{'dateend'}         = $patroninformation->{'debarred'};
373             $flags{'DBARRED'}           = \%flaginfo;
374         }
375     }
376     if (   $patroninformation->{'borrowernotes'}
377         && $patroninformation->{'borrowernotes'} )
378     {
379         my %flaginfo;
380         $flaginfo{'message'} = $patroninformation->{'borrowernotes'};
381         $flags{'NOTES'}      = \%flaginfo;
382     }
383     my ( $odues, $itemsoverdue ) = C4::Overdues::checkoverdues($patroninformation->{'borrowernumber'});
384     if ( $odues && $odues > 0 ) {
385         my %flaginfo;
386         $flaginfo{'message'}  = "Yes";
387         $flaginfo{'itemlist'} = $itemsoverdue;
388         foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
389             @$itemsoverdue )
390         {
391             $flaginfo{'itemlisttext'} .=
392               "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n";  # newline is display layer
393         }
394         $flags{'ODUES'} = \%flaginfo;
395     }
396     my @itemswaiting = C4::Reserves::GetReservesFromBorrowernumber( $patroninformation->{'borrowernumber'},'W' );
397     my $nowaiting = scalar @itemswaiting;
398     if ( $nowaiting > 0 ) {
399         my %flaginfo;
400         $flaginfo{'message'}  = "Reserved items available";
401         $flaginfo{'itemlist'} = \@itemswaiting;
402         $flags{'WAITING'}     = \%flaginfo;
403     }
404     return ( \%flags );
405 }
406
407
408 =head2 GetMember
409
410   $borrower = &GetMember(%information);
411
412 Retrieve the first patron record meeting on criteria listed in the
413 C<%information> hash, which should contain one or more
414 pairs of borrowers column names and values, e.g.,
415
416    $borrower = GetMember(borrowernumber => id);
417
418 C<&GetBorrower> returns a reference-to-hash whose keys are the fields of
419 the C<borrowers> table in the Koha database.
420
421 FIXME: GetMember() is used throughout the code as a lookup
422 on a unique key such as the borrowernumber, but this meaning is not
423 enforced in the routine itself.
424
425 =cut
426
427 #'
428 sub GetMember {
429     my ( %information ) = @_;
430     if (exists $information{borrowernumber} && !defined $information{borrowernumber}) {
431         #passing mysql's kohaadmin?? Makes no sense as a query
432         return;
433     }
434     my $dbh = C4::Context->dbh;
435     my $select =
436     q{SELECT borrowers.*, categories.category_type, categories.description
437     FROM borrowers 
438     LEFT JOIN categories on borrowers.categorycode=categories.categorycode WHERE };
439     my $more_p = 0;
440     my @values = ();
441     for (keys %information ) {
442         if ($more_p) {
443             $select .= ' AND ';
444         }
445         else {
446             $more_p++;
447         }
448
449         if (defined $information{$_}) {
450             $select .= "$_ = ?";
451             push @values, $information{$_};
452         }
453         else {
454             $select .= "$_ IS NULL";
455         }
456     }
457     $debug && warn $select, " ",values %information;
458     my $sth = $dbh->prepare("$select");
459     $sth->execute(@values);
460     my $data = $sth->fetchall_arrayref({});
461     #FIXME interface to this routine now allows generation of a result set
462     #so whole array should be returned but bowhere in the current code expects this
463     if (@{$data} ) {
464         return $data->[0];
465     }
466
467     return;
468 }
469
470 =head2 IsMemberBlocked
471
472   my ($block_status, $count) = IsMemberBlocked( $borrowernumber );
473
474 Returns whether a patron is restricted or has overdue items that may result
475 in a block of circulation privileges.
476
477 C<$block_status> can have the following values:
478
479 1 if the patron is currently restricted, in which case
480 C<$count> is the expiration date (9999-12-31 for indefinite)
481
482 -1 if the patron has overdue items, in which case C<$count> is the number of them
483
484 0 if the patron has no overdue items or outstanding fine days, in which case C<$count> is 0
485
486 Existing active restrictions are checked before current overdue items.
487
488 =cut
489
490 sub IsMemberBlocked {
491     my $borrowernumber = shift;
492     my $dbh            = C4::Context->dbh;
493
494     my $blockeddate = Koha::Patron::Debarments::IsDebarred($borrowernumber);
495
496     return ( 1, $blockeddate ) if $blockeddate;
497
498     # if he have late issues
499     my $sth = $dbh->prepare(
500         "SELECT COUNT(*) as latedocs
501          FROM issues
502          WHERE borrowernumber = ?
503          AND date_due < now()"
504     );
505     $sth->execute($borrowernumber);
506     my $latedocs = $sth->fetchrow_hashref->{'latedocs'};
507
508     return ( -1, $latedocs ) if $latedocs > 0;
509
510     return ( 0, 0 );
511 }
512
513 =head2 GetMemberIssuesAndFines
514
515   ($overdue_count, $issue_count, $total_fines) = &GetMemberIssuesAndFines($borrowernumber);
516
517 Returns aggregate data about items borrowed by the patron with the
518 given borrowernumber.
519
520 C<&GetMemberIssuesAndFines> returns a three-element array.  C<$overdue_count> is the
521 number of overdue items the patron currently has borrowed. C<$issue_count> is the
522 number of books the patron currently has borrowed.  C<$total_fines> is
523 the total fine currently due by the borrower.
524
525 =cut
526
527 #'
528 sub GetMemberIssuesAndFines {
529     my ( $borrowernumber ) = @_;
530     my $dbh   = C4::Context->dbh;
531     my $query = "SELECT COUNT(*) FROM issues WHERE borrowernumber = ?";
532
533     $debug and warn $query."\n";
534     my $sth = $dbh->prepare($query);
535     $sth->execute($borrowernumber);
536     my $issue_count = $sth->fetchrow_arrayref->[0];
537
538     $sth = $dbh->prepare(
539         "SELECT COUNT(*) FROM issues 
540          WHERE borrowernumber = ? 
541          AND date_due < now()"
542     );
543     $sth->execute($borrowernumber);
544     my $overdue_count = $sth->fetchrow_arrayref->[0];
545
546     $sth = $dbh->prepare("SELECT SUM(amountoutstanding) FROM accountlines WHERE borrowernumber = ?");
547     $sth->execute($borrowernumber);
548     my $total_fines = $sth->fetchrow_arrayref->[0];
549
550     return ($overdue_count, $issue_count, $total_fines);
551 }
552
553
554 =head2 columns
555
556   my @columns = C4::Member::columns();
557
558 Returns an array of borrowers' table columns on success,
559 and an empty array on failure.
560
561 =cut
562
563 sub columns {
564
565     # Pure ANSI SQL goodness.
566     my $sql = 'SELECT * FROM borrowers WHERE 1=0;';
567
568     # Get the database handle.
569     my $dbh = C4::Context->dbh;
570
571     # Run the SQL statement to load STH's readonly properties.
572     my $sth = $dbh->prepare($sql);
573     my $rv = $sth->execute();
574
575     # This only fails if the table doesn't exist.
576     # This will always be called AFTER an install or upgrade,
577     # so borrowers will exist!
578     my @data;
579     if ($sth->{NUM_OF_FIELDS}>0) {
580         @data = @{$sth->{NAME}};
581     }
582     else {
583         @data = ();
584     }
585     return @data;
586 }
587
588
589 =head2 ModMember
590
591   my $success = ModMember(borrowernumber => $borrowernumber,
592                                             [ field => value ]... );
593
594 Modify borrower's data.  All date fields should ALREADY be in ISO format.
595
596 return :
597 true on success, or false on failure
598
599 =cut
600
601 sub ModMember {
602     my (%data) = @_;
603     # test to know if you must update or not the borrower password
604     if (exists $data{password}) {
605         if ($data{password} eq '****' or $data{password} eq '') {
606             delete $data{password};
607         } else {
608             if ( C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
609                 # Update the hashed PIN in borrower_sync.hashed_pin, before Koha hashes it
610                 Koha::NorwegianPatronDB::NLUpdateHashedPIN( $data{'borrowernumber'}, $data{password} );
611             }
612             $data{password} = hash_password($data{password});
613         }
614     }
615
616     my $old_categorycode = GetBorrowerCategorycode( $data{borrowernumber} );
617
618     # get only the columns of a borrower
619     my $schema = Koha::Database->new()->schema;
620     my @columns = $schema->source('Borrower')->columns;
621     my $new_borrower = { map { join(' ', @columns) =~ /$_/ ? ( $_ => $data{$_} ) : () } keys(%data) };
622     delete $new_borrower->{flags};
623
624     $new_borrower->{dateofbirth}     ||= undef if exists $new_borrower->{dateofbirth};
625     $new_borrower->{dateenrolled}    ||= undef if exists $new_borrower->{dateenrolled};
626     $new_borrower->{dateexpiry}      ||= undef if exists $new_borrower->{dateexpiry};
627     $new_borrower->{debarred}        ||= undef if exists $new_borrower->{debarred};
628     $new_borrower->{sms_provider_id} ||= undef if exists $new_borrower->{sms_provider_id};
629
630     my $rs = $schema->resultset('Borrower')->search({
631         borrowernumber => $new_borrower->{borrowernumber},
632      });
633
634     my $execute_success = $rs->update($new_borrower);
635     if ($execute_success ne '0E0') { # only proceed if the update was a success
636         # If the patron changes to a category with enrollment fee, we add a fee
637         if ( $data{categorycode} and $data{categorycode} ne $old_categorycode ) {
638             if ( C4::Context->preference('FeeOnChangePatronCategory') ) {
639                 AddEnrolmentFeeIfNeeded( $data{categorycode}, $data{borrowernumber} );
640             }
641         }
642
643         # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
644         # cronjob will use for syncing with NL
645         if ( C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
646             my $borrowersync = Koha::Database->new->schema->resultset('BorrowerSync')->find({
647                 'synctype'       => 'norwegianpatrondb',
648                 'borrowernumber' => $data{'borrowernumber'}
649             });
650             # Do not set to "edited" if syncstatus is "new". We need to sync as new before
651             # we can sync as changed. And the "new sync" will pick up all changes since
652             # the patron was created anyway.
653             if ( $borrowersync->syncstatus ne 'new' && $borrowersync->syncstatus ne 'delete' ) {
654                 $borrowersync->update( { 'syncstatus' => 'edited' } );
655             }
656             # Set the value of 'sync'
657             $borrowersync->update( { 'sync' => $data{'sync'} } );
658             # Try to do the live sync
659             Koha::NorwegianPatronDB::NLSync({ 'borrowernumber' => $data{'borrowernumber'} });
660         }
661
662         logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "UPDATE (executed w/ arg: $data{'borrowernumber'})") if C4::Context->preference("BorrowersLog");
663     }
664     return $execute_success;
665 }
666
667 =head2 AddMember
668
669   $borrowernumber = &AddMember(%borrower);
670
671 insert new borrower into table
672
673 (%borrower keys are database columns. Database columns could be
674 different in different versions. Please look into database for correct
675 column names.)
676
677 Returns the borrowernumber upon success
678
679 Returns as undef upon any db error without further processing
680
681 =cut
682
683 #'
684 sub AddMember {
685     my (%data) = @_;
686     my $dbh = C4::Context->dbh;
687     my $schema = Koha::Database->new()->schema;
688
689     # generate a proper login if none provided
690     $data{'userid'} = Generate_Userid( $data{'borrowernumber'}, $data{'firstname'}, $data{'surname'} )
691       if ( $data{'userid'} eq '' || !Check_Userid( $data{'userid'} ) );
692
693     # add expiration date if it isn't already there
694     unless ( $data{'dateexpiry'} ) {
695         $data{'dateexpiry'} = GetExpiryDate( $data{'categorycode'}, output_pref( { dt => dt_from_string, dateonly => 1, dateformat => 'iso' } ) );
696     }
697
698     # add enrollment date if it isn't already there
699     unless ( $data{'dateenrolled'} ) {
700         $data{'dateenrolled'} = output_pref( { dt => dt_from_string, dateonly => 1, dateformat => 'iso' } );
701     }
702
703     my $patron_category = $schema->resultset('Category')->find( $data{'categorycode'} );
704     $data{'privacy'} =
705         $patron_category->default_privacy() eq 'default' ? 1
706       : $patron_category->default_privacy() eq 'never'   ? 2
707       : $patron_category->default_privacy() eq 'forever' ? 0
708       :                                                    undef;
709
710     $data{'privacy_guarantor_checkouts'} = 0 unless defined( $data{'privacy_guarantor_checkouts'} );
711
712     # Make a copy of the plain text password for later use
713     my $plain_text_password = $data{'password'};
714
715     # create a disabled account if no password provided
716     $data{'password'} = ($data{'password'})? hash_password($data{'password'}) : '!';
717
718     # we don't want invalid dates in the db (mysql has a bad habit of inserting 0000-00-00
719     $data{'dateofbirth'}     = undef if ( not $data{'dateofbirth'} );
720     $data{'debarred'}        = undef if ( not $data{'debarred'} );
721     $data{'sms_provider_id'} = undef if ( not $data{'sms_provider_id'} );
722
723     # get only the columns of Borrower
724     my @columns = $schema->source('Borrower')->columns;
725     my $new_member = { map { join(' ',@columns) =~ /$_/ ? ( $_ => $data{$_} )  : () } keys(%data) } ;
726     delete $new_member->{borrowernumber};
727
728     my $rs = $schema->resultset('Borrower');
729     $data{borrowernumber} = $rs->create($new_member)->id;
730
731     # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
732     # cronjob will use for syncing with NL
733     if ( exists $data{'borrowernumber'} && C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
734         Koha::Database->new->schema->resultset('BorrowerSync')->create({
735             'borrowernumber' => $data{'borrowernumber'},
736             'synctype'       => 'norwegianpatrondb',
737             'sync'           => 1,
738             'syncstatus'     => 'new',
739             'hashed_pin'     => Koha::NorwegianPatronDB::NLEncryptPIN( $plain_text_password ),
740         });
741     }
742
743     # mysql_insertid is probably bad.  not necessarily accurate and mysql-specific at best.
744     logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");
745
746     AddEnrolmentFeeIfNeeded( $data{categorycode}, $data{borrowernumber} );
747
748     return $data{borrowernumber};
749 }
750
751 =head2 Check_Userid
752
753     my $uniqueness = Check_Userid($userid,$borrowernumber);
754
755     $borrowernumber is optional (i.e. it can contain a blank value). If $userid is passed with a blank $borrowernumber variable, the database will be checked for all instances of that userid (i.e. userid=? AND borrowernumber != '').
756
757     If $borrowernumber is provided, the database will be checked for every instance of that userid coupled with a different borrower(number) than the one provided.
758
759     return :
760         0 for not unique (i.e. this $userid already exists)
761         1 for unique (i.e. this $userid does not exist, or this $userid/$borrowernumber combination already exists)
762
763 =cut
764
765 sub Check_Userid {
766     my ( $uid, $borrowernumber ) = @_;
767
768     return 0 unless ($uid); # userid is a unique column, we should assume NULL is not unique
769
770     return 0 if ( $uid eq C4::Context->config('user') );
771
772     my $rs = Koha::Database->new()->schema()->resultset('Borrower');
773
774     my $params;
775     $params->{userid} = $uid;
776     $params->{borrowernumber} = { '!=' => $borrowernumber } if ($borrowernumber);
777
778     my $count = $rs->count( $params );
779
780     return $count ? 0 : 1;
781 }
782
783 =head2 Generate_Userid
784
785     my $newuid = Generate_Userid($borrowernumber, $firstname, $surname);
786
787     Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
788
789     $borrowernumber is optional (i.e. it can contain a blank value). A value is passed when generating a new userid for an existing borrower. When a new userid is created for a new borrower, a blank value is passed to this sub.
790
791     return :
792         new userid ($firstname.$surname if there is a $firstname, or $surname if there is no value in $firstname) plus offset (0 if the $newuid is unique, or a higher numeric value if Check_Userid finds an existing match for the $newuid in the database).
793
794 =cut
795
796 sub Generate_Userid {
797   my ($borrowernumber, $firstname, $surname) = @_;
798   my $newuid;
799   my $offset = 0;
800   #The script will "do" the following code and increment the $offset until Check_Userid = 1 (i.e. until $newuid comes back as unique)
801   do {
802     $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
803     $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
804     $newuid = lc(($firstname)? "$firstname.$surname" : $surname);
805     $newuid = unac_string('utf-8',$newuid);
806     $newuid .= $offset unless $offset == 0;
807     $offset++;
808
809    } while (!Check_Userid($newuid,$borrowernumber));
810
811    return $newuid;
812 }
813
814 sub changepassword {
815     my ( $uid, $member, $digest ) = @_;
816     my $dbh = C4::Context->dbh;
817
818 #Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
819 #Then we need to tell the user and have them create a new one.
820     my $resultcode;
821     my $sth =
822       $dbh->prepare(
823         "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
824     $sth->execute( $uid, $member );
825     if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
826         $resultcode=0;
827     }
828     else {
829         #Everything is good so we can update the information.
830         $sth =
831           $dbh->prepare(
832             "update borrowers set userid=?, password=? where borrowernumber=?");
833         $sth->execute( $uid, $digest, $member );
834         $resultcode=1;
835     }
836     
837     logaction("MEMBERS", "CHANGE PASS", $member, "") if C4::Context->preference("BorrowersLog");
838     return $resultcode;    
839 }
840
841
842
843 =head2 fixup_cardnumber
844
845 Warning: The caller is responsible for locking the members table in write
846 mode, to avoid database corruption.
847
848 =cut
849
850 use vars qw( @weightings );
851 my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
852
853 sub fixup_cardnumber {
854     my ($cardnumber) = @_;
855     my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0;
856
857     # Find out whether member numbers should be generated
858     # automatically. Should be either "1" or something else.
859     # Defaults to "0", which is interpreted as "no".
860
861     #     if ($cardnumber !~ /\S/ && $autonumber_members) {
862     ($autonumber_members) or return $cardnumber;
863     my $checkdigit = C4::Context->preference('checkdigit');
864     my $dbh = C4::Context->dbh;
865     if ( $checkdigit and $checkdigit eq 'katipo' ) {
866
867         # if checkdigit is selected, calculate katipo-style cardnumber.
868         # otherwise, just use the max()
869         # purpose: generate checksum'd member numbers.
870         # We'll assume we just got the max value of digits 2-8 of member #'s
871         # from the database and our job is to increment that by one,
872         # determine the 1st and 9th digits and return the full string.
873         my $sth = $dbh->prepare(
874             "select max(substring(borrowers.cardnumber,2,7)) as new_num from borrowers"
875         );
876         $sth->execute;
877         my $data = $sth->fetchrow_hashref;
878         $cardnumber = $data->{new_num};
879         if ( !$cardnumber ) {    # If DB has no values,
880             $cardnumber = 1000000;    # start at 1000000
881         } else {
882             $cardnumber += 1;
883         }
884
885         my $sum = 0;
886         for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
887             # read weightings, left to right, 1 char at a time
888             my $temp1 = $weightings[$i];
889
890             # sequence left to right, 1 char at a time
891             my $temp2 = substr( $cardnumber, $i, 1 );
892
893             # mult each char 1-7 by its corresponding weighting
894             $sum += $temp1 * $temp2;
895         }
896
897         my $rem = ( $sum % 11 );
898         $rem = 'X' if $rem == 10;
899
900         return "V$cardnumber$rem";
901      } else {
902
903         my $sth = $dbh->prepare(
904             'SELECT MAX( CAST( cardnumber AS SIGNED ) ) FROM borrowers WHERE cardnumber REGEXP "^-?[0-9]+$"'
905         );
906         $sth->execute;
907         my ($result) = $sth->fetchrow;
908         return $result + 1;
909     }
910     return $cardnumber;     # just here as a fallback/reminder 
911 }
912
913 =head2 GetPendingIssues
914
915   my $issues = &GetPendingIssues(@borrowernumber);
916
917 Looks up what the patron with the given borrowernumber has borrowed.
918
919 C<&GetPendingIssues> returns a
920 reference-to-array where each element is a reference-to-hash; the
921 keys are the fields from the C<issues>, C<biblio>, and C<items> tables.
922 The keys include C<biblioitems> fields except marc and marcxml.
923
924 =cut
925
926 sub GetPendingIssues {
927     my @borrowernumbers = @_;
928
929     unless (@borrowernumbers ) { # return a ref_to_array
930         return \@borrowernumbers; # to not cause surprise to caller
931     }
932
933     # Borrowers part of the query
934     my $bquery = '';
935     for (my $i = 0; $i < @borrowernumbers; $i++) {
936         $bquery .= ' issues.borrowernumber = ?';
937         if ($i < $#borrowernumbers ) {
938             $bquery .= ' OR';
939         }
940     }
941
942     # must avoid biblioitems.* to prevent large marc and marcxml fields from killing performance
943     # FIXME: namespace collision: each table has "timestamp" fields.  Which one is "timestamp" ?
944     # FIXME: circ/ciculation.pl tries to sort by timestamp!
945     # FIXME: namespace collision: other collisions possible.
946     # FIXME: most of this data isn't really being used by callers.
947     my $query =
948    "SELECT issues.*,
949             items.*,
950            biblio.*,
951            biblioitems.volume,
952            biblioitems.number,
953            biblioitems.itemtype,
954            biblioitems.isbn,
955            biblioitems.issn,
956            biblioitems.publicationyear,
957            biblioitems.publishercode,
958            biblioitems.volumedate,
959            biblioitems.volumedesc,
960            biblioitems.lccn,
961            biblioitems.url,
962            borrowers.firstname,
963            borrowers.surname,
964            borrowers.cardnumber,
965            issues.timestamp AS timestamp,
966            issues.renewals  AS renewals,
967            issues.borrowernumber AS borrowernumber,
968             items.renewals  AS totalrenewals
969     FROM   issues
970     LEFT JOIN items       ON items.itemnumber       =      issues.itemnumber
971     LEFT JOIN biblio      ON items.biblionumber     =      biblio.biblionumber
972     LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
973     LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
974     WHERE
975       $bquery
976     ORDER BY issues.issuedate"
977     ;
978
979     my $sth = C4::Context->dbh->prepare($query);
980     $sth->execute(@borrowernumbers);
981     my $data = $sth->fetchall_arrayref({});
982     my $today = dt_from_string;
983     foreach (@{$data}) {
984         if ($_->{issuedate}) {
985             $_->{issuedate} = dt_from_string($_->{issuedate}, 'sql');
986         }
987         $_->{date_due_sql} = $_->{date_due};
988         # FIXME no need to have this value
989         $_->{date_due} or next;
990         $_->{date_due_sql} = $_->{date_due};
991         # FIXME no need to have this value
992         $_->{date_due} = dt_from_string($_->{date_due}, 'sql');
993         if ( DateTime->compare($_->{date_due}, $today) == -1 ) {
994             $_->{overdue} = 1;
995         }
996     }
997     return $data;
998 }
999
1000 =head2 GetAllIssues
1001
1002   $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
1003
1004 Looks up what the patron with the given borrowernumber has borrowed,
1005 and sorts the results.
1006
1007 C<$sortkey> is the name of a field on which to sort the results. This
1008 should be the name of a field in the C<issues>, C<biblio>,
1009 C<biblioitems>, or C<items> table in the Koha database.
1010
1011 C<$limit> is the maximum number of results to return.
1012
1013 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
1014 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
1015 C<items> tables of the Koha database.
1016
1017 =cut
1018
1019 #'
1020 sub GetAllIssues {
1021     my ( $borrowernumber, $order, $limit ) = @_;
1022
1023     return unless $borrowernumber;
1024     $order = 'date_due desc' unless $order;
1025
1026     my $dbh = C4::Context->dbh;
1027     my $query =
1028 'SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1029   FROM issues 
1030   LEFT JOIN items on items.itemnumber=issues.itemnumber
1031   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1032   LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1033   WHERE borrowernumber=? 
1034   UNION ALL
1035   SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp 
1036   FROM old_issues 
1037   LEFT JOIN items on items.itemnumber=old_issues.itemnumber
1038   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1039   LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1040   WHERE borrowernumber=? AND old_issues.itemnumber IS NOT NULL
1041   order by ' . $order;
1042     if ($limit) {
1043         $query .= " limit $limit";
1044     }
1045
1046     my $sth = $dbh->prepare($query);
1047     $sth->execute( $borrowernumber, $borrowernumber );
1048     return $sth->fetchall_arrayref( {} );
1049 }
1050
1051
1052 =head2 GetMemberAccountRecords
1053
1054   ($total, $acctlines, $count) = &GetMemberAccountRecords($borrowernumber);
1055
1056 Looks up accounting data for the patron with the given borrowernumber.
1057
1058 C<&GetMemberAccountRecords> returns a three-element array. C<$acctlines> is a
1059 reference-to-array, where each element is a reference-to-hash; the
1060 keys are the fields of the C<accountlines> table in the Koha database.
1061 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1062 total amount outstanding for all of the account lines.
1063
1064 =cut
1065
1066 sub GetMemberAccountRecords {
1067     my ($borrowernumber) = @_;
1068     my $dbh = C4::Context->dbh;
1069     my @acctlines;
1070     my $numlines = 0;
1071     my $strsth      = qq(
1072                         SELECT * 
1073                         FROM accountlines 
1074                         WHERE borrowernumber=?);
1075     $strsth.=" ORDER BY accountlines_id desc";
1076     my $sth= $dbh->prepare( $strsth );
1077     $sth->execute( $borrowernumber );
1078
1079     my $total = 0;
1080     while ( my $data = $sth->fetchrow_hashref ) {
1081         if ( $data->{itemnumber} ) {
1082             my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
1083             $data->{biblionumber} = $biblio->{biblionumber};
1084             $data->{title}        = $biblio->{title};
1085         }
1086         $acctlines[$numlines] = $data;
1087         $numlines++;
1088         $total += sprintf "%.0f", 1000*$data->{amountoutstanding}; # convert float to integer to avoid round-off errors
1089     }
1090     $total /= 1000;
1091     return ( $total, \@acctlines,$numlines);
1092 }
1093
1094 =head2 GetMemberAccountBalance
1095
1096   ($total_balance, $non_issue_balance, $other_charges) = &GetMemberAccountBalance($borrowernumber);
1097
1098 Calculates amount immediately owing by the patron - non-issue charges.
1099 Based on GetMemberAccountRecords.
1100 Charges exempt from non-issue are:
1101 * Res (reserves)
1102 * Rent (rental) if RentalsInNoissuesCharge syspref is set to false
1103 * Manual invoices if ManInvInNoissuesCharge syspref is set to false
1104
1105 =cut
1106
1107 sub GetMemberAccountBalance {
1108     my ($borrowernumber) = @_;
1109
1110     my $ACCOUNT_TYPE_LENGTH = 5; # this is plain ridiculous...
1111
1112     my @not_fines;
1113     push @not_fines, 'Res' unless C4::Context->preference('HoldsInNoissuesCharge');
1114     push @not_fines, 'Rent' unless C4::Context->preference('RentalsInNoissuesCharge');
1115     unless ( C4::Context->preference('ManInvInNoissuesCharge') ) {
1116         my $dbh = C4::Context->dbh;
1117         my $man_inv_types = $dbh->selectcol_arrayref(qq{SELECT authorised_value FROM authorised_values WHERE category = 'MANUAL_INV'});
1118         push @not_fines, map substr($_, 0, $ACCOUNT_TYPE_LENGTH), @$man_inv_types;
1119     }
1120     my %not_fine = map {$_ => 1} @not_fines;
1121
1122     my ($total, $acctlines) = GetMemberAccountRecords($borrowernumber);
1123     my $other_charges = 0;
1124     foreach (@$acctlines) {
1125         $other_charges += $_->{amountoutstanding} if $not_fine{ substr($_->{accounttype}, 0, $ACCOUNT_TYPE_LENGTH) };
1126     }
1127
1128     return ( $total, $total - $other_charges, $other_charges);
1129 }
1130
1131 =head2 GetBorNotifyAcctRecord
1132
1133   ($total, $acctlines, $count) = &GetBorNotifyAcctRecord($params,$notifyid);
1134
1135 Looks up accounting data for the patron with the given borrowernumber per file number.
1136
1137 C<&GetBorNotifyAcctRecord> returns a three-element array. C<$acctlines> is a
1138 reference-to-array, where each element is a reference-to-hash; the
1139 keys are the fields of the C<accountlines> table in the Koha database.
1140 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1141 total amount outstanding for all of the account lines.
1142
1143 =cut
1144
1145 sub GetBorNotifyAcctRecord {
1146     my ( $borrowernumber, $notifyid ) = @_;
1147     my $dbh = C4::Context->dbh;
1148     my @acctlines;
1149     my $numlines = 0;
1150     my $sth = $dbh->prepare(
1151             "SELECT * 
1152                 FROM accountlines 
1153                 WHERE borrowernumber=? 
1154                     AND notify_id=? 
1155                     AND amountoutstanding != '0' 
1156                 ORDER BY notify_id,accounttype
1157                 ");
1158
1159     $sth->execute( $borrowernumber, $notifyid );
1160     my $total = 0;
1161     while ( my $data = $sth->fetchrow_hashref ) {
1162         if ( $data->{itemnumber} ) {
1163             my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
1164             $data->{biblionumber} = $biblio->{biblionumber};
1165             $data->{title}        = $biblio->{title};
1166         }
1167         $acctlines[$numlines] = $data;
1168         $numlines++;
1169         $total += int(100 * $data->{'amountoutstanding'});
1170     }
1171     $total /= 100;
1172     return ( $total, \@acctlines, $numlines );
1173 }
1174
1175 =head2 checkuniquemember (OUEST-PROVENCE)
1176
1177   ($result,$categorycode)  = &checkuniquemember($collectivity,$surname,$firstname,$dateofbirth);
1178
1179 Checks that a member exists or not in the database.
1180
1181 C<&result> is nonzero (=exist) or 0 (=does not exist)
1182 C<&categorycode> is from categorycode table
1183 C<&collectivity> is 1 (= we add a collectivity) or 0 (= we add a physical member)
1184 C<&surname> is the surname
1185 C<&firstname> is the firstname (only if collectivity=0)
1186 C<&dateofbirth> is the date of birth in ISO format (only if collectivity=0)
1187
1188 =cut
1189
1190 # FIXME: This function is not legitimate.  Multiple patrons might have the same first/last name and birthdate.
1191 # This is especially true since first name is not even a required field.
1192
1193 sub checkuniquemember {
1194     my ( $collectivity, $surname, $firstname, $dateofbirth ) = @_;
1195     my $dbh = C4::Context->dbh;
1196     my $request = ($collectivity) ?
1197         "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? " :
1198             ($dateofbirth) ?
1199             "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=?  and dateofbirth=?" :
1200             "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=?";
1201     my $sth = $dbh->prepare($request);
1202     if ($collectivity) {
1203         $sth->execute( uc($surname) );
1204     } elsif($dateofbirth){
1205         $sth->execute( uc($surname), ucfirst($firstname), $dateofbirth );
1206     }else{
1207         $sth->execute( uc($surname), ucfirst($firstname));
1208     }
1209     my @data = $sth->fetchrow;
1210     ( $data[0] ) and return $data[0], $data[1];
1211     return 0;
1212 }
1213
1214 sub checkcardnumber {
1215     my ( $cardnumber, $borrowernumber ) = @_;
1216
1217     # If cardnumber is null, we assume they're allowed.
1218     return 0 unless defined $cardnumber;
1219
1220     my $dbh = C4::Context->dbh;
1221     my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
1222     $query .= " AND borrowernumber <> ?" if ($borrowernumber);
1223     my $sth = $dbh->prepare($query);
1224     $sth->execute(
1225         $cardnumber,
1226         ( $borrowernumber ? $borrowernumber : () )
1227     );
1228
1229     return 1 if $sth->fetchrow_hashref;
1230
1231     my ( $min_length, $max_length ) = get_cardnumber_length();
1232     return 2
1233         if length $cardnumber > $max_length
1234         or length $cardnumber < $min_length;
1235
1236     return 0;
1237 }
1238
1239 =head2 get_cardnumber_length
1240
1241     my ($min, $max) = C4::Members::get_cardnumber_length()
1242
1243 Returns the minimum and maximum length for patron cardnumbers as
1244 determined by the CardnumberLength system preference, the
1245 BorrowerMandatoryField system preference, and the width of the
1246 database column.
1247
1248 =cut
1249
1250 sub get_cardnumber_length {
1251     my ( $min, $max ) = ( 0, 16 ); # borrowers.cardnumber is a nullable varchar(16)
1252     $min = 1 if C4::Context->preference('BorrowerMandatoryField') =~ /cardnumber/;
1253     if ( my $cardnumber_length = C4::Context->preference('CardnumberLength') ) {
1254         # Is integer and length match
1255         if ( $cardnumber_length =~ m|^\d+$| ) {
1256             $min = $max = $cardnumber_length
1257                 if $cardnumber_length >= $min
1258                     and $cardnumber_length <= $max;
1259         }
1260         # Else assuming it is a range
1261         elsif ( $cardnumber_length =~ m|(\d*),(\d*)| ) {
1262             $min = $1 if $1 and $min < $1;
1263             $max = $2 if $2 and $max > $2;
1264         }
1265
1266     }
1267     return ( $min, $max );
1268 }
1269
1270 =head2 GetFirstValidEmailAddress
1271
1272   $email = GetFirstValidEmailAddress($borrowernumber);
1273
1274 Return the first valid email address for a borrower, given the borrowernumber.  For now, the order 
1275 is defined as email, emailpro, B_email.  Returns the empty string if the borrower has no email 
1276 addresses.
1277
1278 =cut
1279
1280 sub GetFirstValidEmailAddress {
1281     my $borrowernumber = shift;
1282     my $dbh = C4::Context->dbh;
1283     my $sth = $dbh->prepare( "SELECT email, emailpro, B_email FROM borrowers where borrowernumber = ? ");
1284     $sth->execute( $borrowernumber );
1285     my $data = $sth->fetchrow_hashref;
1286
1287     if ($data->{'email'}) {
1288        return $data->{'email'};
1289     } elsif ($data->{'emailpro'}) {
1290        return $data->{'emailpro'};
1291     } elsif ($data->{'B_email'}) {
1292        return $data->{'B_email'};
1293     } else {
1294        return '';
1295     }
1296 }
1297
1298 =head2 GetNoticeEmailAddress
1299
1300   $email = GetNoticeEmailAddress($borrowernumber);
1301
1302 Return the email address of borrower used for notices, given the borrowernumber.
1303 Returns the empty string if no email address.
1304
1305 =cut
1306
1307 sub GetNoticeEmailAddress {
1308     my $borrowernumber = shift;
1309
1310     my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
1311     # if syspref is set to 'first valid' (value == OFF), look up email address
1312     if ( $which_address eq 'OFF' ) {
1313         return GetFirstValidEmailAddress($borrowernumber);
1314     }
1315     # specified email address field
1316     my $dbh = C4::Context->dbh;
1317     my $sth = $dbh->prepare( qq{
1318         SELECT $which_address AS primaryemail
1319         FROM borrowers
1320         WHERE borrowernumber=?
1321     } );
1322     $sth->execute($borrowernumber);
1323     my $data = $sth->fetchrow_hashref;
1324     return $data->{'primaryemail'} || '';
1325 }
1326
1327 =head2 GetExpiryDate 
1328
1329   $expirydate = GetExpiryDate($categorycode, $dateenrolled);
1330
1331 Calculate expiry date given a categorycode and starting date.  Date argument must be in ISO format.
1332 Return date is also in ISO format.
1333
1334 =cut
1335
1336 sub GetExpiryDate {
1337     my ( $categorycode, $dateenrolled ) = @_;
1338     my $enrolments;
1339     if ($categorycode) {
1340         my $dbh = C4::Context->dbh;
1341         my $sth = $dbh->prepare("SELECT enrolmentperiod,enrolmentperioddate FROM categories WHERE categorycode=?");
1342         $sth->execute($categorycode);
1343         $enrolments = $sth->fetchrow_hashref;
1344     }
1345     # die "GetExpiryDate: for enrollmentperiod $enrolmentperiod (category '$categorycode') starting $dateenrolled.\n";
1346     my @date = split (/-/,$dateenrolled);
1347     if($enrolments->{enrolmentperiod}){
1348         return sprintf("%04d-%02d-%02d", Add_Delta_YM(@date,0,$enrolments->{enrolmentperiod}));
1349     }else{
1350         return $enrolments->{enrolmentperioddate};
1351     }
1352 }
1353
1354 =head2 GetUpcomingMembershipExpires
1355
1356     my $expires = GetUpcomingMembershipExpires({
1357         branch => $branch, before => $before, after => $after,
1358     });
1359
1360     $branch is an optional branch code.
1361     $before/$after is an optional number of days before/after the date that
1362     is set by the preference MembershipExpiryDaysNotice.
1363     If the pref would be 14, before 2 and after 3, you will get all expires
1364     from 12 to 17 days.
1365
1366 =cut
1367
1368 sub GetUpcomingMembershipExpires {
1369     my ( $params ) = @_;
1370     my $before = $params->{before} || 0;
1371     my $after  = $params->{after} || 0;
1372     my $branch = $params->{branch};
1373
1374     my $dbh = C4::Context->dbh;
1375     my $days = C4::Context->preference("MembershipExpiryDaysNotice") || 0;
1376     my $date1 = dt_from_string->add( days => $days - $before );
1377     my $date2 = dt_from_string->add( days => $days + $after );
1378     $date1= output_pref({ dt => $date1, dateformat => 'iso', dateonly => 1 });
1379     $date2= output_pref({ dt => $date2, dateformat => 'iso', dateonly => 1 });
1380
1381     my $query = q|
1382         SELECT borrowers.*, categories.description,
1383         branches.branchname, branches.branchemail FROM borrowers
1384         LEFT JOIN branches USING (branchcode)
1385         LEFT JOIN categories USING (categorycode)
1386     |;
1387     if( $branch ) {
1388         $query.= 'WHERE branchcode=? AND dateexpiry BETWEEN ? AND ?';
1389     } else {
1390         $query.= 'WHERE dateexpiry BETWEEN ? AND ?';
1391     }
1392
1393     my $sth = $dbh->prepare( $query );
1394     my @pars = $branch? ( $branch ): ();
1395     push @pars, $date1, $date2;
1396     $sth->execute( @pars );
1397     my $results = $sth->fetchall_arrayref( {} );
1398     return $results;
1399 }
1400
1401 =head2 GetborCatFromCatType
1402
1403   ($codes_arrayref, $labels_hashref) = &GetborCatFromCatType();
1404
1405 Looks up the different types of borrowers in the database. Returns two
1406 elements: a reference-to-array, which lists the borrower category
1407 codes, and a reference-to-hash, which maps the borrower category codes
1408 to category descriptions.
1409
1410 =cut
1411
1412 #'
1413 sub GetborCatFromCatType {
1414     my ( $category_type, $action, $no_branch_limit ) = @_;
1415
1416     my $branch_limit = $no_branch_limit
1417         ? 0
1418         : C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1419
1420     # FIXME - This API  seems both limited and dangerous.
1421     my $dbh     = C4::Context->dbh;
1422
1423     my $request = qq{
1424         SELECT categories.categorycode, categories.description
1425         FROM categories
1426     };
1427     $request .= qq{
1428         LEFT JOIN categories_branches ON categories.categorycode = categories_branches.categorycode
1429     } if $branch_limit;
1430     if($action) {
1431         $request .= " $action ";
1432         $request .= " AND (branchcode = ? OR branchcode IS NULL) GROUP BY description" if $branch_limit;
1433     } else {
1434         $request .= " WHERE branchcode = ? OR branchcode IS NULL GROUP BY description" if $branch_limit;
1435     }
1436     $request .= " ORDER BY categorycode";
1437
1438     my $sth = $dbh->prepare($request);
1439     $sth->execute(
1440         $action ? $category_type : (),
1441         $branch_limit ? $branch_limit : ()
1442     );
1443
1444     my %labels;
1445     my @codes;
1446
1447     while ( my $data = $sth->fetchrow_hashref ) {
1448         push @codes, $data->{'categorycode'};
1449         $labels{ $data->{'categorycode'} } = $data->{'description'};
1450     }
1451     $sth->finish;
1452     return ( \@codes, \%labels );
1453 }
1454
1455 =head2 GetBorrowercategory
1456
1457   $hashref = &GetBorrowercategory($categorycode);
1458
1459 Given the borrower's category code, the function returns the corresponding
1460 data hashref for a comprehensive information display.
1461
1462 =cut
1463
1464 sub GetBorrowercategory {
1465     my ($catcode) = @_;
1466     my $dbh       = C4::Context->dbh;
1467     if ($catcode){
1468         my $sth       =
1469         $dbh->prepare(
1470     "SELECT description,dateofbirthrequired,upperagelimit,category_type 
1471     FROM categories 
1472     WHERE categorycode = ?"
1473         );
1474         $sth->execute($catcode);
1475         my $data =
1476         $sth->fetchrow_hashref;
1477         return $data;
1478     } 
1479     return;  
1480 }    # sub getborrowercategory
1481
1482
1483 =head2 GetBorrowerCategorycode
1484
1485     $categorycode = &GetBorrowerCategoryCode( $borrowernumber );
1486
1487 Given the borrowernumber, the function returns the corresponding categorycode
1488
1489 =cut
1490
1491 sub GetBorrowerCategorycode {
1492     my ( $borrowernumber ) = @_;
1493     my $dbh = C4::Context->dbh;
1494     my $sth = $dbh->prepare( qq{
1495         SELECT categorycode
1496         FROM borrowers
1497         WHERE borrowernumber = ?
1498     } );
1499     $sth->execute( $borrowernumber );
1500     return $sth->fetchrow;
1501 }
1502
1503 =head2 GetBorrowercategoryList
1504
1505   $arrayref_hashref = &GetBorrowercategoryList;
1506 If no category code provided, the function returns all the categories.
1507
1508 =cut
1509
1510 sub GetBorrowercategoryList {
1511     my $no_branch_limit = @_ ? shift : 0;
1512     my $branch_limit = $no_branch_limit
1513         ? 0
1514         : C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1515     my $dbh       = C4::Context->dbh;
1516     my $query = "SELECT categories.* FROM categories";
1517     $query .= qq{
1518         LEFT JOIN categories_branches ON categories.categorycode = categories_branches.categorycode
1519         WHERE branchcode = ? OR branchcode IS NULL GROUP BY description
1520     } if $branch_limit;
1521     $query .= " ORDER BY description";
1522     my $sth = $dbh->prepare( $query );
1523     $sth->execute( $branch_limit ? $branch_limit : () );
1524     my $data = $sth->fetchall_arrayref( {} );
1525     $sth->finish;
1526     return $data;
1527 }    # sub getborrowercategory
1528
1529 =head2 GetAge
1530
1531   $dateofbirth,$date = &GetAge($date);
1532
1533 this function return the borrowers age with the value of dateofbirth
1534
1535 =cut
1536
1537 #'
1538 sub GetAge{
1539     my ( $date, $date_ref ) = @_;
1540
1541     if ( not defined $date_ref ) {
1542         $date_ref = sprintf( '%04d-%02d-%02d', Today() );
1543     }
1544
1545     my ( $year1, $month1, $day1 ) = split /-/, $date;
1546     my ( $year2, $month2, $day2 ) = split /-/, $date_ref;
1547
1548     my $age = $year2 - $year1;
1549     if ( $month1 . $day1 > $month2 . $day2 ) {
1550         $age--;
1551     }
1552
1553     return $age;
1554 }    # sub get_age
1555
1556 =head2 SetAge
1557
1558   $borrower = C4::Members::SetAge($borrower, $datetimeduration);
1559   $borrower = C4::Members::SetAge($borrower, '0015-12-10');
1560   $borrower = C4::Members::SetAge($borrower, $datetimeduration, $datetime_reference);
1561
1562   eval { $borrower = C4::Members::SetAge($borrower, '015-1-10'); };
1563   if ($@) {print $@;} #Catch a bad ISO Date or kill your script!
1564
1565 This function sets the borrower's dateofbirth to match the given age.
1566 Optionally relative to the given $datetime_reference.
1567
1568 @PARAM1 koha.borrowers-object
1569 @PARAM2 DateTime::Duration-object as the desired age
1570         OR a ISO 8601 Date. (To make the API more pleasant)
1571 @PARAM3 DateTime-object as the relative date, defaults to now().
1572 RETURNS The given borrower reference @PARAM1.
1573 DIES    If there was an error with the ISO Date handling.
1574
1575 =cut
1576
1577 #'
1578 sub SetAge{
1579     my ( $borrower, $datetimeduration, $datetime_ref ) = @_;
1580     $datetime_ref = DateTime->now() unless $datetime_ref;
1581
1582     if ($datetimeduration && ref $datetimeduration ne 'DateTime::Duration') {
1583         if ($datetimeduration =~ /^(\d{4})-(\d{2})-(\d{2})/) {
1584             $datetimeduration = DateTime::Duration->new(years => $1, months => $2, days => $3);
1585         }
1586         else {
1587             die "C4::Members::SetAge($borrower, $datetimeduration), datetimeduration not a valid ISO 8601 Date!\n";
1588         }
1589     }
1590
1591     my $new_datetime_ref = $datetime_ref->clone();
1592     $new_datetime_ref->subtract_duration( $datetimeduration );
1593
1594     $borrower->{dateofbirth} = $new_datetime_ref->ymd();
1595
1596     return $borrower;
1597 }    # sub SetAge
1598
1599 =head2 GetSortDetails (OUEST-PROVENCE)
1600
1601   ($lib) = &GetSortDetails($category,$sortvalue);
1602
1603 Returns the authorized value  details
1604 C<&$lib>return value of authorized value details
1605 C<&$sortvalue>this is the value of authorized value 
1606 C<&$category>this is the value of authorized value category
1607
1608 =cut
1609
1610 sub GetSortDetails {
1611     my ( $category, $sortvalue ) = @_;
1612     my $dbh   = C4::Context->dbh;
1613     my $query = qq|SELECT lib 
1614         FROM authorised_values 
1615         WHERE category=?
1616         AND authorised_value=? |;
1617     my $sth = $dbh->prepare($query);
1618     $sth->execute( $category, $sortvalue );
1619     my $lib = $sth->fetchrow;
1620     return ($lib) if ($lib);
1621     return ($sortvalue) unless ($lib);
1622 }
1623
1624 =head2 MoveMemberToDeleted
1625
1626   $result = &MoveMemberToDeleted($borrowernumber);
1627
1628 Copy the record from borrowers to deletedborrowers table.
1629 The routine returns 1 for success, undef for failure.
1630
1631 =cut
1632
1633 sub MoveMemberToDeleted {
1634     my ($member) = shift or return;
1635
1636     my $schema       = Koha::Database->new()->schema();
1637     my $borrowers_rs = $schema->resultset('Borrower');
1638     $borrowers_rs->result_class('DBIx::Class::ResultClass::HashRefInflator');
1639     my $borrower = $borrowers_rs->find($member);
1640     return unless $borrower;
1641
1642     my $deleted = $schema->resultset('Deletedborrower')->create($borrower);
1643
1644     return $deleted ? 1 : undef;
1645 }
1646
1647 =head2 DelMember
1648
1649     DelMember($borrowernumber);
1650
1651 This function remove directly a borrower whitout writing it on deleteborrower.
1652 + Deletes reserves for the borrower
1653
1654 =cut
1655
1656 sub DelMember {
1657     my $dbh            = C4::Context->dbh;
1658     my $borrowernumber = shift;
1659     #warn "in delmember with $borrowernumber";
1660     return unless $borrowernumber;    # borrowernumber is mandatory.
1661
1662     my $query = qq|DELETE 
1663           FROM  reserves 
1664           WHERE borrowernumber=?|;
1665     my $sth = $dbh->prepare($query);
1666     $sth->execute($borrowernumber);
1667     $query = "
1668        DELETE
1669        FROM borrowers
1670        WHERE borrowernumber = ?
1671    ";
1672     $sth = $dbh->prepare($query);
1673     $sth->execute($borrowernumber);
1674     logaction("MEMBERS", "DELETE", $borrowernumber, "") if C4::Context->preference("BorrowersLog");
1675     return $sth->rows;
1676 }
1677
1678 =head2 HandleDelBorrower
1679
1680      HandleDelBorrower($borrower);
1681
1682 When a member is deleted (DelMember in Members.pm), you should call me first.
1683 This routine deletes/moves lists and entries for the deleted member/borrower.
1684 Lists owned by the borrower are deleted, but entries from the borrower to
1685 other lists are kept.
1686
1687 =cut
1688
1689 sub HandleDelBorrower {
1690     my ($borrower)= @_;
1691     my $query;
1692     my $dbh = C4::Context->dbh;
1693
1694     #Delete all lists and all shares of this borrower
1695     #Consistent with the approach Koha uses on deleting individual lists
1696     #Note that entries in virtualshelfcontents added by this borrower to
1697     #lists of others will be handled by a table constraint: the borrower
1698     #is set to NULL in those entries.
1699     $query="DELETE FROM virtualshelves WHERE owner=?";
1700     $dbh->do($query,undef,($borrower));
1701
1702     #NOTE:
1703     #We could handle the above deletes via a constraint too.
1704     #But a new BZ report 11889 has been opened to discuss another approach.
1705     #Instead of deleting we could also disown lists (based on a pref).
1706     #In that way we could save shared and public lists.
1707     #The current table constraints support that idea now.
1708     #This pref should then govern the results of other routines/methods such as
1709     #Koha::Virtualshelf->new->delete too.
1710 }
1711
1712 =head2 ExtendMemberSubscriptionTo (OUEST-PROVENCE)
1713
1714     $date = ExtendMemberSubscriptionTo($borrowerid, $date);
1715
1716 Extending the subscription to a given date or to the expiry date calculated on ISO date.
1717 Returns ISO date.
1718
1719 =cut
1720
1721 sub ExtendMemberSubscriptionTo {
1722     my ( $borrowerid,$date) = @_;
1723     my $dbh = C4::Context->dbh;
1724     my $borrower = GetMember('borrowernumber'=>$borrowerid);
1725     unless ($date){
1726       $date = (C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry') ?
1727                                         eval { output_pref( { dt => dt_from_string( $borrower->{'dateexpiry'}  ), dateonly => 1, dateformat => 'iso' } ); }
1728                                         :
1729                                         output_pref( { dt => dt_from_string, dateonly => 1, dateformat => 'iso' } );
1730       $date = GetExpiryDate( $borrower->{'categorycode'}, $date );
1731     }
1732     my $sth = $dbh->do(<<EOF);
1733 UPDATE borrowers 
1734 SET  dateexpiry='$date' 
1735 WHERE borrowernumber='$borrowerid'
1736 EOF
1737
1738     AddEnrolmentFeeIfNeeded( $borrower->{categorycode}, $borrower->{borrowernumber} );
1739
1740     logaction("MEMBERS", "RENEW", $borrower->{'borrowernumber'}, "Membership renewed")if C4::Context->preference("BorrowersLog");
1741     return $date if ($sth);
1742     return 0;
1743 }
1744
1745 =head2 GetTitles (OUEST-PROVENCE)
1746
1747   ($borrowertitle)= &GetTitles();
1748
1749 Looks up the different title . Returns array  with all borrowers title
1750
1751 =cut
1752
1753 sub GetTitles {
1754     my @borrowerTitle = split (/,|\|/,C4::Context->preference('BorrowersTitles'));
1755     unshift( @borrowerTitle, "" );
1756     my $count=@borrowerTitle;
1757     if ($count == 1){
1758         return ();
1759     }
1760     else {
1761         return ( \@borrowerTitle);
1762     }
1763 }
1764
1765 =head2 GetHideLostItemsPreference
1766
1767   $hidelostitemspref = &GetHideLostItemsPreference($borrowernumber);
1768
1769 Returns the HideLostItems preference for the patron category of the supplied borrowernumber
1770 C<&$hidelostitemspref>return value of function, 0 or 1
1771
1772 =cut
1773
1774 sub GetHideLostItemsPreference {
1775     my ($borrowernumber) = @_;
1776     my $dbh = C4::Context->dbh;
1777     my $query = "SELECT hidelostitems FROM borrowers,categories WHERE borrowers.categorycode = categories.categorycode AND borrowernumber = ?";
1778     my $sth = $dbh->prepare($query);
1779     $sth->execute($borrowernumber);
1780     my $hidelostitems = $sth->fetchrow;    
1781     return $hidelostitems;    
1782 }
1783
1784 =head2 GetBorrowersToExpunge
1785
1786   $borrowers = &GetBorrowersToExpunge(
1787       not_borrowed_since => $not_borrowed_since,
1788       expired_before       => $expired_before,
1789       category_code        => $category_code,
1790       patron_list_id       => $patron_list_id,
1791       branchcode           => $branchcode
1792   );
1793
1794   This function get all borrowers based on the given criteria.
1795
1796 =cut
1797
1798 sub GetBorrowersToExpunge {
1799
1800     my $params = shift;
1801     my $filterdate       = $params->{'not_borrowed_since'};
1802     my $filterexpiry     = $params->{'expired_before'};
1803     my $filtercategory   = $params->{'category_code'};
1804     my $filterbranch     = $params->{'branchcode'} ||
1805                         ((C4::Context->preference('IndependentBranches')
1806                              && C4::Context->userenv 
1807                              && !C4::Context->IsSuperLibrarian()
1808                              && C4::Context->userenv->{branch})
1809                          ? C4::Context->userenv->{branch}
1810                          : "");  
1811     my $filterpatronlist = $params->{'patron_list_id'};
1812
1813     my $dbh   = C4::Context->dbh;
1814     my $query = q|
1815         SELECT borrowers.borrowernumber,
1816                MAX(old_issues.timestamp) AS latestissue,
1817                MAX(issues.timestamp) AS currentissue
1818         FROM   borrowers
1819         JOIN   categories USING (categorycode)
1820         LEFT JOIN (
1821             SELECT guarantorid
1822             FROM borrowers
1823             WHERE guarantorid IS NOT NULL
1824                 AND guarantorid <> 0
1825         ) as tmp ON borrowers.borrowernumber=tmp.guarantorid
1826         LEFT JOIN old_issues USING (borrowernumber)
1827         LEFT JOIN issues USING (borrowernumber)|;
1828     if ( $filterpatronlist  ){
1829         $query .= q| LEFT JOIN patron_list_patrons USING (borrowernumber)|;
1830     }
1831     $query .= q| WHERE  category_type <> 'S'
1832         AND tmp.guarantorid IS NULL
1833    |;
1834     my @query_params;
1835     if ( $filterbranch && $filterbranch ne "" ) {
1836         $query.= " AND borrowers.branchcode = ? ";
1837         push( @query_params, $filterbranch );
1838     }
1839     if ( $filterexpiry ) {
1840         $query .= " AND dateexpiry < ? ";
1841         push( @query_params, $filterexpiry );
1842     }
1843     if ( $filtercategory ) {
1844         $query .= " AND categorycode = ? ";
1845         push( @query_params, $filtercategory );
1846     }
1847     if ( $filterpatronlist ){
1848         $query.=" AND patron_list_id = ? ";
1849         push( @query_params, $filterpatronlist );
1850     }
1851     $query.=" GROUP BY borrowers.borrowernumber HAVING currentissue IS NULL ";
1852     if ( $filterdate ) {
1853         $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
1854         push @query_params,$filterdate;
1855     }
1856     warn $query if $debug;
1857
1858     my $sth = $dbh->prepare($query);
1859     if (scalar(@query_params)>0){  
1860         $sth->execute(@query_params);
1861     }
1862     else {
1863         $sth->execute;
1864     }
1865     
1866     my @results;
1867     while ( my $data = $sth->fetchrow_hashref ) {
1868         push @results, $data;
1869     }
1870     return \@results;
1871 }
1872
1873 =head2 GetBorrowersWhoHaveNeverBorrowed
1874
1875   $results = &GetBorrowersWhoHaveNeverBorrowed
1876
1877 This function get all borrowers who have never borrowed.
1878
1879 I<$result> is a ref to an array which all elements are a hasref.
1880
1881 =cut
1882
1883 sub GetBorrowersWhoHaveNeverBorrowed {
1884     my $filterbranch = shift || 
1885                         ((C4::Context->preference('IndependentBranches')
1886                              && C4::Context->userenv 
1887                              && !C4::Context->IsSuperLibrarian()
1888                              && C4::Context->userenv->{branch})
1889                          ? C4::Context->userenv->{branch}
1890                          : "");  
1891     my $dbh   = C4::Context->dbh;
1892     my $query = "
1893         SELECT borrowers.borrowernumber,max(timestamp) as latestissue
1894         FROM   borrowers
1895           LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
1896         WHERE issues.borrowernumber IS NULL
1897    ";
1898     my @query_params;
1899     if ($filterbranch && $filterbranch ne ""){ 
1900         $query.=" AND borrowers.branchcode= ?";
1901         push @query_params,$filterbranch;
1902     }
1903     warn $query if $debug;
1904   
1905     my $sth = $dbh->prepare($query);
1906     if (scalar(@query_params)>0){  
1907         $sth->execute(@query_params);
1908     } 
1909     else {
1910         $sth->execute;
1911     }      
1912     
1913     my @results;
1914     while ( my $data = $sth->fetchrow_hashref ) {
1915         push @results, $data;
1916     }
1917     return \@results;
1918 }
1919
1920 =head2 GetBorrowersWithIssuesHistoryOlderThan
1921
1922   $results = &GetBorrowersWithIssuesHistoryOlderThan($date)
1923
1924 this function get all borrowers who has an issue history older than I<$date> given on input arg.
1925
1926 I<$result> is a ref to an array which all elements are a hashref.
1927 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
1928
1929 =cut
1930
1931 sub GetBorrowersWithIssuesHistoryOlderThan {
1932     my $dbh  = C4::Context->dbh;
1933     my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime());
1934     my $filterbranch = shift || 
1935                         ((C4::Context->preference('IndependentBranches')
1936                              && C4::Context->userenv 
1937                              && !C4::Context->IsSuperLibrarian()
1938                              && C4::Context->userenv->{branch})
1939                          ? C4::Context->userenv->{branch}
1940                          : "");  
1941     my $query = "
1942        SELECT count(borrowernumber) as n,borrowernumber
1943        FROM old_issues
1944        WHERE returndate < ?
1945          AND borrowernumber IS NOT NULL 
1946     "; 
1947     my @query_params;
1948     push @query_params, $date;
1949     if ($filterbranch){
1950         $query.="   AND branchcode = ?";
1951         push @query_params, $filterbranch;
1952     }    
1953     $query.=" GROUP BY borrowernumber ";
1954     warn $query if $debug;
1955     my $sth = $dbh->prepare($query);
1956     $sth->execute(@query_params);
1957     my @results;
1958
1959     while ( my $data = $sth->fetchrow_hashref ) {
1960         push @results, $data;
1961     }
1962     return \@results;
1963 }
1964
1965 =head2 GetBorrowersNamesAndLatestIssue
1966
1967   $results = &GetBorrowersNamesAndLatestIssueList(@borrowernumbers)
1968
1969 this function get borrowers Names and surnames and Issue information.
1970
1971 I<@borrowernumbers> is an array which all elements are borrowernumbers.
1972 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
1973
1974 =cut
1975
1976 sub GetBorrowersNamesAndLatestIssue {
1977     my $dbh  = C4::Context->dbh;
1978     my @borrowernumbers=@_;  
1979     my $query = "
1980        SELECT surname,lastname, phone, email,max(timestamp)
1981        FROM borrowers 
1982          LEFT JOIN issues ON borrowers.borrowernumber=issues.borrowernumber
1983        GROUP BY borrowernumber
1984    ";
1985     my $sth = $dbh->prepare($query);
1986     $sth->execute;
1987     my $results = $sth->fetchall_arrayref({});
1988     return $results;
1989 }
1990
1991 =head2 ModPrivacy
1992
1993   my $success = ModPrivacy( $borrowernumber, $privacy );
1994
1995 Update the privacy of a patron.
1996
1997 return :
1998 true on success, false on failure
1999
2000 =cut
2001
2002 sub ModPrivacy {
2003     my $borrowernumber = shift;
2004     my $privacy = shift;
2005     return unless defined $borrowernumber;
2006     return unless $borrowernumber =~ /^\d+$/;
2007
2008     return ModMember( borrowernumber => $borrowernumber,
2009                       privacy        => $privacy );
2010 }
2011
2012 =head2 IssueSlip
2013
2014   IssueSlip($branchcode, $borrowernumber, $quickslip)
2015
2016   Returns letter hash ( see C4::Letters::GetPreparedLetter )
2017
2018   $quickslip is boolean, to indicate whether we want a quick slip
2019
2020   IssueSlip populates ISSUESLIP and ISSUEQSLIP, and will make the following expansions:
2021
2022   Both slips:
2023
2024       <<branches.*>>
2025       <<borrowers.*>>
2026
2027   ISSUESLIP:
2028
2029       <checkedout>
2030          <<biblio.*>>
2031          <<items.*>>
2032          <<biblioitems.*>>
2033          <<issues.*>>
2034       </checkedout>
2035
2036       <overdue>
2037          <<biblio.*>>
2038          <<items.*>>
2039          <<biblioitems.*>>
2040          <<issues.*>>
2041       </overdue>
2042
2043       <news>
2044          <<opac_news.*>>
2045       </news>
2046
2047   ISSUEQSLIP:
2048
2049       <checkedout>
2050          <<biblio.*>>
2051          <<items.*>>
2052          <<biblioitems.*>>
2053          <<issues.*>>
2054       </checkedout>
2055
2056   NOTE: Not all table fields are available, pleasee see GetPendingIssues for a list of available fields.
2057
2058 =cut
2059
2060 sub IssueSlip {
2061     my ($branch, $borrowernumber, $quickslip) = @_;
2062
2063     # FIXME Check callers before removing this statement
2064     #return unless $borrowernumber;
2065
2066     my @issues = @{ GetPendingIssues($borrowernumber) };
2067
2068     for my $issue (@issues) {
2069         $issue->{date_due} = $issue->{date_due_sql};
2070         if ($quickslip) {
2071             my $today = output_pref({ dt => dt_from_string, dateformat => 'iso', dateonly => 1 });
2072             if ( substr( $issue->{issuedate}, 0, 10 ) eq $today
2073                 or substr( $issue->{lastreneweddate}, 0, 10 ) eq $today ) {
2074                   $issue->{now} = 1;
2075             };
2076         }
2077     }
2078
2079     # Sort on timestamp then on issuedate (useful for tests and could be if modified in a batch
2080     @issues = sort {
2081         my $s = $b->{timestamp} <=> $a->{timestamp};
2082         $s == 0 ?
2083              $b->{issuedate} <=> $a->{issuedate} : $s;
2084     } @issues;
2085
2086     my ($letter_code, %repeat);
2087     if ( $quickslip ) {
2088         $letter_code = 'ISSUEQSLIP';
2089         %repeat =  (
2090             'checkedout' => [ map {
2091                 'biblio'       => $_,
2092                 'items'        => $_,
2093                 'biblioitems'  => $_,
2094                 'issues'       => $_,
2095             }, grep { $_->{'now'} } @issues ],
2096         );
2097     }
2098     else {
2099         $letter_code = 'ISSUESLIP';
2100         %repeat =  (
2101             'checkedout' => [ map {
2102                 'biblio'       => $_,
2103                 'items'        => $_,
2104                 'biblioitems'  => $_,
2105                 'issues'       => $_,
2106             }, grep { !$_->{'overdue'} } @issues ],
2107
2108             'overdue' => [ map {
2109                 'biblio'       => $_,
2110                 'items'        => $_,
2111                 'biblioitems'  => $_,
2112                 'issues'       => $_,
2113             }, grep { $_->{'overdue'} } @issues ],
2114
2115             'news' => [ map {
2116                 $_->{'timestamp'} = $_->{'newdate'};
2117                 { opac_news => $_ }
2118             } @{ GetNewsToDisplay("slip",$branch) } ],
2119         );
2120     }
2121
2122     return  C4::Letters::GetPreparedLetter (
2123         module => 'circulation',
2124         letter_code => $letter_code,
2125         branchcode => $branch,
2126         tables => {
2127             'branches'    => $branch,
2128             'borrowers'   => $borrowernumber,
2129         },
2130         repeat => \%repeat,
2131     );
2132 }
2133
2134 =head2 GetBorrowersWithEmail
2135
2136     ([$borrnum,$userid], ...) = GetBorrowersWithEmail('me@example.com');
2137
2138 This gets a list of users and their basic details from their email address.
2139 As it's possible for multiple user to have the same email address, it provides
2140 you with all of them. If there is no userid for the user, there will be an
2141 C<undef> there. An empty list will be returned if there are no matches.
2142
2143 =cut
2144
2145 sub GetBorrowersWithEmail {
2146     my $email = shift;
2147
2148     my $dbh = C4::Context->dbh;
2149
2150     my $query = "SELECT borrowernumber, userid FROM borrowers WHERE email=?";
2151     my $sth=$dbh->prepare($query);
2152     $sth->execute($email);
2153     my @result = ();
2154     while (my $ref = $sth->fetch) {
2155         push @result, $ref;
2156     }
2157     die "Failure searching for borrowers by email address: $sth->errstr" if $sth->err;
2158     return @result;
2159 }
2160
2161 =head2 AddMember_Opac
2162
2163 =cut
2164
2165 sub AddMember_Opac {
2166     my ( %borrower ) = @_;
2167
2168     $borrower{'categorycode'} //= C4::Context->preference('PatronSelfRegistrationDefaultCategory');
2169     if (not defined $borrower{'password'}){
2170         my $sr = new String::Random;
2171         $sr->{'A'} = [ 'A'..'Z', 'a'..'z' ];
2172         my $password = $sr->randpattern("AAAAAAAAAA");
2173         $borrower{'password'} = $password;
2174     }
2175
2176     $borrower{'cardnumber'} = fixup_cardnumber( $borrower{'cardnumber'} );
2177
2178     my $borrowernumber = AddMember(%borrower);
2179
2180     return ( $borrowernumber, $borrower{'password'} );
2181 }
2182
2183 =head2 AddEnrolmentFeeIfNeeded
2184
2185     AddEnrolmentFeeIfNeeded( $borrower->{categorycode}, $borrower->{borrowernumber} );
2186
2187 Add enrolment fee for a patron if needed.
2188
2189 =cut
2190
2191 sub AddEnrolmentFeeIfNeeded {
2192     my ( $categorycode, $borrowernumber ) = @_;
2193     # check for enrollment fee & add it if needed
2194     my $dbh = C4::Context->dbh;
2195     my $sth = $dbh->prepare(q{
2196         SELECT enrolmentfee
2197         FROM categories
2198         WHERE categorycode=?
2199     });
2200     $sth->execute( $categorycode );
2201     if ( $sth->err ) {
2202         warn sprintf('Database returned the following error: %s', $sth->errstr);
2203         return;
2204     }
2205     my ($enrolmentfee) = $sth->fetchrow;
2206     if ($enrolmentfee && $enrolmentfee > 0) {
2207         # insert fee in patron debts
2208         C4::Accounts::manualinvoice( $borrowernumber, '', '', 'A', $enrolmentfee );
2209     }
2210 }
2211
2212 =head2 HasOverdues
2213
2214 =cut
2215
2216 sub HasOverdues {
2217     my ( $borrowernumber ) = @_;
2218
2219     my $sql = "SELECT COUNT(*) FROM issues WHERE date_due < NOW() AND borrowernumber = ?";
2220     my $sth = C4::Context->dbh->prepare( $sql );
2221     $sth->execute( $borrowernumber );
2222     my ( $count ) = $sth->fetchrow_array();
2223
2224     return $count;
2225 }
2226
2227 =head2 DeleteExpiredOpacRegistrations
2228
2229     Delete accounts that haven't been upgraded from the 'temporary' category
2230     Returns the number of removed patrons
2231
2232 =cut
2233
2234 sub DeleteExpiredOpacRegistrations {
2235
2236     my $delay = C4::Context->preference('PatronSelfRegistrationExpireTemporaryAccountsDelay');
2237     my $category_code = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
2238
2239     return 0 if not $category_code or not defined $delay or $delay eq q||;
2240
2241     my $query = qq|
2242 SELECT borrowernumber
2243 FROM borrowers
2244 WHERE categorycode = ? AND DATEDIFF( NOW(), dateenrolled ) > ? |;
2245
2246     my $dbh = C4::Context->dbh;
2247     my $sth = $dbh->prepare($query);
2248     $sth->execute( $category_code, $delay );
2249     my $cnt=0;
2250     while ( my ($borrowernumber) = $sth->fetchrow_array() ) {
2251         DelMember($borrowernumber);
2252         $cnt++;
2253     }
2254     return $cnt;
2255 }
2256
2257 =head2 DeleteUnverifiedOpacRegistrations
2258
2259     Delete all unverified self registrations in borrower_modifications,
2260     older than the specified number of days.
2261
2262 =cut
2263
2264 sub DeleteUnverifiedOpacRegistrations {
2265     my ( $days ) = @_;
2266     my $dbh = C4::Context->dbh;
2267     my $sql=qq|
2268 DELETE FROM borrower_modifications
2269 WHERE borrowernumber = 0 AND DATEDIFF( NOW(), timestamp ) > ?|;
2270     my $cnt=$dbh->do($sql, undef, ($days) );
2271     return $cnt eq '0E0'? 0: $cnt;
2272 }
2273
2274 sub GetOverduesForPatron {
2275     my ( $borrowernumber ) = @_;
2276
2277     my $sql = "
2278         SELECT *
2279         FROM issues, items, biblio, biblioitems
2280         WHERE items.itemnumber=issues.itemnumber
2281           AND biblio.biblionumber   = items.biblionumber
2282           AND biblio.biblionumber   = biblioitems.biblionumber
2283           AND issues.borrowernumber = ?
2284           AND date_due < NOW()
2285     ";
2286
2287     my $sth = C4::Context->dbh->prepare( $sql );
2288     $sth->execute( $borrowernumber );
2289
2290     return $sth->fetchall_arrayref({});
2291 }
2292
2293 END { }    # module clean-up code here (global destructor)
2294
2295 1;
2296
2297 __END__
2298
2299 =head1 AUTHOR
2300
2301 Koha Team
2302
2303 =cut