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