C4/Members.pm

   1 package C4::Members;
   2
   3 # Copyright 2000-2003 Katipo Communications
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it under the
   8 # terms of the GNU General Public License as published by the Free Software
   9 # Foundation; either version 2 of the License, or (at your option) any later
  10 # version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License along with
  17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  18 # Suite 330, Boston, MA  02111-1307 USA
  19
  20
  21 use strict;
  22 use C4::Context;
  23 use C4::Dates qw(format_date_in_iso);
  24 use Digest::MD5 qw(md5_base64);
  25 use Date::Calc qw/Today Add_Delta_YM/;
  26 use C4::Log; # logaction
  27 use C4::Overdues;
  28 use C4::Reserves;
  29 use C4::Accounts;
  30 use C4::Biblio;
  31
  32 our ($VERSION,@ISA,@EXPORT,@EXPORT_OK,$debug);
  33
  34 BEGIN {
  35         $VERSION = 3.02;
  36         $debug = $ENV{DEBUG} || 0;
  37         require Exporter;
  38         @ISA = qw(Exporter);
  39         #Get data
  40         push @EXPORT, qw(
  41                 &SearchMember
  42                 &GetMemberDetails
  43                 &GetMember
  44
  45                 &GetGuarantees
  46
  47                 &GetMemberIssuesAndFines
  48                 &GetPendingIssues
  49                 &GetAllIssues
  50
  51                 &get_institutions
  52                 &getzipnamecity
  53                 &getidcity
  54
  55                 &GetAge
  56                 &GetCities
  57                 &GetRoadTypes
  58                 &GetRoadTypeDetails
  59                 &GetSortDetails
  60                 &GetTitles
  61
  62     &GetPatronImage
  63     &PutPatronImage
  64     &RmPatronImage
  65
  66                 &GetMemberAccountRecords
  67                 &GetBorNotifyAcctRecord
  68
  69                 &GetborCatFromCatType
  70                 &GetBorrowercategory
  71     &GetBorrowercategoryList
  72
  73                 &GetBorrowersWhoHaveNotBorrowedSince
  74                 &GetBorrowersWhoHaveNeverBorrowed
  75                 &GetBorrowersWithIssuesHistoryOlderThan
  76
  77                 &GetExpiryDate
  78         );
  79
  80         #Modify data
  81         push @EXPORT, qw(
  82                 &ModMember
  83                 &changepassword
  84         );
  85
  86         #Delete data
  87         push @EXPORT, qw(
  88                 &DelMember
  89         );
  90
  91         #Insert data
  92         push @EXPORT, qw(
  93                 &AddMember
  94                 &add_member_orgs
  95                 &MoveMemberToDeleted
  96                 &ExtendMemberSubscriptionTo
  97         );
  98
  99         #Check data
 100         push @EXPORT, qw(
 101                 &checkuniquemember
 102                 &checkuserpassword
 103                 &Check_Userid
 104                 &fixEthnicity
 105                 &ethnicitycategories
 106                 &fixup_cardnumber
 107                 &checkcardnumber
 108         );
 109 }
 110
 111 =head1 NAME
 112
 113 C4::Members - Perl Module containing convenience functions for member handling
 114
 115 =head1 SYNOPSIS
 116
 117 use C4::Members;
 118
 119 =head1 DESCRIPTION
 120
 121 This module contains routines for adding, modifying and deleting members/patrons/borrowers
 122
 123 =head1 FUNCTIONS
 124
 125 =over 2
 126
 127 =item SearchMember
 128
 129   ($count, $borrowers) = &SearchMember($searchstring, $type,$category_type,$filter,$showallbranches);
 130
 131 =back
 132
 133 Looks up patrons (borrowers) by name.
 134
 135 BUGFIX 499: C<$type> is now used to determine type of search.
 136 if $type is "simple", search is performed on the first letter of the
 137 surname only.
 138
 139 $category_type is used to get a specified type of user.
 140 (mainly adults when creating a child.)
 141
 142 C<$searchstring> is a space-separated list of search terms. Each term
 143 must match the beginning a borrower's surname, first name, or other
 144 name.
 145
 146 C<$filter> is assumed to be a list of elements to filter results on
 147
 148 C<$showallbranches> is used in IndependantBranches Context to display all branches results.
 149
 150 C<&SearchMember> returns a two-element list. C<$borrowers> is a
 151 reference-to-array; each element is a reference-to-hash, whose keys
 152 are the fields of the C<borrowers> table in the Koha database.
 153 C<$count> is the number of elements in C<$borrowers>.
 154
 155 =cut
 156
 157 #'
 158 #used by member enquiries from the intranet
 159 #called by member.pl and circ/circulation.pl
 160 sub SearchMember {
 161     my ($searchstring, $orderby, $type,$category_type,$filter,$showallbranches ) = @_;
 162     my $dbh   = C4::Context->dbh;
 163     my $query = "";
 164     my $count;
 165     my @data;
 166     my @bind = ();
 167
 168     # this is used by circulation everytime a new borrowers cardnumber is scanned
 169     # so we can check an exact match first, if that works return, otherwise do the rest
 170     $query = "SELECT * FROM borrowers
 171         LEFT JOIN categories ON borrowers.categorycode=categories.categorycode
 172         ";
 173     my $sth = $dbh->prepare("$query WHERE cardnumber = ?");
 174     $sth->execute($searchstring);
 175     my $data = $sth->fetchall_arrayref({});
 176     if (@$data){
 177         return ( scalar(@$data), $data );
 178     }
 179     $sth->finish;
 180
 181     if ( $type eq "simple" )    # simple search for one letter only
 182     {
 183         $query .= ($category_type ? " AND category_type = ".$dbh->quote($category_type) : "");
 184         $query .= " WHERE (surname LIKE ? OR cardnumber like ?) ";
 185         if (C4::Context->preference("IndependantBranches") && !$showallbranches){
 186           if (C4::Context->userenv && C4::Context->userenv->{flags}!=1 && C4::Context->userenv->{'branch'}){
 187             $query.=" AND borrowers.branchcode =".$dbh->quote(C4::Context->userenv->{'branch'}) unless (C4::Context->userenv->{'branch'} eq "insecure");
 188           }
 189         }
 190         $query.=" ORDER BY $orderby";
 191         @bind = ("$searchstring%","$searchstring");
 192     }
 193     else    # advanced search looking in surname, firstname and othernames
 194     {
 195         @data  = split( ' ', $searchstring );
 196         $count = @data;
 197         $query .= " WHERE ";
 198         if (C4::Context->preference("IndependantBranches") && !$showallbranches){
 199           if (C4::Context->userenv && C4::Context->userenv->{flags}!=1 && C4::Context->userenv->{'branch'}){
 200             $query.=" borrowers.branchcode =".$dbh->quote(C4::Context->userenv->{'branch'})." AND " unless (C4::Context->userenv->{'branch'} eq "insecure");
 201           }
 202         }
 203         $query.="((surname LIKE ? OR surname LIKE ?
 204                 OR firstname  LIKE ? OR firstname LIKE ?
 205                 OR othernames LIKE ? OR othernames LIKE ?)
 206         " .
 207         ($category_type?" AND category_type = ".$dbh->quote($category_type):"");
 208         @bind = (
 209             "$data[0]%", "% $data[0]%", "$data[0]%", "% $data[0]%",
 210             "$data[0]%", "% $data[0]%"
 211         );
 212         for ( my $i = 1 ; $i < $count ; $i++ ) {
 213             $query = $query . " AND (" . " surname LIKE ? OR surname LIKE ?
 214                 OR firstname  LIKE ? OR firstname LIKE ?
 215                 OR othernames LIKE ? OR othernames LIKE ?)";
 216             push( @bind,
 217                 "$data[$i]%",   "% $data[$i]%", "$data[$i]%",
 218                 "% $data[$i]%", "$data[$i]%",   "% $data[$i]%" );
 219
 220             # FIXME - .= <<EOT;
 221         }
 222         $query = $query . ") OR cardnumber LIKE ? ";
 223         push( @bind, $searchstring );
 224         if (C4::Context->preference('ExtendedPatronAttributes')) {
 225             $query .= "OR borrowernumber IN (
 226 SELECT borrowernumber
 227 FROM borrower_attributes
 228 JOIN borrower_attribute_types USING (code)
 229 WHERE staff_searchable = 1
 230 AND attribute like ?
 231 )";
 232             push (@bind, $searchstring);
 233         }
 234         $query .= "order by $orderby";
 235
 236         # FIXME - .= <<EOT;
 237     }
 238
 239     $sth = $dbh->prepare($query);
 240
 241     $debug and print STDERR "Q $orderby : $query\n";
 242     $sth->execute(@bind);
 243     my @results;
 244     $data = $sth->fetchall_arrayref({});
 245
 246     $sth->finish;
 247     return ( scalar(@$data), $data );
 248 }
 249
 250 =head2 GetMemberDetails
 251
 252 ($borrower) = &GetMemberDetails($borrowernumber, $cardnumber);
 253
 254 Looks up a patron and returns information about him or her. If
 255 C<$borrowernumber> is true (nonzero), C<&GetMemberDetails> looks
 256 up the borrower by number; otherwise, it looks up the borrower by card
 257 number.
 258
 259 C<$borrower> is a reference-to-hash whose keys are the fields of the
 260 borrowers table in the Koha database. In addition,
 261 C<$borrower-E<gt>{flags}> is a hash giving more detailed information
 262 about the patron. Its keys act as flags :
 263
 264     if $borrower->{flags}->{LOST} {
 265         # Patron's card was reported lost
 266     }
 267
 268 Each flag has a C<message> key, giving a human-readable explanation of
 269 the flag. If the state of a flag means that the patron should not be
 270 allowed to borrow any more books, then it will have a C<noissues> key
 271 with a true value.
 272
 273 The possible flags are:
 274
 275 =head3 CHARGES
 276
 277 =over 4
 278
 279 =item Shows the patron's credit or debt, if any.
 280
 281 =back
 282
 283 =head3 GNA
 284
 285 =over 4
 286
 287 =item (Gone, no address.) Set if the patron has left without giving a
 288 forwarding address.
 289
 290 =back
 291
 292 =head3 LOST
 293
 294 =over 4
 295
 296 =item Set if the patron's card has been reported as lost.
 297
 298 =back
 299
 300 =head3 DBARRED
 301
 302 =over 4
 303
 304 =item Set if the patron has been debarred.
 305
 306 =back
 307
 308 =head3 NOTES
 309
 310 =over 4
 311
 312 =item Any additional notes about the patron.
 313
 314 =back
 315
 316 =head3 ODUES
 317
 318 =over 4
 319
 320 =item Set if the patron has overdue items. This flag has several keys:
 321
 322 C<$flags-E<gt>{ODUES}{itemlist}> is a reference-to-array listing the
 323 overdue items. Its elements are references-to-hash, each describing an
 324 overdue item. The keys are selected fields from the issues, biblio,
 325 biblioitems, and items tables of the Koha database.
 326
 327 C<$flags-E<gt>{ODUES}{itemlist}> is a string giving a text listing of
 328 the overdue items, one per line.
 329
 330 =back
 331
 332 =head3 WAITING
 333
 334 =over 4
 335
 336 =item Set if any items that the patron has reserved are available.
 337
 338 C<$flags-E<gt>{WAITING}{itemlist}> is a reference-to-array listing the
 339 available items. Each element is a reference-to-hash whose keys are
 340 fields from the reserves table of the Koha database.
 341
 342 =back
 343
 344 C<$borrower-E<gt>{authflags}> is a hash giving more detailed information
 345 about the top-level permissions flags set for the borrower.  For example,
 346 if a user has the "editcatalogue" permission,
 347 C<$borrower-E<gt>{authflags}-E<gt>{editcatalogue}> will exist and have
 348 the value "1".
 349
 350 =cut
 351
 352 sub GetMemberDetails {
 353     my ( $borrowernumber, $cardnumber ) = @_;
 354     my $dbh = C4::Context->dbh;
 355     my $query;
 356     my $sth;
 357     if ($borrowernumber) {
 358         $sth = $dbh->prepare("select borrowers.*,category_type,categories.description from borrowers left join categories on borrowers.categorycode=categories.categorycode where  borrowernumber=?");
 359         $sth->execute($borrowernumber);
 360     }
 361     elsif ($cardnumber) {
 362         $sth = $dbh->prepare("select borrowers.*,category_type,categories.description from borrowers left join categories on borrowers.categorycode=categories.categorycode where cardnumber=?");
 363         $sth->execute($cardnumber);
 364     }
 365     else {
 366         return undef;
 367     }
 368     my $borrower = $sth->fetchrow_hashref;
 369     my ($amount) = GetMemberAccountRecords( $borrowernumber);
 370     $borrower->{'amountoutstanding'} = $amount;
 371     # FIXME - patronflags calls GetMemberAccountRecords... just have patronflags return $amount
 372     my $flags = patronflags( $borrower);
 373     my $accessflagshash;
 374
 375     $sth = $dbh->prepare("select bit,flag from userflags");
 376     $sth->execute;
 377     while ( my ( $bit, $flag ) = $sth->fetchrow ) {
 378         if ( $borrower->{'flags'} && $borrower->{'flags'} & 2**$bit ) {
 379             $accessflagshash->{$flag} = 1;
 380         }
 381     }
 382     $sth->finish;
 383     $borrower->{'flags'}     = $flags;
 384     $borrower->{'authflags'} = $accessflagshash;
 385
 386     # find out how long the membership lasts
 387     $sth =
 388       $dbh->prepare(
 389         "select enrolmentperiod from categories where categorycode = ?");
 390     $sth->execute( $borrower->{'categorycode'} );
 391     my $enrolment = $sth->fetchrow;
 392     $borrower->{'enrolmentperiod'} = $enrolment;
 393     return ($borrower);    #, $flags, $accessflagshash);
 394 }
 395
 396 =head2 patronflags
 397
 398  Not exported
 399
 400  NOTE!: If you change this function, be sure to update the POD for
 401  &GetMemberDetails.
 402
 403  $flags = &patronflags($patron);
 404
 405  $flags->{CHARGES}
 406         {message}    Message showing patron's credit or debt
 407        {noissues}    Set if patron owes >$5.00
 408          {GNA}            Set if patron gone w/o address
 409         {message}    "Borrower has no valid address"
 410         {noissues}    Set.
 411         {LOST}        Set if patron's card reported lost
 412         {message}    Message to this effect
 413         {noissues}    Set.
 414         {DBARRED}        Set is patron is debarred
 415         {message}    Message to this effect
 416         {noissues}    Set.
 417          {NOTES}        Set if patron has notes
 418         {message}    Notes about patron
 419          {ODUES}        Set if patron has overdue books
 420         {message}    "Yes"
 421         {itemlist}    ref-to-array: list of overdue books
 422         {itemlisttext}    Text list of overdue items
 423          {WAITING}        Set if there are items available that the
 424                 patron reserved
 425         {message}    Message to this effect
 426         {itemlist}    ref-to-array: list of available items
 427
 428 =cut
 429 # FIXME rename this function.
 430 sub patronflags {
 431     my %flags;
 432     my ( $patroninformation) = @_;
 433     my $dbh=C4::Context->dbh;
 434     my ($amount) = GetMemberAccountRecords( $patroninformation->{'borrowernumber'});
 435     if ( $amount > 0 ) {
 436         my %flaginfo;
 437         my $noissuescharge = C4::Context->preference("noissuescharge");
 438         $flaginfo{'message'} = sprintf "Patron owes \$%.02f", $amount;
 439         $flaginfo{'amount'} = sprintf "%.02f",$amount;
 440         if ( $amount > $noissuescharge ) {
 441             $flaginfo{'noissues'} = 1;
 442         }
 443         $flags{'CHARGES'} = \%flaginfo;
 444     }
 445     elsif ( $amount < 0 ) {
 446         my %flaginfo;
 447         $flaginfo{'message'} = sprintf "Patron has credit of \$%.02f", -$amount;
 448         $flags{'CREDITS'} = \%flaginfo;
 449     }
 450     if (   $patroninformation->{'gonenoaddress'}
 451         && $patroninformation->{'gonenoaddress'} == 1 )
 452     {
 453         my %flaginfo;
 454         $flaginfo{'message'}  = 'Borrower has no valid address.';
 455         $flaginfo{'noissues'} = 1;
 456         $flags{'GNA'}         = \%flaginfo;
 457     }
 458     if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
 459         my %flaginfo;
 460         $flaginfo{'message'}  = 'Borrower\'s card reported lost.';
 461         $flaginfo{'noissues'} = 1;
 462         $flags{'LOST'}        = \%flaginfo;
 463     }
 464     if (   $patroninformation->{'debarred'}
 465         && $patroninformation->{'debarred'} == 1 )
 466     {
 467         my %flaginfo;
 468         $flaginfo{'message'}  = 'Borrower is Debarred.';
 469         $flaginfo{'noissues'} = 1;
 470         $flags{'DBARRED'}     = \%flaginfo;
 471     }
 472     if (   $patroninformation->{'borrowernotes'}
 473         && $patroninformation->{'borrowernotes'} )
 474     {
 475         my %flaginfo;
 476         $flaginfo{'message'} = "$patroninformation->{'borrowernotes'}";
 477         $flags{'NOTES'}      = \%flaginfo;
 478     }
 479     my ( $odues, $itemsoverdue ) =
 480       checkoverdues( $patroninformation->{'borrowernumber'}, $dbh );
 481     if ( $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";
 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, $type);
 508
 509 Looks up information about a patron (borrower) by either card number
 510 ,firstname, or borrower number, depending on $type value.
 511 If C<$type> == 'cardnumber', C<&GetBorrower>
 512 searches by cardnumber then by firstname if not found in cardnumber;
 513 otherwise, it searches by borrowernumber.
 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 =cut
 519
 520 #'
 521 sub GetMember {
 522     my ( $information, $type ) = @_;
 523     my $dbh = C4::Context->dbh;
 524     my $sth;
 525     my $select = "
 526 SELECT borrowers.*, categories.category_type, categories.description
 527 FROM borrowers
 528 LEFT JOIN categories on borrowers.categorycode=categories.categorycode
 529 ";
 530     if ( defined $type && ( $type eq 'cardnumber' || $type eq 'firstname'|| $type eq 'userid'|| $type eq 'borrowernumber' ) ){
 531         $information = uc $information;
 532         $sth = $dbh->prepare("$select WHERE $type=?");
 533     } else {
 534         $sth = $dbh->prepare("$select WHERE borrowernumber=?");
 535     }
 536     $sth->execute($information);
 537     my $data = $sth->fetchrow_hashref;
 538     $sth->finish;
 539     ($data) and return ($data);
 540
 541     if ($type eq 'cardnumber' || $type eq 'firstname') {    # otherwise, try with firstname
 542         $sth = $dbh->prepare("$select WHERE firstname like ?");
 543         $sth->execute($information);
 544         $data = $sth->fetchrow_hashref;
 545         $sth->finish;
 546         ($data) and return ($data);
 547     }
 548     return undef;
 549 }
 550
 551 =head2 GetMemberIssuesAndFines
 552
 553   ($overdue_count, $issue_count, $total_fines) = &GetMemberIssuesAndFines($borrowernumber);
 554
 555 Returns aggregate data about items borrowed by the patron with the
 556 given borrowernumber.
 557
 558 C<&GetMemberIssuesAndFines> returns a three-element array.  C<$overdue_count> is the
 559 number of overdue items the patron currently has borrowed. C<$issue_count> is the
 560 number of books the patron currently has borrowed.  C<$total_fines> is
 561 the total fine currently due by the borrower.
 562
 563 =cut
 564
 565 #'
 566 sub GetMemberIssuesAndFines {
 567     my ( $borrowernumber ) = @_;
 568     my $dbh   = C4::Context->dbh;
 569     my $query = "SELECT COUNT(*) FROM issues WHERE borrowernumber = ?";
 570
 571     $debug and warn $query."\n";
 572     my $sth = $dbh->prepare($query);
 573     $sth->execute($borrowernumber);
 574     my $issue_count = $sth->fetchrow_arrayref->[0];
 575     $sth->finish;
 576
 577     $sth = $dbh->prepare(
 578         "SELECT COUNT(*) FROM issues
 579          WHERE borrowernumber = ?
 580          AND date_due < now()"
 581     );
 582     $sth->execute($borrowernumber);
 583     my $overdue_count = $sth->fetchrow_arrayref->[0];
 584     $sth->finish;
 585
 586     $sth = $dbh->prepare("SELECT SUM(amountoutstanding) FROM accountlines WHERE borrowernumber = ?");
 587     $sth->execute($borrowernumber);
 588     my $total_fines = $sth->fetchrow_arrayref->[0];
 589     $sth->finish;
 590
 591     return ($overdue_count, $issue_count, $total_fines);
 592 }
 593
 594 sub columns(;$) {
 595     return @{C4::Context->dbh->selectcol_arrayref("SHOW columns from borrowers")};
 596 }
 597
 598 =head2
 599
 600 =head2 ModMember
 601
 602 =over 4
 603
 604 my $success = ModMember(borrowernumber => $borrowernumber, [ field => value ]... );
 605
 606 Modify borrower's data.  All date fields should ALREADY be in ISO format.
 607
 608 return :
 609 true on success, or false on failure
 610
 611 =back
 612
 613 =cut
 614
 615 sub ModMember {
 616     my (%data) = @_;
 617     my $dbh = C4::Context->dbh;
 618     my $iso_re = C4::Dates->new()->regexp('iso');
 619     foreach (qw(dateofbirth dateexpiry dateenrolled)) {
 620         if (my $tempdate = $data{$_}) {                                 # assignment, not comparison
 621             ($tempdate =~ /$iso_re/) and next;                          # Congatulations, you sent a valid ISO date.
 622             warn "ModMember given $_ not in ISO format ($tempdate)";
 623             my $tempdate2 = format_date_in_iso($tempdate);
 624             if (!$tempdate2 or $tempdate2 eq '0000-00-00') {
 625                 warn "ModMember cannot convert '$tempdate' (from syspref to ISO)";
 626                 next;
 627             }
 628             $data{$_} = $tempdate2;
 629         }
 630     }
 631     if (!$data{'dateofbirth'}){
 632         delete $data{'dateofbirth'};
 633     }
 634     my @columns = &columns;
 635     my %hashborrowerfields = (map {$_=>1} @columns);
 636     my $query = "UPDATE borrowers SET \n";
 637     my $sth;
 638     my @parameters;
 639
 640     # test to know if you must update or not the borrower password
 641     if (exists $data{password}) {
 642         if ($data{password} eq '****' or $data{password} eq '') {
 643             delete $data{password};
 644         } else {
 645             $data{password} = md5_base64($data{password});
 646         }
 647     }
 648     my @badkeys;
 649     foreach (keys %data) {
 650         next if ($_ eq 'borrowernumber' or $_ eq 'flags');
 651         if ($hashborrowerfields{$_}){
 652             $query .= " $_=?, ";
 653             push @parameters,$data{$_};
 654         } else {
 655             push @badkeys, $_;
 656             delete $data{$_};
 657         }
 658     }
 659     (@badkeys) and warn scalar(@badkeys) . " Illegal key(s) passed to ModMember: " . join(',',@badkeys);
 660     $query =~ s/, $//;
 661     $query .= " WHERE borrowernumber=?";
 662     push @parameters, $data{'borrowernumber'};
 663     $debug and print STDERR "$query (executed w/ arg: $data{'borrowernumber'})";
 664     $sth = $dbh->prepare($query);
 665     my $execute_success = $sth->execute(@parameters);
 666     $sth->finish;
 667
 668 # ok if its an adult (type) it may have borrowers that depend on it as a guarantor
 669 # so when we update information for an adult we should check for guarantees and update the relevant part
 670 # of their records, ie addresses and phone numbers
 671     my $borrowercategory= GetBorrowercategory( $data{'category_type'} );
 672     if ( exists  $borrowercategory->{'category_type'} && $borrowercategory->{'category_type'} eq ('A' || 'S') ) {
 673         # is adult check guarantees;
 674         UpdateGuarantees(%data);
 675     }
 676     logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "$query (executed w/ arg: $data{'borrowernumber'})")
 677         if C4::Context->preference("BorrowersLog");
 678
 679     return $execute_success;
 680 }
 681
 682
 683 =head2
 684
 685 =head2 AddMember
 686
 687   $borrowernumber = &AddMember(%borrower);
 688
 689 insert new borrower into table
 690 Returns the borrowernumber
 691
 692 =cut
 693
 694 #'
 695 sub AddMember {
 696     my (%data) = @_;
 697     my $dbh = C4::Context->dbh;
 698     $data{'userid'} = '' unless $data{'password'};
 699     $data{'password'} = md5_base64( $data{'password'} ) if $data{'password'};
 700
 701     # WE SHOULD NEVER PASS THIS SUBROUTINE ANYTHING OTHER THAN ISO DATES
 702     # IF YOU UNCOMMENT THESE LINES YOU BETTER HAVE A DARN COMPELLING REASON
 703 #    $data{'dateofbirth'}  = format_date_in_iso( $data{'dateofbirth'} );
 704 #    $data{'dateenrolled'} = format_date_in_iso( $data{'dateenrolled'});
 705 #    $data{'dateexpiry'}   = format_date_in_iso( $data{'dateexpiry'}  );
 706     # This query should be rewritten to use "?" at execute.
 707     if (!$data{'dateofbirth'}){
 708         undef ($data{'dateofbirth'});
 709     }
 710     my $query =
 711         "insert into borrowers set cardnumber=" . $dbh->quote( $data{'cardnumber'} )
 712       . ",surname="     . $dbh->quote( $data{'surname'} )
 713       . ",firstname="   . $dbh->quote( $data{'firstname'} )
 714       . ",title="       . $dbh->quote( $data{'title'} )
 715       . ",othernames="  . $dbh->quote( $data{'othernames'} )
 716       . ",initials="    . $dbh->quote( $data{'initials'} )
 717       . ",streetnumber=". $dbh->quote( $data{'streetnumber'} )
 718       . ",streettype="  . $dbh->quote( $data{'streettype'} )
 719       . ",address="     . $dbh->quote( $data{'address'} )
 720       . ",address2="    . $dbh->quote( $data{'address2'} )
 721       . ",zipcode="     . $dbh->quote( $data{'zipcode'} )
 722       . ",city="        . $dbh->quote( $data{'city'} )
 723       . ",phone="       . $dbh->quote( $data{'phone'} )
 724       . ",email="       . $dbh->quote( $data{'email'} )
 725       . ",mobile="      . $dbh->quote( $data{'mobile'} )
 726       . ",phonepro="    . $dbh->quote( $data{'phonepro'} )
 727       . ",opacnote="    . $dbh->quote( $data{'opacnote'} )
 728       . ",guarantorid=" . $dbh->quote( $data{'guarantorid'} )
 729       . ",dateofbirth=" . $dbh->quote( $data{'dateofbirth'} )
 730       . ",branchcode="  . $dbh->quote( $data{'branchcode'} )
 731       . ",categorycode=" . $dbh->quote( $data{'categorycode'} )
 732       . ",dateenrolled=" . $dbh->quote( $data{'dateenrolled'} )
 733       . ",contactname=" . $dbh->quote( $data{'contactname'} )
 734       . ",borrowernotes=" . $dbh->quote( $data{'borrowernotes'} )
 735       . ",dateexpiry="  . $dbh->quote( $data{'dateexpiry'} )
 736       . ",contactnote=" . $dbh->quote( $data{'contactnote'} )
 737       . ",B_address="   . $dbh->quote( $data{'B_address'} )
 738       . ",B_zipcode="   . $dbh->quote( $data{'B_zipcode'} )
 739       . ",B_city="      . $dbh->quote( $data{'B_city'} )
 740       . ",B_phone="     . $dbh->quote( $data{'B_phone'} )
 741       . ",B_email="     . $dbh->quote( $data{'B_email'} )
 742       . ",password="    . $dbh->quote( $data{'password'} )
 743       . ",userid="      . $dbh->quote( $data{'userid'} )
 744       . ",sort1="       . $dbh->quote( $data{'sort1'} )
 745       . ",sort2="       . $dbh->quote( $data{'sort2'} )
 746       . ",contacttitle=" . $dbh->quote( $data{'contacttitle'} )
 747       . ",emailpro="    . $dbh->quote( $data{'emailpro'} )
 748       . ",contactfirstname=" . $dbh->quote( $data{'contactfirstname'} )
 749       . ",sex="         . $dbh->quote( $data{'sex'} )
 750       . ",fax="         . $dbh->quote( $data{'fax'} )
 751       . ",relationship=" . $dbh->quote( $data{'relationship'} )
 752       . ",B_streetnumber=" . $dbh->quote( $data{'B_streetnumber'} )
 753       . ",B_streettype=" . $dbh->quote( $data{'B_streettype'} )
 754       . ",gonenoaddress=" . $dbh->quote( $data{'gonenoaddress'} )
 755       . ",lost="        . $dbh->quote( $data{'lost'} )
 756       . ",debarred="    . $dbh->quote( $data{'debarred'} )
 757       . ",ethnicity="   . $dbh->quote( $data{'ethnicity'} )
 758       . ",ethnotes="    . $dbh->quote( $data{'ethnotes'} )
 759       . ",altcontactsurname="   . $dbh->quote( $data{'altcontactsurname'} )
 760       . ",altcontactfirstname="     . $dbh->quote( $data{'altcontactfirstname'} )
 761       . ",altcontactaddress1="  . $dbh->quote( $data{'altcontactaddress1'} )
 762       . ",altcontactaddress2="  . $dbh->quote( $data{'altcontactaddress2'} )
 763       . ",altcontactaddress3="  . $dbh->quote( $data{'altcontactaddress3'} )
 764       . ",altcontactzipcode="   . $dbh->quote( $data{'altcontactzipcode'} )
 765       . ",altcontactphone="     . $dbh->quote( $data{'altcontactphone'} ) ;
 766     $debug and print STDERR "AddMember SQL: ($query)\n";
 767     my $sth = $dbh->prepare($query);
 768     #   print "Executing SQL: $query\n";
 769     $sth->execute();
 770     $sth->finish;
 771     $data{'borrowernumber'} = $dbh->{'mysql_insertid'};     # unneeded w/ autoincrement ?
 772     # mysql_insertid is probably bad.  not necessarily accurate and mysql-specific at best.
 773
 774     logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");
 775
 776     # check for enrollment fee & add it if needed
 777     $sth = $dbh->prepare("SELECT enrolmentfee FROM categories WHERE categorycode=?");
 778     $sth->execute($data{'categorycode'});
 779     my ($enrolmentfee) = $sth->fetchrow;
 780     if ($enrolmentfee && $enrolmentfee > 0) {
 781         # insert fee in patron debts
 782         manualinvoice($data{'borrowernumber'}, '', '', 'A', $enrolmentfee);
 783     }
 784     return $data{'borrowernumber'};
 785 }
 786
 787 sub Check_Userid {
 788     my ($uid,$member) = @_;
 789     my $dbh = C4::Context->dbh;
 790     # Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
 791     # Then we need to tell the user and have them create a new one.
 792     my $sth =
 793       $dbh->prepare(
 794         "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
 795     $sth->execute( $uid, $member );
 796     if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
 797         return 0;
 798     }
 799     else {
 800         return 1;
 801     }
 802 }
 803
 804
 805 sub changepassword {
 806     my ( $uid, $member, $digest ) = @_;
 807     my $dbh = C4::Context->dbh;
 808
 809 #Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
 810 #Then we need to tell the user and have them create a new one.
 811     my $resultcode;
 812     my $sth =
 813       $dbh->prepare(
 814         "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
 815     $sth->execute( $uid, $member );
 816     if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
 817         $resultcode=0;
 818     }
 819     else {
 820         #Everything is good so we can update the information.
 821         $sth =
 822           $dbh->prepare(
 823             "update borrowers set userid=?, password=? where borrowernumber=?");
 824         $sth->execute( $uid, $digest, $member );
 825         $resultcode=1;
 826     }
 827
 828     logaction("MEMBERS", "CHANGE PASS", $member, "") if C4::Context->preference("BorrowersLog");
 829     return $resultcode;
 830 }
 831
 832
 833
 834 =head2 fixup_cardnumber
 835
 836 Warning: The caller is responsible for locking the members table in write
 837 mode, to avoid database corruption.
 838
 839 =cut
 840
 841 use vars qw( @weightings );
 842 my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
 843
 844 sub fixup_cardnumber ($) {
 845     my ($cardnumber) = @_;
 846     my $autonumber_members = C4::Context->boolean_preference('autoMemberNum');
 847     $autonumber_members = 0 unless defined $autonumber_members;
 848
 849     # Find out whether member numbers should be generated
 850     # automatically. Should be either "1" or something else.
 851     # Defaults to "0", which is interpreted as "no".
 852
 853     #     if ($cardnumber !~ /\S/ && $autonumber_members) {
 854     if ($autonumber_members) {
 855         my $dbh = C4::Context->dbh;
 856         if ( C4::Context->preference('checkdigit') eq 'katipo' ) {
 857
 858             # if checkdigit is selected, calculate katipo-style cardnumber.
 859             # otherwise, just use the max()
 860             # purpose: generate checksum'd member numbers.
 861             # We'll assume we just got the max value of digits 2-8 of member #'s
 862             # from the database and our job is to increment that by one,
 863             # determine the 1st and 9th digits and return the full string.
 864             my $sth =
 865               $dbh->prepare(
 866                 "select max(substring(borrowers.cardnumber,2,7)) from borrowers"
 867               );
 868             $sth->execute;
 869
 870             my $data = $sth->fetchrow_hashref;
 871             $cardnumber = $data->{'max(substring(borrowers.cardnumber,2,7))'};
 872             $sth->finish;
 873             if ( !$cardnumber ) {    # If DB has no values,
 874                 $cardnumber = 1000000;    # start at 1000000
 875             }
 876             else {
 877                 $cardnumber += 1;
 878             }
 879
 880             my $sum = 0;
 881             for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
 882
 883                 # read weightings, left to right, 1 char at a time
 884                 my $temp1 = $weightings[$i];
 885
 886                 # sequence left to right, 1 char at a time
 887                 my $temp2 = substr( $cardnumber, $i, 1 );
 888
 889                 # mult each char 1-7 by its corresponding weighting
 890                 $sum += $temp1 * $temp2;
 891             }
 892
 893             my $rem = ( $sum % 11 );
 894             $rem = 'X' if $rem == 10;
 895
 896             $cardnumber = "V$cardnumber$rem";
 897         }
 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 =
 903               $dbh->prepare(
 904                 "select max(cast(cardnumber as signed)) from borrowers");
 905
 906       #my $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers");
 907
 908             $sth->execute;
 909
 910             my ($result) = $sth->fetchrow;
 911             $sth->finish;
 912             $cardnumber = $result + 1;
 913         }
 914     }
 915     return $cardnumber;
 916 }
 917
 918 =head2 GetGuarantees
 919
 920   ($num_children, $children_arrayref) = &GetGuarantees($parent_borrno);
 921   $child0_cardno = $children_arrayref->[0]{"cardnumber"};
 922   $child0_borrno = $children_arrayref->[0]{"borrowernumber"};
 923
 924 C<&GetGuarantees> takes a borrower number (e.g., that of a patron
 925 with children) and looks up the borrowers who are guaranteed by that
 926 borrower (i.e., the patron's children).
 927
 928 C<&GetGuarantees> returns two values: an integer giving the number of
 929 borrowers guaranteed by C<$parent_borrno>, and a reference to an array
 930 of references to hash, which gives the actual results.
 931
 932 =cut
 933
 934 #'
 935 sub GetGuarantees {
 936     my ($borrowernumber) = @_;
 937     my $dbh              = C4::Context->dbh;
 938     my $sth              =
 939       $dbh->prepare(
 940 "select cardnumber,borrowernumber, firstname, surname from borrowers where guarantorid=?"
 941       );
 942     $sth->execute($borrowernumber);
 943
 944     my @dat;
 945     my $data = $sth->fetchall_arrayref({});
 946     $sth->finish;
 947     return ( scalar(@$data), $data );
 948 }
 949
 950 =head2 UpdateGuarantees
 951
 952   &UpdateGuarantees($parent_borrno);
 953
 954
 955 C<&UpdateGuarantees> borrower data for an adulte and updates all the guarantees
 956 with the modified information
 957
 958 =cut
 959
 960 #'
 961 sub UpdateGuarantees {
 962     my (%data) = @_;
 963     my $dbh = C4::Context->dbh;
 964     my ( $count, $guarantees ) = GetGuarantees( $data{'borrowernumber'} );
 965     for ( my $i = 0 ; $i < $count ; $i++ ) {
 966
 967         # FIXME
 968         # It looks like the $i is only being returned to handle walking through
 969         # the array, which is probably better done as a foreach loop.
 970         #
 971         my $guaquery = qq|UPDATE borrowers
 972               SET address='$data{'address'}',fax='$data{'fax'}',
 973                   B_city='$data{'B_city'}',mobile='$data{'mobile'}',city='$data{'city'}',phone='$data{'phone'}'
 974               WHERE borrowernumber='$guarantees->[$i]->{'borrowernumber'}'
 975         |;
 976         my $sth3 = $dbh->prepare($guaquery);
 977         $sth3->execute;
 978         $sth3->finish;
 979     }
 980 }
 981 =head2 GetPendingIssues
 982
 983   ($count, $issues) = &GetPendingIssues($borrowernumber);
 984
 985 Looks up what the patron with the given borrowernumber has borrowed.
 986
 987 C<&GetPendingIssues> returns a two-element array. C<$issues> is a
 988 reference-to-array, where each element is a reference-to-hash; the
 989 keys are the fields from the C<issues>, C<biblio>, and C<items> tables
 990 in the Koha database. C<$count> is the number of elements in
 991 C<$issues>.
 992
 993 =cut
 994
 995 #'
 996 sub GetPendingIssues {
 997     my ($borrowernumber) = @_;
 998     my $dbh              = C4::Context->dbh;
 999
1000     my $sth              = $dbh->prepare(
1001    "SELECT *,issues.timestamp as timestamp FROM issues
1002       LEFT JOIN items ON issues.itemnumber=items.itemnumber
1003       LEFT JOIN biblio ON     items.biblionumber=biblio.biblionumber
1004       LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1005     WHERE
1006       borrowernumber=?
1007     ORDER BY issues.issuedate"
1008     );
1009     $sth->execute($borrowernumber);
1010     my $data = $sth->fetchall_arrayref({});
1011     my $today = POSIX::strftime("%Y%m%d", localtime);
1012     foreach( @$data ) {
1013         my $datedue = $_->{'date_due'};
1014         $datedue =~ s/-//g;
1015         if ( $datedue < $today ) {
1016             $_->{'overdue'} = 1;
1017         }
1018     }
1019     $sth->finish;
1020     return ( scalar(@$data), $data );
1021 }
1022
1023 =head2 GetAllIssues
1024
1025   ($count, $issues) = &GetAllIssues($borrowernumber, $sortkey, $limit);
1026
1027 Looks up what the patron with the given borrowernumber has borrowed,
1028 and sorts the results.
1029
1030 C<$sortkey> is the name of a field on which to sort the results. This
1031 should be the name of a field in the C<issues>, C<biblio>,
1032 C<biblioitems>, or C<items> table in the Koha database.
1033
1034 C<$limit> is the maximum number of results to return.
1035
1036 C<&GetAllIssues> returns a two-element array. C<$issues> is a
1037 reference-to-array, where each element is a reference-to-hash; the
1038 keys are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
1039 C<items> tables of the Koha database. C<$count> is the number of
1040 elements in C<$issues>
1041
1042 =cut
1043
1044 #'
1045 sub GetAllIssues {
1046     my ( $borrowernumber, $order, $limit ) = @_;
1047
1048     #FIXME: sanity-check order and limit
1049     my $dbh   = C4::Context->dbh;
1050     my $count = 0;
1051     my $query =
1052   "SELECT *,issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1053   FROM issues
1054   LEFT JOIN items on items.itemnumber=issues.itemnumber
1055   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1056   LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1057   WHERE borrowernumber=?
1058   UNION ALL
1059   SELECT *,old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1060   FROM old_issues
1061   LEFT JOIN items on items.itemnumber=old_issues.itemnumber
1062   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1063   LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1064   WHERE borrowernumber=?
1065   order by $order";
1066     if ( $limit != 0 ) {
1067         $query .= " limit $limit";
1068     }
1069
1070     #print $query;
1071     my $sth = $dbh->prepare($query);
1072     $sth->execute($borrowernumber, $borrowernumber);
1073     my @result;
1074     my $i = 0;
1075     while ( my $data = $sth->fetchrow_hashref ) {
1076         $result[$i] = $data;
1077         $i++;
1078         $count++;
1079     }
1080
1081     # get all issued items for borrowernumber from oldissues table
1082     # large chunk of older issues data put into table oldissues
1083     # to speed up db calls for issuing items
1084     if ( C4::Context->preference("ReadingHistory") ) {
1085         # FIXME oldissues (not to be confused with old_issues) is
1086         # apparently specific to HLT.  Not sure if the ReadingHistory
1087         # syspref is still required, as old_issues by design
1088         # is no longer checked with each loan.
1089         my $query2 = "SELECT * FROM oldissues
1090                       LEFT JOIN items ON items.itemnumber=oldissues.itemnumber
1091                       LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1092                       LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1093                       WHERE borrowernumber=?
1094                       ORDER BY $order";
1095         if ( $limit != 0 ) {
1096             $limit = $limit - $count;
1097             $query2 .= " limit $limit";
1098         }
1099
1100         my $sth2 = $dbh->prepare($query2);
1101         $sth2->execute($borrowernumber);
1102
1103         while ( my $data2 = $sth2->fetchrow_hashref ) {
1104             $result[$i] = $data2;
1105             $i++;
1106         }
1107         $sth2->finish;
1108     }
1109     $sth->finish;
1110
1111     return ( $i, \@result );
1112 }
1113
1114
1115 =head2 GetMemberAccountRecords
1116
1117   ($total, $acctlines, $count) = &GetMemberAccountRecords($borrowernumber);
1118
1119 Looks up accounting data for the patron with the given borrowernumber.
1120
1121 C<&GetMemberAccountRecords> returns a three-element array. C<$acctlines> is a
1122 reference-to-array, where each element is a reference-to-hash; the
1123 keys are the fields of the C<accountlines> table in the Koha database.
1124 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1125 total amount outstanding for all of the account lines.
1126
1127 =cut
1128
1129 #'
1130 sub GetMemberAccountRecords {
1131     my ($borrowernumber,$date) = @_;
1132     my $dbh = C4::Context->dbh;
1133     my @acctlines;
1134     my $numlines = 0;
1135     my $strsth      = qq(
1136                         SELECT *
1137                         FROM accountlines
1138                         WHERE borrowernumber=?);
1139     my @bind = ($borrowernumber);
1140     if ($date && $date ne ''){
1141             $strsth.=" AND date < ? ";
1142             push(@bind,$date);
1143     }
1144     $strsth.=" ORDER BY date desc,timestamp DESC";
1145     my $sth= $dbh->prepare( $strsth );
1146     $sth->execute( @bind );
1147     my $total = 0;
1148     while ( my $data = $sth->fetchrow_hashref ) {
1149                 my $biblio = GetBiblioFromItemNumber($data->{itemnumber}) if $data->{itemnumber};
1150                 $data->{biblionumber} = $biblio->{biblionumber};
1151         $acctlines[$numlines] = $data;
1152         $numlines++;
1153         $total += $data->{'amountoutstanding'};
1154     }
1155     $sth->finish;
1156     return ( $total, \@acctlines,$numlines);
1157 }
1158
1159 =head2 GetBorNotifyAcctRecord
1160
1161   ($count, $acctlines, $total) = &GetBorNotifyAcctRecord($params,$notifyid);
1162
1163 Looks up accounting data for the patron with the given borrowernumber per file number.
1164
1165 (FIXME - I'm not at all sure what this is about.)
1166
1167 C<&GetBorNotifyAcctRecord> returns a three-element array. C<$acctlines> is a
1168 reference-to-array, where each element is a reference-to-hash; the
1169 keys are the fields of the C<accountlines> table in the Koha database.
1170 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1171 total amount outstanding for all of the account lines.
1172
1173 =cut
1174
1175 sub GetBorNotifyAcctRecord {
1176     my ( $borrowernumber, $notifyid ) = @_;
1177     my $dbh = C4::Context->dbh;
1178     my @acctlines;
1179     my $numlines = 0;
1180     my $sth = $dbh->prepare(
1181             "SELECT *
1182                 FROM accountlines
1183                 WHERE borrowernumber=?
1184                     AND notify_id=?
1185                     AND amountoutstanding != '0'
1186                 ORDER BY notify_id,accounttype
1187                 ");
1188 #                    AND (accounttype='FU' OR accounttype='N' OR accounttype='M'OR accounttype='A'OR accounttype='F'OR accounttype='L' OR accounttype='IP' OR accounttype='CH' OR accounttype='RE' OR accounttype='RL')
1189
1190     $sth->execute( $borrowernumber, $notifyid );
1191     my $total = 0;
1192     while ( my $data = $sth->fetchrow_hashref ) {
1193         $acctlines[$numlines] = $data;
1194         $numlines++;
1195         $total += $data->{'amountoutstanding'};
1196     }
1197     $sth->finish;
1198     return ( $total, \@acctlines, $numlines );
1199 }
1200
1201 =head2 checkuniquemember (OUEST-PROVENCE)
1202
1203   ($result,$categorycode)  = &checkuniquemember($collectivity,$surname,$firstname,$dateofbirth);
1204
1205 Checks that a member exists or not in the database.
1206
1207 C<&result> is nonzero (=exist) or 0 (=does not exist)
1208 C<&categorycode> is from categorycode table
1209 C<&collectivity> is 1 (= we add a collectivity) or 0 (= we add a physical member)
1210 C<&surname> is the surname
1211 C<&firstname> is the firstname (only if collectivity=0)
1212 C<&dateofbirth> is the date of birth in ISO format (only if collectivity=0)
1213
1214 =cut
1215
1216 # FIXME: This function is not legitimate.  Multiple patrons might have the same first/last name and birthdate.
1217 # This is especially true since first name is not even a required field.
1218
1219 sub checkuniquemember {
1220     my ( $collectivity, $surname, $firstname, $dateofbirth ) = @_;
1221     my $dbh = C4::Context->dbh;
1222     my $request = ($collectivity) ?
1223         "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? " :
1224         "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=? and dateofbirth=? ";
1225     my $sth = $dbh->prepare($request);
1226     if ($collectivity) {
1227         $sth->execute( uc($surname) );
1228     } else {
1229         $sth->execute( uc($surname), ucfirst($firstname), $dateofbirth );
1230     }
1231     my @data = $sth->fetchrow;
1232     $sth->finish;
1233     ( $data[0] ) and return $data[0], $data[1];
1234     return 0;
1235 }
1236
1237 sub checkcardnumber {
1238     my ($cardnumber,$borrowernumber) = @_;
1239     my $dbh = C4::Context->dbh;
1240     my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
1241     $query .= " AND borrowernumber <> ?" if ($borrowernumber);
1242   my $sth = $dbh->prepare($query);
1243   if ($borrowernumber) {
1244    $sth->execute($cardnumber,$borrowernumber);
1245   } else {
1246      $sth->execute($cardnumber);
1247   }
1248     if (my $data= $sth->fetchrow_hashref()){
1249         return 1;
1250     }
1251     else {
1252         return 0;
1253     }
1254     $sth->finish();
1255 }
1256
1257
1258 =head2 getzipnamecity (OUEST-PROVENCE)
1259
1260 take all info from table city for the fields city and  zip
1261 check for the name and the zip code of the city selected
1262
1263 =cut
1264
1265 sub getzipnamecity {
1266     my ($cityid) = @_;
1267     my $dbh      = C4::Context->dbh;
1268     my $sth      =
1269       $dbh->prepare(
1270         "select city_name,city_zipcode from cities where cityid=? ");
1271     $sth->execute($cityid);
1272     my @data = $sth->fetchrow;
1273     return $data[0], $data[1];
1274 }
1275
1276
1277 =head2 getdcity (OUEST-PROVENCE)
1278
1279 recover cityid  with city_name condition
1280
1281 =cut
1282
1283 sub getidcity {
1284     my ($city_name) = @_;
1285     my $dbh = C4::Context->dbh;
1286     my $sth = $dbh->prepare("select cityid from cities where city_name=? ");
1287     $sth->execute($city_name);
1288     my $data = $sth->fetchrow;
1289     return $data;
1290 }
1291
1292
1293 =head2 GetExpiryDate
1294
1295   $expirydate = GetExpiryDate($categorycode, $dateenrolled);
1296
1297 Calculate expiry date given a categorycode and starting date.  Date argument must be in ISO format.
1298 Return date is also in ISO format.
1299
1300 =cut
1301
1302 sub GetExpiryDate {
1303     my ( $categorycode, $dateenrolled ) = @_;
1304     my $enrolmentperiod = 12;   # reasonable default
1305     if ($categorycode) {
1306         my $dbh = C4::Context->dbh;
1307         my $sth = $dbh->prepare("select enrolmentperiod from categories where categorycode=?");
1308         $sth->execute($categorycode);
1309         $enrolmentperiod = $sth->fetchrow;
1310     }
1311     # die "GetExpiryDate: for enrollmentperiod $enrolmentperiod (category '$categorycode') starting $dateenrolled.\n";
1312     my @date = split /-/,$dateenrolled;
1313     return sprintf("%04d-%02d-%02d", Add_Delta_YM(@date,0,$enrolmentperiod));
1314 }
1315
1316 =head2 checkuserpassword (OUEST-PROVENCE)
1317
1318 check for the password and login are not used
1319 return the number of record
1320 0=> NOT USED 1=> USED
1321
1322 =cut
1323
1324 sub checkuserpassword {
1325     my ( $borrowernumber, $userid, $password ) = @_;
1326     $password = md5_base64($password);
1327     my $dbh = C4::Context->dbh;
1328     my $sth =
1329       $dbh->prepare(
1330 "Select count(*) from borrowers where borrowernumber !=? and userid =? and password=? "
1331       );
1332     $sth->execute( $borrowernumber, $userid, $password );
1333     my $number_rows = $sth->fetchrow;
1334     return $number_rows;
1335
1336 }
1337
1338 =head2 GetborCatFromCatType
1339
1340   ($codes_arrayref, $labels_hashref) = &GetborCatFromCatType();
1341
1342 Looks up the different types of borrowers in the database. Returns two
1343 elements: a reference-to-array, which lists the borrower category
1344 codes, and a reference-to-hash, which maps the borrower category codes
1345 to category descriptions.
1346
1347 =cut
1348
1349 #'
1350 sub GetborCatFromCatType {
1351     my ( $category_type, $action ) = @_;
1352         # FIXME - This API  seems both limited and dangerous.
1353     my $dbh     = C4::Context->dbh;
1354     my $request = qq|   SELECT categorycode,description
1355             FROM categories
1356             $action
1357             ORDER BY categorycode|;
1358     my $sth = $dbh->prepare($request);
1359         if ($action) {
1360         $sth->execute($category_type);
1361     }
1362     else {
1363         $sth->execute();
1364     }
1365
1366     my %labels;
1367     my @codes;
1368
1369     while ( my $data = $sth->fetchrow_hashref ) {
1370         push @codes, $data->{'categorycode'};
1371         $labels{ $data->{'categorycode'} } = $data->{'description'};
1372     }
1373     $sth->finish;
1374     return ( \@codes, \%labels );
1375 }
1376
1377 =head2 GetBorrowercategory
1378
1379   $hashref = &GetBorrowercategory($categorycode);
1380
1381 Given the borrower's category code, the function returns the corresponding
1382 data hashref for a comprehensive information display.
1383
1384   $arrayref_hashref = &GetBorrowercategory;
1385 If no category code provided, the function returns all the categories.
1386
1387 =cut
1388
1389 sub GetBorrowercategory {
1390     my ($catcode) = @_;
1391     my $dbh       = C4::Context->dbh;
1392     if ($catcode){
1393         my $sth       =
1394         $dbh->prepare(
1395     "SELECT description,dateofbirthrequired,upperagelimit,category_type
1396     FROM categories
1397     WHERE categorycode = ?"
1398         );
1399         $sth->execute($catcode);
1400         my $data =
1401         $sth->fetchrow_hashref;
1402         $sth->finish();
1403         return $data;
1404     }
1405     return;
1406 }    # sub getborrowercategory
1407
1408 =head2 GetBorrowercategoryList
1409
1410   $arrayref_hashref = &GetBorrowercategoryList;
1411 If no category code provided, the function returns all the categories.
1412
1413 =cut
1414
1415 sub GetBorrowercategoryList {
1416     my $dbh       = C4::Context->dbh;
1417     my $sth       =
1418     $dbh->prepare(
1419     "SELECT *
1420     FROM categories
1421     ORDER BY description"
1422         );
1423     $sth->execute;
1424     my $data =
1425     $sth->fetchall_arrayref({});
1426     $sth->finish();
1427     return $data;
1428 }    # sub getborrowercategory
1429
1430 =head2 ethnicitycategories
1431
1432   ($codes_arrayref, $labels_hashref) = &ethnicitycategories();
1433
1434 Looks up the different ethnic types in the database. Returns two
1435 elements: a reference-to-array, which lists the ethnicity codes, and a
1436 reference-to-hash, which maps the ethnicity codes to ethnicity
1437 descriptions.
1438
1439 =cut
1440
1441 #'
1442
1443 sub ethnicitycategories {
1444     my $dbh = C4::Context->dbh;
1445     my $sth = $dbh->prepare("Select code,name from ethnicity order by name");
1446     $sth->execute;
1447     my %labels;
1448     my @codes;
1449     while ( my $data = $sth->fetchrow_hashref ) {
1450         push @codes, $data->{'code'};
1451         $labels{ $data->{'code'} } = $data->{'name'};
1452     }
1453     $sth->finish;
1454     return ( \@codes, \%labels );
1455 }
1456
1457 =head2 fixEthnicity
1458
1459   $ethn_name = &fixEthnicity($ethn_code);
1460
1461 Takes an ethnicity code (e.g., "european" or "pi") and returns the
1462 corresponding descriptive name from the C<ethnicity> table in the
1463 Koha database ("European" or "Pacific Islander").
1464
1465 =cut
1466
1467 #'
1468
1469 sub fixEthnicity {
1470     my $ethnicity = shift;
1471     return unless $ethnicity;
1472     my $dbh       = C4::Context->dbh;
1473     my $sth       = $dbh->prepare("Select name from ethnicity where code = ?");
1474     $sth->execute($ethnicity);
1475     my $data = $sth->fetchrow_hashref;
1476     $sth->finish;
1477     return $data->{'name'};
1478 }    # sub fixEthnicity
1479
1480 =head2 GetAge
1481
1482   $dateofbirth,$date = &GetAge($date);
1483
1484 this function return the borrowers age with the value of dateofbirth
1485
1486 =cut
1487
1488 #'
1489 sub GetAge{
1490     my ( $date, $date_ref ) = @_;
1491
1492     if ( not defined $date_ref ) {
1493         $date_ref = sprintf( '%04d-%02d-%02d', Today() );
1494     }
1495
1496     my ( $year1, $month1, $day1 ) = split /-/, $date;
1497     my ( $year2, $month2, $day2 ) = split /-/, $date_ref;
1498
1499     my $age = $year2 - $year1;
1500     if ( $month1 . $day1 > $month2 . $day2 ) {
1501         $age--;
1502     }
1503
1504     return $age;
1505 }    # sub get_age
1506
1507 =head2 get_institutions
1508   $insitutions = get_institutions();
1509
1510 Just returns a list of all the borrowers of type I, borrownumber and name
1511
1512 =cut
1513
1514 #'
1515 sub get_institutions {
1516     my $dbh = C4::Context->dbh();
1517     my $sth =
1518       $dbh->prepare(
1519 "SELECT borrowernumber,surname FROM borrowers WHERE categorycode=? ORDER BY surname"
1520       );
1521     $sth->execute('I');
1522     my %orgs;
1523     while ( my $data = $sth->fetchrow_hashref() ) {
1524         $orgs{ $data->{'borrowernumber'} } = $data;
1525     }
1526     $sth->finish();
1527     return ( \%orgs );
1528
1529 }    # sub get_institutions
1530
1531 =head2 add_member_orgs
1532
1533   add_member_orgs($borrowernumber,$borrowernumbers);
1534
1535 Takes a borrowernumber and a list of other borrowernumbers and inserts them into the borrowers_to_borrowers table
1536
1537 =cut
1538
1539 #'
1540 sub add_member_orgs {
1541     my ( $borrowernumber, $otherborrowers ) = @_;
1542     my $dbh   = C4::Context->dbh();
1543     my $query =
1544       "INSERT INTO borrowers_to_borrowers (borrower1,borrower2) VALUES (?,?)";
1545     my $sth = $dbh->prepare($query);
1546     foreach my $otherborrowernumber (@$otherborrowers) {
1547         $sth->execute( $borrowernumber, $otherborrowernumber );
1548     }
1549     $sth->finish();
1550
1551 }    # sub add_member_orgs
1552
1553 =head2 GetCities (OUEST-PROVENCE)
1554
1555   ($id_cityarrayref, $city_hashref) = &GetCities();
1556
1557 Looks up the different city and zip in the database. Returns two
1558 elements: a reference-to-array, which lists the zip city
1559 codes, and a reference-to-hash, which maps the name of the city.
1560 WHERE =>OUEST PROVENCE OR EXTERIEUR
1561
1562 =cut
1563
1564 sub GetCities {
1565
1566     #my ($type_city) = @_;
1567     my $dbh   = C4::Context->dbh;
1568     my $query = qq|SELECT cityid,city_zipcode,city_name
1569         FROM cities
1570         ORDER BY city_name|;
1571     my $sth = $dbh->prepare($query);
1572
1573     #$sth->execute($type_city);
1574     $sth->execute();
1575     my %city;
1576     my @id;
1577     #    insert empty value to create a empty choice in cgi popup
1578     push @id, " ";
1579     $city{""} = "";
1580     while ( my $data = $sth->fetchrow_hashref ) {
1581         push @id, $data->{'city_zipcode'}."|".$data->{'city_name'};
1582         $city{ $data->{'city_zipcode'}."|".$data->{'city_name'} } = $data->{'city_name'};
1583     }
1584
1585 #test to know if the table contain some records if no the function return nothing
1586     my $id = @id;
1587     $sth->finish;
1588     if ( $id == 1 ) {
1589         # all we have is the one blank row
1590         return ();
1591     }
1592     else {
1593         unshift( @id, "" );
1594         return ( \@id, \%city );
1595     }
1596 }
1597
1598 =head2 GetSortDetails (OUEST-PROVENCE)
1599
1600   ($lib) = &GetSortDetails($category,$sortvalue);
1601
1602 Returns the authorized value  details
1603 C<&$lib>return value of authorized value details
1604 C<&$sortvalue>this is the value of authorized value
1605 C<&$category>this is the value of authorized value category
1606
1607 =cut
1608
1609 sub GetSortDetails {
1610     my ( $category, $sortvalue ) = @_;
1611     my $dbh   = C4::Context->dbh;
1612     my $query = qq|SELECT lib
1613         FROM authorised_values
1614         WHERE category=?
1615         AND authorised_value=? |;
1616     my $sth = $dbh->prepare($query);
1617     $sth->execute( $category, $sortvalue );
1618     my $lib = $sth->fetchrow;
1619     return ($lib) if ($lib);
1620     return ($sortvalue) unless ($lib);
1621 }
1622
1623 =head2 DeleteBorrower
1624
1625   () = &DeleteBorrower($member);
1626
1627 delete all data fo borrowers and add record to deletedborrowers table
1628 C<&$member>this is the borrowernumber
1629
1630 =cut
1631
1632 sub MoveMemberToDeleted {
1633     my ($member) = @_;
1634     my $dbh = C4::Context->dbh;
1635     my $query;
1636     $query = qq|SELECT *
1637           FROM borrowers
1638           WHERE borrowernumber=?|;
1639     my $sth = $dbh->prepare($query);
1640     $sth->execute($member);
1641     my @data = $sth->fetchrow_array;
1642     $sth->finish;
1643     $sth =
1644       $dbh->prepare( "INSERT INTO deletedborrowers VALUES ("
1645           . ( "?," x ( scalar(@data) - 1 ) )
1646           . "?)" );
1647     $sth->execute(@data);
1648     $sth->finish;
1649 }
1650
1651 =head2 DelMember
1652
1653 DelMember($borrowernumber);
1654
1655 This function remove directly a borrower whitout writing it on deleteborrower.
1656 + Deletes reserves for the borrower
1657
1658 =cut
1659
1660 sub DelMember {
1661     my $dbh            = C4::Context->dbh;
1662     my $borrowernumber = shift;
1663     #warn "in delmember with $borrowernumber";
1664     return unless $borrowernumber;    # borrowernumber is mandatory.
1665
1666     my $query = qq|DELETE
1667           FROM  reserves
1668           WHERE borrowernumber=?|;
1669     my $sth = $dbh->prepare($query);
1670     $sth->execute($borrowernumber);
1671     $sth->finish;
1672     $query = "
1673        DELETE
1674        FROM borrowers
1675        WHERE borrowernumber = ?
1676    ";
1677     $sth = $dbh->prepare($query);
1678     $sth->execute($borrowernumber);
1679     $sth->finish;
1680     logaction("MEMBERS", "DELETE", $borrowernumber, "") if C4::Context->preference("BorrowersLog");
1681     return $sth->rows;
1682 }
1683
1684 =head2 ExtendMemberSubscriptionTo (OUEST-PROVENCE)
1685
1686     $date = ExtendMemberSubscriptionTo($borrowerid, $date);
1687
1688 Extending the subscription to a given date or to the expiry date calculated on ISO date.
1689 Returns ISO date.
1690
1691 =cut
1692
1693 sub ExtendMemberSubscriptionTo {
1694     my ( $borrowerid,$date) = @_;
1695     my $dbh = C4::Context->dbh;
1696     my $borrower = GetMember($borrowerid,'borrowernumber');
1697     unless ($date){
1698       $date=POSIX::strftime("%Y-%m-%d",localtime());
1699       my $borrower = GetMember($borrowerid,'borrowernumber');
1700       $date = GetExpiryDate( $borrower->{'categorycode'}, $date );
1701     }
1702     my $sth = $dbh->do(<<EOF);
1703 UPDATE borrowers
1704 SET  dateexpiry='$date'
1705 WHERE borrowernumber='$borrowerid'
1706 EOF
1707     # add enrolmentfee if needed
1708     $sth = $dbh->prepare("SELECT enrolmentfee FROM categories WHERE categorycode=?");
1709     $sth->execute($borrower->{'categorycode'});
1710     my ($enrolmentfee) = $sth->fetchrow;
1711     if ($enrolmentfee) {
1712         # insert fee in patron debts
1713         manualinvoice($borrower->{'borrowernumber'}, '', '', 'A', $enrolmentfee);
1714     }
1715     return $date if ($sth);
1716     return 0;
1717 }
1718
1719 =head2 GetRoadTypes (OUEST-PROVENCE)
1720
1721   ($idroadtypearrayref, $roadttype_hashref) = &GetRoadTypes();
1722
1723 Looks up the different road type . Returns two
1724 elements: a reference-to-array, which lists the id_roadtype
1725 codes, and a reference-to-hash, which maps the road type of the road .
1726
1727 =cut
1728
1729 sub GetRoadTypes {
1730     my $dbh   = C4::Context->dbh;
1731     my $query = qq|
1732 SELECT roadtypeid,road_type
1733 FROM roadtype
1734 ORDER BY road_type|;
1735     my $sth = $dbh->prepare($query);
1736     $sth->execute();
1737     my %roadtype;
1738     my @id;
1739
1740     #    insert empty value to create a empty choice in cgi popup
1741
1742     while ( my $data = $sth->fetchrow_hashref ) {
1743
1744         push @id, $data->{'roadtypeid'};
1745         $roadtype{ $data->{'roadtypeid'} } = $data->{'road_type'};
1746     }
1747
1748 #test to know if the table contain some records if no the function return nothing
1749     my $id = @id;
1750     $sth->finish;
1751     if ( $id eq 0 ) {
1752         return ();
1753     }
1754     else {
1755         unshift( @id, "" );
1756         return ( \@id, \%roadtype );
1757     }
1758 }
1759
1760
1761
1762 =head2 GetTitles (OUEST-PROVENCE)
1763
1764   ($borrowertitle)= &GetTitles();
1765
1766 Looks up the different title . Returns array  with all borrowers title
1767
1768 =cut
1769
1770 sub GetTitles {
1771     my @borrowerTitle = split /,|\|/,C4::Context->preference('BorrowersTitles');
1772     unshift( @borrowerTitle, "" );
1773     my $count=@borrowerTitle;
1774     if ($count == 1){
1775         return ();
1776     }
1777     else {
1778         return ( \@borrowerTitle);
1779     }
1780 }
1781
1782 =head2 GetPatronImage
1783
1784     my ($imagedata, $dberror) = GetPatronImage($cardnumber);
1785
1786 Returns the mimetype and binary image data of the image for the patron with the supplied cardnumber.
1787
1788 =cut
1789
1790 sub GetPatronImage {
1791     my ($cardnumber) = @_;
1792     warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1793     my $dbh = C4::Context->dbh;
1794     my $query = 'SELECT mimetype, imagefile FROM patronimage WHERE cardnumber = ?';
1795     my $sth = $dbh->prepare($query);
1796     $sth->execute($cardnumber);
1797     my $imagedata = $sth->fetchrow_hashref;
1798     my $dberror = $sth->errstr;
1799     warn "Database error!" if $sth->errstr;
1800     $sth->finish;
1801     return $imagedata, $dberror;
1802 }
1803
1804 =head2 PutPatronImage
1805
1806     PutPatronImage($cardnumber, $mimetype, $imgfile);
1807
1808 Stores patron binary image data and mimetype in database.
1809 NOTE: This function is good for updating images as well as inserting new images in the database.
1810
1811 =cut
1812
1813 sub PutPatronImage {
1814     my ($cardnumber, $mimetype, $imgfile) = @_;
1815     warn "Parameters passed in: Cardnumber=$cardnumber, Mimetype=$mimetype, " . ($imgfile ? "Imagefile" : "No Imagefile") if $debug;
1816     my $dbh = C4::Context->dbh;
1817     my $query = "INSERT INTO patronimage (cardnumber, mimetype, imagefile) VALUES (?,?,?) ON DUPLICATE KEY UPDATE imagefile = ?;";
1818     my $sth = $dbh->prepare($query);
1819     $sth->execute($cardnumber,$mimetype,$imgfile,$imgfile);
1820     warn "Error returned inserting $cardnumber.$mimetype." if $sth->errstr;
1821     my $dberror = $sth->errstr;
1822     $sth->finish;
1823     return $dberror;
1824 }
1825
1826 =head2 RmPatronImage
1827
1828     my ($dberror) = RmPatronImage($cardnumber);
1829
1830 Removes the image for the patron with the supplied cardnumber.
1831
1832 =cut
1833
1834 sub RmPatronImage {
1835     my ($cardnumber) = @_;
1836     warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1837     my $dbh = C4::Context->dbh;
1838     my $query = "DELETE FROM patronimage WHERE cardnumber = ?;";
1839     my $sth = $dbh->prepare($query);
1840     $sth->execute($cardnumber);
1841     my $dberror = $sth->errstr;
1842     warn "Database error!" if $sth->errstr;
1843     $sth->finish;
1844     return $dberror;
1845 }
1846
1847 =head2 GetRoadTypeDetails (OUEST-PROVENCE)
1848
1849   ($roadtype) = &GetRoadTypeDetails($roadtypeid);
1850
1851 Returns the description of roadtype
1852 C<&$roadtype>return description of road type
1853 C<&$roadtypeid>this is the value of roadtype s
1854
1855 =cut
1856
1857 sub GetRoadTypeDetails {
1858     my ($roadtypeid) = @_;
1859     my $dbh          = C4::Context->dbh;
1860     my $query        = qq|
1861 SELECT road_type
1862 FROM roadtype
1863 WHERE roadtypeid=?|;
1864     my $sth = $dbh->prepare($query);
1865     $sth->execute($roadtypeid);
1866     my $roadtype = $sth->fetchrow;
1867     return ($roadtype);
1868 }
1869
1870 =head2 GetBorrowersWhoHaveNotBorrowedSince
1871
1872 &GetBorrowersWhoHaveNotBorrowedSince($date)
1873
1874 this function get all borrowers who haven't borrowed since the date given on input arg.
1875
1876 =cut
1877
1878 sub GetBorrowersWhoHaveNotBorrowedSince {
1879 ### TODO : It could be dangerous to delete Borrowers who have just been entered and who have not yet borrowed any book. May be good to add a dateexpiry or dateenrolled filter.
1880
1881                 my $filterdate = shift||POSIX::strftime("%Y-%m-%d",localtime());
1882     my $filterbranch = shift ||
1883                         ((C4::Context->preference('IndependantBranches')
1884                              && C4::Context->userenv
1885                              && C4::Context->userenv->{flags}!=1
1886                              && C4::Context->userenv->{branch})
1887                          ? C4::Context->userenv->{branch}
1888                          : "");
1889     my $dbh   = C4::Context->dbh;
1890     my $query = "
1891         SELECT borrowers.borrowernumber,max(issues.timestamp) as latestissue
1892         FROM   borrowers
1893         JOIN   categories USING (categorycode)
1894         LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
1895         WHERE  category_type <> 'S'
1896    ";
1897     my @query_params;
1898     if ($filterbranch && $filterbranch ne ""){
1899         $query.=" AND borrowers.branchcode= ?";
1900         push @query_params,$filterbranch;
1901     }
1902     $query.=" GROUP BY borrowers.borrowernumber";
1903     if ($filterdate){
1904         $query.=" HAVING latestissue <? OR latestissue IS NULL";
1905         push @query_params,$filterdate;
1906     }
1907     warn $query if $debug;
1908     my $sth = $dbh->prepare($query);
1909     if (scalar(@query_params)>0){
1910         $sth->execute(@query_params);
1911     }
1912     else {
1913         $sth->execute;
1914     }
1915
1916     my @results;
1917     while ( my $data = $sth->fetchrow_hashref ) {
1918         push @results, $data;
1919     }
1920     return \@results;
1921 }
1922
1923 =head2 GetBorrowersWhoHaveNeverBorrowed
1924
1925 $results = &GetBorrowersWhoHaveNeverBorrowed
1926
1927 this function get all borrowers who have never borrowed.
1928
1929 I<$result> is a ref to an array which all elements are a hasref.
1930
1931 =cut
1932
1933 sub GetBorrowersWhoHaveNeverBorrowed {
1934     my $filterbranch = shift ||
1935                         ((C4::Context->preference('IndependantBranches')
1936                              && C4::Context->userenv
1937                              && C4::Context->userenv->{flags}!=1
1938                              && C4::Context->userenv->{branch})
1939                          ? C4::Context->userenv->{branch}
1940                          : "");
1941     my $dbh   = C4::Context->dbh;
1942     my $query = "
1943         SELECT borrowers.borrowernumber,max(timestamp) as latestissue
1944         FROM   borrowers
1945           LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
1946         WHERE issues.borrowernumber IS NULL
1947    ";
1948     my @query_params;
1949     if ($filterbranch && $filterbranch ne ""){
1950         $query.=" AND borrowers.branchcode= ?";
1951         push @query_params,$filterbranch;
1952     }
1953     warn $query if $debug;
1954
1955     my $sth = $dbh->prepare($query);
1956     if (scalar(@query_params)>0){
1957         $sth->execute(@query_params);
1958     }
1959     else {
1960         $sth->execute;
1961     }
1962
1963     my @results;
1964     while ( my $data = $sth->fetchrow_hashref ) {
1965         push @results, $data;
1966     }
1967     return \@results;
1968 }
1969
1970 =head2 GetBorrowersWithIssuesHistoryOlderThan
1971
1972 $results = &GetBorrowersWithIssuesHistoryOlderThan($date)
1973
1974 this function get all borrowers who has an issue history older than I<$date> given on input arg.
1975
1976 I<$result> is a ref to an array which all elements are a hashref.
1977 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
1978
1979 =cut
1980
1981 sub GetBorrowersWithIssuesHistoryOlderThan {
1982     my $dbh  = C4::Context->dbh;
1983     my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime());
1984     my $filterbranch = shift ||
1985                         ((C4::Context->preference('IndependantBranches')
1986                              && C4::Context->userenv
1987                              && C4::Context->userenv->{flags}!=1
1988                              && C4::Context->userenv->{branch})
1989                          ? C4::Context->userenv->{branch}
1990                          : "");
1991     my $query = "
1992        SELECT count(borrowernumber) as n,borrowernumber
1993        FROM old_issues
1994        WHERE returndate < ?
1995          AND borrowernumber IS NOT NULL
1996     ";
1997     my @query_params;
1998     push @query_params, $date;
1999     if ($filterbranch){
2000         $query.="   AND branchcode = ?";
2001         push @query_params, $filterbranch;
2002     }
2003     $query.=" GROUP BY borrowernumber ";
2004     warn $query if $debug;
2005     my $sth = $dbh->prepare($query);
2006     $sth->execute(@query_params);
2007     my @results;
2008
2009     while ( my $data = $sth->fetchrow_hashref ) {
2010         push @results, $data;
2011     }
2012     return \@results;
2013 }
2014
2015 =head2 GetBorrowersNamesAndLatestIssue
2016
2017 $results = &GetBorrowersNamesAndLatestIssueList(@borrowernumbers)
2018
2019 this function get borrowers Names and surnames and Issue information.
2020
2021 I<@borrowernumbers> is an array which all elements are borrowernumbers.
2022 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
2023
2024 =cut
2025
2026 sub GetBorrowersNamesAndLatestIssue {
2027     my $dbh  = C4::Context->dbh;
2028     my @borrowernumbers=@_;
2029     my $query = "
2030        SELECT surname,lastname, phone, email,max(timestamp)
2031        FROM borrowers
2032          LEFT JOIN issues ON borrowers.borrowernumber=issues.borrowernumber
2033        GROUP BY borrowernumber
2034    ";
2035     my $sth = $dbh->prepare($query);
2036     $sth->execute;
2037     my $results = $sth->fetchall_arrayref({});
2038     return $results;
2039 }
2040
2041 =head2 DebarMember
2042
2043 =over 4
2044
2045 my $success = DebarMember( $borrowernumber );
2046
2047 marks a Member as debarred, and therefore unable to checkout any more
2048 items.
2049
2050 return :
2051 true on success, false on failure
2052
2053 =back
2054
2055 =cut
2056
2057 sub DebarMember {
2058     my $borrowernumber = shift;
2059
2060     return unless defined $borrowernumber;
2061     return unless $borrowernumber =~ /^\d+$/;
2062
2063     return ModMember( borrowernumber => $borrowernumber,
2064                       debarred       => 1 );
2065
2066 }
2067
2068 END { }    # module clean-up code here (global destructor)
2069
2070 1;
2071
2072 __END__
2073
2074 =head1 AUTHOR
2075
2076 Koha Team
2077
2078 =cut