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