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) and ( $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     ($data) and return ($data);
 539
 540     if (defined($type) and ($type eq 'cardnumber' || $type eq 'firstname')) {    # otherwise, try with firstname
 541         $sth = $dbh->prepare("$select WHERE firstname like ?");
 542         $sth->execute($information);
 543         $data = $sth->fetchrow_hashref;
 544         ($data) and return ($data);
 545     }
 546     return undef;
 547 }
 548
 549 =head2 GetMemberIssuesAndFines
 550
 551   ($overdue_count, $issue_count, $total_fines) = &GetMemberIssuesAndFines($borrowernumber);
 552
 553 Returns aggregate data about items borrowed by the patron with the
 554 given borrowernumber.
 555
 556 C<&GetMemberIssuesAndFines> returns a three-element array.  C<$overdue_count> is the
 557 number of overdue items the patron currently has borrowed. C<$issue_count> is the
 558 number of books the patron currently has borrowed.  C<$total_fines> is
 559 the total fine currently due by the borrower.
 560
 561 =cut
 562
 563 #'
 564 sub GetMemberIssuesAndFines {
 565     my ( $borrowernumber ) = @_;
 566     my $dbh   = C4::Context->dbh;
 567     my $query = "SELECT COUNT(*) FROM issues WHERE borrowernumber = ?";
 568
 569     $debug and warn $query."\n";
 570     my $sth = $dbh->prepare($query);
 571     $sth->execute($borrowernumber);
 572     my $issue_count = $sth->fetchrow_arrayref->[0];
 573     $sth->finish;
 574
 575     $sth = $dbh->prepare(
 576         "SELECT COUNT(*) FROM issues
 577          WHERE borrowernumber = ?
 578          AND date_due < now()"
 579     );
 580     $sth->execute($borrowernumber);
 581     my $overdue_count = $sth->fetchrow_arrayref->[0];
 582     $sth->finish;
 583
 584     $sth = $dbh->prepare("SELECT SUM(amountoutstanding) FROM accountlines WHERE borrowernumber = ?");
 585     $sth->execute($borrowernumber);
 586     my $total_fines = $sth->fetchrow_arrayref->[0];
 587     $sth->finish;
 588
 589     return ($overdue_count, $issue_count, $total_fines);
 590 }
 591
 592 sub columns(;$) {
 593     return @{C4::Context->dbh->selectcol_arrayref("SHOW columns from borrowers")};
 594 }
 595
 596 =head2
 597
 598 =head2 ModMember
 599
 600 =over 4
 601
 602 my $success = ModMember(borrowernumber => $borrowernumber, [ field => value ]... );
 603
 604 Modify borrower's data.  All date fields should ALREADY be in ISO format.
 605
 606 return :
 607 true on success, or false on failure
 608
 609 =back
 610
 611 =cut
 612
 613 sub ModMember {
 614     my (%data) = @_;
 615     my $dbh = C4::Context->dbh;
 616     my $iso_re = C4::Dates->new()->regexp('iso');
 617     foreach (qw(dateofbirth dateexpiry dateenrolled)) {
 618         if (my $tempdate = $data{$_}) {                                 # assignment, not comparison
 619             ($tempdate =~ /$iso_re/) and next;                          # Congatulations, you sent a valid ISO date.
 620             warn "ModMember given $_ not in ISO format ($tempdate)";
 621             my $tempdate2 = format_date_in_iso($tempdate);
 622             if (!$tempdate2 or $tempdate2 eq '0000-00-00') {
 623                 warn "ModMember cannot convert '$tempdate' (from syspref to ISO)";
 624                 next;
 625             }
 626             $data{$_} = $tempdate2;
 627         }
 628     }
 629     if (!$data{'dateofbirth'}){
 630         delete $data{'dateofbirth'};
 631     }
 632     my @columns = &columns;
 633     my %hashborrowerfields = (map {$_=>1} @columns);
 634     my $query = "UPDATE borrowers SET \n";
 635     my $sth;
 636     my @parameters;
 637
 638     # test to know if you must update or not the borrower password
 639     if (exists $data{password}) {
 640         if ($data{password} eq '****' or $data{password} eq '') {
 641             delete $data{password};
 642         } else {
 643             $data{password} = md5_base64($data{password});
 644         }
 645     }
 646     my @badkeys;
 647     foreach (keys %data) {
 648         next if ($_ eq 'borrowernumber' or $_ eq 'flags');
 649         if ($hashborrowerfields{$_}){
 650             $query .= " $_=?, ";
 651             push @parameters,$data{$_};
 652         } else {
 653             push @badkeys, $_;
 654             delete $data{$_};
 655         }
 656     }
 657     (@badkeys) and warn scalar(@badkeys) . " Illegal key(s) passed to ModMember: " . join(',',@badkeys);
 658     $query =~ s/, $//;
 659     $query .= " WHERE borrowernumber=?";
 660     push @parameters, $data{'borrowernumber'};
 661     $debug and print STDERR "$query (executed w/ arg: $data{'borrowernumber'})";
 662     $sth = $dbh->prepare($query);
 663     my $execute_success = $sth->execute(@parameters);
 664     $sth->finish;
 665
 666 # ok if its an adult (type) it may have borrowers that depend on it as a guarantor
 667 # so when we update information for an adult we should check for guarantees and update the relevant part
 668 # of their records, ie addresses and phone numbers
 669     my $borrowercategory= GetBorrowercategory( $data{'category_type'} );
 670     if ( exists  $borrowercategory->{'category_type'} && $borrowercategory->{'category_type'} eq ('A' || 'S') ) {
 671         # is adult check guarantees;
 672         UpdateGuarantees(%data);
 673     }
 674     logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "$query (executed w/ arg: $data{'borrowernumber'})")
 675         if C4::Context->preference("BorrowersLog");
 676
 677     return $execute_success;
 678 }
 679
 680
 681 =head2
 682
 683 =head2 AddMember
 684
 685   $borrowernumber = &AddMember(%borrower);
 686
 687 insert new borrower into table
 688 Returns the borrowernumber
 689
 690 =cut
 691
 692 #'
 693 sub AddMember {
 694     my (%data) = @_;
 695     my $dbh = C4::Context->dbh;
 696     $data{'userid'} = '' unless $data{'password'};
 697     $data{'password'} = md5_base64( $data{'password'} ) if $data{'password'};
 698
 699     # WE SHOULD NEVER PASS THIS SUBROUTINE ANYTHING OTHER THAN ISO DATES
 700     # IF YOU UNCOMMENT THESE LINES YOU BETTER HAVE A DARN COMPELLING REASON
 701 #    $data{'dateofbirth'}  = format_date_in_iso( $data{'dateofbirth'} );
 702 #    $data{'dateenrolled'} = format_date_in_iso( $data{'dateenrolled'});
 703 #    $data{'dateexpiry'}   = format_date_in_iso( $data{'dateexpiry'}  );
 704     # This query should be rewritten to use "?" at execute.
 705     if (!$data{'dateofbirth'}){
 706         undef ($data{'dateofbirth'});
 707     }
 708     my $query =
 709         "insert into borrowers set cardnumber=" . $dbh->quote( $data{'cardnumber'} )
 710       . ",surname="     . $dbh->quote( $data{'surname'} )
 711       . ",firstname="   . $dbh->quote( $data{'firstname'} )
 712       . ",title="       . $dbh->quote( $data{'title'} )
 713       . ",othernames="  . $dbh->quote( $data{'othernames'} )
 714       . ",initials="    . $dbh->quote( $data{'initials'} )
 715       . ",streetnumber=". $dbh->quote( $data{'streetnumber'} )
 716       . ",streettype="  . $dbh->quote( $data{'streettype'} )
 717       . ",address="     . $dbh->quote( $data{'address'} )
 718       . ",address2="    . $dbh->quote( $data{'address2'} )
 719       . ",zipcode="     . $dbh->quote( $data{'zipcode'} )
 720       . ",city="        . $dbh->quote( $data{'city'} )
 721       . ",phone="       . $dbh->quote( $data{'phone'} )
 722       . ",email="       . $dbh->quote( $data{'email'} )
 723       . ",mobile="      . $dbh->quote( $data{'mobile'} )
 724       . ",phonepro="    . $dbh->quote( $data{'phonepro'} )
 725       . ",opacnote="    . $dbh->quote( $data{'opacnote'} )
 726       . ",guarantorid=" . $dbh->quote( $data{'guarantorid'} )
 727       . ",dateofbirth=" . $dbh->quote( $data{'dateofbirth'} )
 728       . ",branchcode="  . $dbh->quote( $data{'branchcode'} )
 729       . ",categorycode=" . $dbh->quote( $data{'categorycode'} )
 730       . ",dateenrolled=" . $dbh->quote( $data{'dateenrolled'} )
 731       . ",contactname=" . $dbh->quote( $data{'contactname'} )
 732       . ",borrowernotes=" . $dbh->quote( $data{'borrowernotes'} )
 733       . ",dateexpiry="  . $dbh->quote( $data{'dateexpiry'} )
 734       . ",contactnote=" . $dbh->quote( $data{'contactnote'} )
 735       . ",B_address="   . $dbh->quote( $data{'B_address'} )
 736       . ",B_zipcode="   . $dbh->quote( $data{'B_zipcode'} )
 737       . ",B_city="      . $dbh->quote( $data{'B_city'} )
 738       . ",B_phone="     . $dbh->quote( $data{'B_phone'} )
 739       . ",B_email="     . $dbh->quote( $data{'B_email'} )
 740       . ",password="    . $dbh->quote( $data{'password'} )
 741       . ",userid="      . $dbh->quote( $data{'userid'} )
 742       . ",sort1="       . $dbh->quote( $data{'sort1'} )
 743       . ",sort2="       . $dbh->quote( $data{'sort2'} )
 744       . ",contacttitle=" . $dbh->quote( $data{'contacttitle'} )
 745       . ",emailpro="    . $dbh->quote( $data{'emailpro'} )
 746       . ",contactfirstname=" . $dbh->quote( $data{'contactfirstname'} )
 747       . ",sex="         . $dbh->quote( $data{'sex'} )
 748       . ",fax="         . $dbh->quote( $data{'fax'} )
 749       . ",relationship=" . $dbh->quote( $data{'relationship'} )
 750       . ",B_streetnumber=" . $dbh->quote( $data{'B_streetnumber'} )
 751       . ",B_streettype=" . $dbh->quote( $data{'B_streettype'} )
 752       . ",gonenoaddress=" . $dbh->quote( $data{'gonenoaddress'} )
 753       . ",lost="        . $dbh->quote( $data{'lost'} )
 754       . ",debarred="    . $dbh->quote( $data{'debarred'} )
 755       . ",ethnicity="   . $dbh->quote( $data{'ethnicity'} )
 756       . ",ethnotes="    . $dbh->quote( $data{'ethnotes'} )
 757       . ",altcontactsurname="   . $dbh->quote( $data{'altcontactsurname'} )
 758       . ",altcontactfirstname="     . $dbh->quote( $data{'altcontactfirstname'} )
 759       . ",altcontactaddress1="  . $dbh->quote( $data{'altcontactaddress1'} )
 760       . ",altcontactaddress2="  . $dbh->quote( $data{'altcontactaddress2'} )
 761       . ",altcontactaddress3="  . $dbh->quote( $data{'altcontactaddress3'} )
 762       . ",altcontactzipcode="   . $dbh->quote( $data{'altcontactzipcode'} )
 763       . ",altcontactphone="     . $dbh->quote( $data{'altcontactphone'} ) ;
 764     $debug and print STDERR "AddMember SQL: ($query)\n";
 765     my $sth = $dbh->prepare($query);
 766     #   print "Executing SQL: $query\n";
 767     $sth->execute();
 768     $sth->finish;
 769     $data{'borrowernumber'} = $dbh->{'mysql_insertid'};     # unneeded w/ autoincrement ?
 770     # mysql_insertid is probably bad.  not necessarily accurate and mysql-specific at best.
 771
 772     logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");
 773
 774     # check for enrollment fee & add it if needed
 775     $sth = $dbh->prepare("SELECT enrolmentfee FROM categories WHERE categorycode=?");
 776     $sth->execute($data{'categorycode'});
 777     my ($enrolmentfee) = $sth->fetchrow;
 778     if ($enrolmentfee && $enrolmentfee > 0) {
 779         # insert fee in patron debts
 780         manualinvoice($data{'borrowernumber'}, '', '', 'A', $enrolmentfee);
 781     }
 782     return $data{'borrowernumber'};
 783 }
 784
 785 sub Check_Userid {
 786     my ($uid,$member) = @_;
 787     my $dbh = C4::Context->dbh;
 788     # Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
 789     # Then we need to tell the user and have them create a new one.
 790     my $sth =
 791       $dbh->prepare(
 792         "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
 793     $sth->execute( $uid, $member );
 794     if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
 795         return 0;
 796     }
 797     else {
 798         return 1;
 799     }
 800 }
 801
 802
 803 sub changepassword {
 804     my ( $uid, $member, $digest ) = @_;
 805     my $dbh = C4::Context->dbh;
 806
 807 #Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
 808 #Then we need to tell the user and have them create a new one.
 809     my $resultcode;
 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         $resultcode=0;
 816     }
 817     else {
 818         #Everything is good so we can update the information.
 819         $sth =
 820           $dbh->prepare(
 821             "update borrowers set userid=?, password=? where borrowernumber=?");
 822         $sth->execute( $uid, $digest, $member );
 823         $resultcode=1;
 824     }
 825
 826     logaction("MEMBERS", "CHANGE PASS", $member, "") if C4::Context->preference("BorrowersLog");
 827     return $resultcode;
 828 }
 829
 830
 831
 832 =head2 fixup_cardnumber
 833
 834 Warning: The caller is responsible for locking the members table in write
 835 mode, to avoid database corruption.
 836
 837 =cut
 838
 839 use vars qw( @weightings );
 840 my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
 841
 842 sub fixup_cardnumber ($) {
 843     my ($cardnumber) = @_;
 844     my $autonumber_members = C4::Context->boolean_preference('autoMemberNum');
 845     $autonumber_members = 0 unless defined $autonumber_members;
 846
 847     # Find out whether member numbers should be generated
 848     # automatically. Should be either "1" or something else.
 849     # Defaults to "0", which is interpreted as "no".
 850
 851     #     if ($cardnumber !~ /\S/ && $autonumber_members) {
 852     if ($autonumber_members) {
 853         my $dbh = C4::Context->dbh;
 854         if ( C4::Context->preference('checkdigit') eq 'katipo' ) {
 855
 856             # if checkdigit is selected, calculate katipo-style cardnumber.
 857             # otherwise, just use the max()
 858             # purpose: generate checksum'd member numbers.
 859             # We'll assume we just got the max value of digits 2-8 of member #'s
 860             # from the database and our job is to increment that by one,
 861             # determine the 1st and 9th digits and return the full string.
 862             my $sth =
 863               $dbh->prepare(
 864                 "select max(substring(borrowers.cardnumber,2,7)) from borrowers"
 865               );
 866             $sth->execute;
 867
 868             my $data = $sth->fetchrow_hashref;
 869             $cardnumber = $data->{'max(substring(borrowers.cardnumber,2,7))'};
 870             $sth->finish;
 871             if ( !$cardnumber ) {    # If DB has no values,
 872                 $cardnumber = 1000000;    # start at 1000000
 873             }
 874             else {
 875                 $cardnumber += 1;
 876             }
 877
 878             my $sum = 0;
 879             for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
 880
 881                 # read weightings, left to right, 1 char at a time
 882                 my $temp1 = $weightings[$i];
 883
 884                 # sequence left to right, 1 char at a time
 885                 my $temp2 = substr( $cardnumber, $i, 1 );
 886
 887                 # mult each char 1-7 by its corresponding weighting
 888                 $sum += $temp1 * $temp2;
 889             }
 890
 891             my $rem = ( $sum % 11 );
 892             $rem = 'X' if $rem == 10;
 893
 894             $cardnumber = "V$cardnumber$rem";
 895         }
 896         else {
 897
 898      # MODIFIED BY JF: mysql4.1 allows casting as an integer, which is probably
 899      # better. I'll leave the original in in case it needs to be changed for you
 900             my $sth =
 901               $dbh->prepare(
 902                 "select max(cast(cardnumber as signed)) from borrowers");
 903
 904       #my $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers");
 905
 906             $sth->execute;
 907
 908             my ($result) = $sth->fetchrow;
 909             $sth->finish;
 910             $cardnumber = $result + 1;
 911         }
 912     }
 913     return $cardnumber;
 914 }
 915
 916 =head2 GetGuarantees
 917
 918   ($num_children, $children_arrayref) = &GetGuarantees($parent_borrno);
 919   $child0_cardno = $children_arrayref->[0]{"cardnumber"};
 920   $child0_borrno = $children_arrayref->[0]{"borrowernumber"};
 921
 922 C<&GetGuarantees> takes a borrower number (e.g., that of a patron
 923 with children) and looks up the borrowers who are guaranteed by that
 924 borrower (i.e., the patron's children).
 925
 926 C<&GetGuarantees> returns two values: an integer giving the number of
 927 borrowers guaranteed by C<$parent_borrno>, and a reference to an array
 928 of references to hash, which gives the actual results.
 929
 930 =cut
 931
 932 #'
 933 sub GetGuarantees {
 934     my ($borrowernumber) = @_;
 935     my $dbh              = C4::Context->dbh;
 936     my $sth              =
 937       $dbh->prepare(
 938 "select cardnumber,borrowernumber, firstname, surname from borrowers where guarantorid=?"
 939       );
 940     $sth->execute($borrowernumber);
 941
 942     my @dat;
 943     my $data = $sth->fetchall_arrayref({});
 944     $sth->finish;
 945     return ( scalar(@$data), $data );
 946 }
 947
 948 =head2 UpdateGuarantees
 949
 950   &UpdateGuarantees($parent_borrno);
 951
 952
 953 C<&UpdateGuarantees> borrower data for an adulte and updates all the guarantees
 954 with the modified information
 955
 956 =cut
 957
 958 #'
 959 sub UpdateGuarantees {
 960     my (%data) = @_;
 961     my $dbh = C4::Context->dbh;
 962     my ( $count, $guarantees ) = GetGuarantees( $data{'borrowernumber'} );
 963     for ( my $i = 0 ; $i < $count ; $i++ ) {
 964
 965         # FIXME
 966         # It looks like the $i is only being returned to handle walking through
 967         # the array, which is probably better done as a foreach loop.
 968         #
 969         my $guaquery = qq|UPDATE borrowers
 970               SET address='$data{'address'}',fax='$data{'fax'}',
 971                   B_city='$data{'B_city'}',mobile='$data{'mobile'}',city='$data{'city'}',phone='$data{'phone'}'
 972               WHERE borrowernumber='$guarantees->[$i]->{'borrowernumber'}'
 973         |;
 974         my $sth3 = $dbh->prepare($guaquery);
 975         $sth3->execute;
 976         $sth3->finish;
 977     }
 978 }
 979 =head2 GetPendingIssues
 980
 981   ($count, $issues) = &GetPendingIssues($borrowernumber);
 982
 983 Looks up what the patron with the given borrowernumber has borrowed.
 984
 985 C<&GetPendingIssues> returns a two-element array. C<$issues> is a
 986 reference-to-array, where each element is a reference-to-hash; the
 987 keys are the fields from the C<issues>, C<biblio>, and C<items> tables
 988 in the Koha database. C<$count> is the number of elements in
 989 C<$issues>.
 990
 991 =cut
 992
 993 #'
 994 sub GetPendingIssues {
 995     my ($borrowernumber) = @_;
 996     my $dbh              = C4::Context->dbh;
 997
 998     my $sth              = $dbh->prepare(
 999    "SELECT *,issues.timestamp as timestamp FROM issues
1000       LEFT JOIN items ON issues.itemnumber=items.itemnumber
1001       LEFT JOIN biblio ON     items.biblionumber=biblio.biblionumber
1002       LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1003     WHERE
1004       borrowernumber=?
1005     ORDER BY issues.issuedate"
1006     );
1007     $sth->execute($borrowernumber);
1008     my $data = $sth->fetchall_arrayref({});
1009     my $today = POSIX::strftime("%Y%m%d", localtime);
1010     foreach( @$data ) {
1011         my $datedue = $_->{'date_due'};
1012         $datedue =~ s/-//g;
1013         if ( $datedue < $today ) {
1014             $_->{'overdue'} = 1;
1015         }
1016     }
1017     $sth->finish;
1018     return ( scalar(@$data), $data );
1019 }
1020
1021 =head2 GetAllIssues
1022
1023   ($count, $issues) = &GetAllIssues($borrowernumber, $sortkey, $limit);
1024
1025 Looks up what the patron with the given borrowernumber has borrowed,
1026 and sorts the results.
1027
1028 C<$sortkey> is the name of a field on which to sort the results. This
1029 should be the name of a field in the C<issues>, C<biblio>,
1030 C<biblioitems>, or C<items> table in the Koha database.
1031
1032 C<$limit> is the maximum number of results to return.
1033
1034 C<&GetAllIssues> returns a two-element array. C<$issues> is a
1035 reference-to-array, where each element is a reference-to-hash; the
1036 keys are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
1037 C<items> tables of the Koha database. C<$count> is the number of
1038 elements in C<$issues>
1039
1040 =cut
1041
1042 #'
1043 sub GetAllIssues {
1044     my ( $borrowernumber, $order, $limit ) = @_;
1045
1046     #FIXME: sanity-check order and limit
1047     my $dbh   = C4::Context->dbh;
1048     my $count = 0;
1049     my $query =
1050   "SELECT *,issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1051   FROM issues
1052   LEFT JOIN items on items.itemnumber=issues.itemnumber
1053   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1054   LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1055   WHERE borrowernumber=?
1056   UNION ALL
1057   SELECT *,old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1058   FROM old_issues
1059   LEFT JOIN items on items.itemnumber=old_issues.itemnumber
1060   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1061   LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1062   WHERE borrowernumber=?
1063   order by $order";
1064     if ( $limit != 0 ) {
1065         $query .= " limit $limit";
1066     }
1067
1068     #print $query;
1069     my $sth = $dbh->prepare($query);
1070     $sth->execute($borrowernumber, $borrowernumber);
1071     my @result;
1072     my $i = 0;
1073     while ( my $data = $sth->fetchrow_hashref ) {
1074         $result[$i] = $data;
1075         $i++;
1076         $count++;
1077     }
1078
1079     # get all issued items for borrowernumber from oldissues table
1080     # large chunk of older issues data put into table oldissues
1081     # to speed up db calls for issuing items
1082     if ( C4::Context->preference("ReadingHistory") ) {
1083         # FIXME oldissues (not to be confused with old_issues) is
1084         # apparently specific to HLT.  Not sure if the ReadingHistory
1085         # syspref is still required, as old_issues by design
1086         # is no longer checked with each loan.
1087         my $query2 = "SELECT * FROM oldissues
1088                       LEFT JOIN items ON items.itemnumber=oldissues.itemnumber
1089                       LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1090                       LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1091                       WHERE borrowernumber=?
1092                       ORDER BY $order";
1093         if ( $limit != 0 ) {
1094             $limit = $limit - $count;
1095             $query2 .= " limit $limit";
1096         }
1097
1098         my $sth2 = $dbh->prepare($query2);
1099         $sth2->execute($borrowernumber);
1100
1101         while ( my $data2 = $sth2->fetchrow_hashref ) {
1102             $result[$i] = $data2;
1103             $i++;
1104         }
1105         $sth2->finish;
1106     }
1107     $sth->finish;
1108
1109     return ( $i, \@result );
1110 }
1111
1112
1113 =head2 GetMemberAccountRecords
1114
1115   ($total, $acctlines, $count) = &GetMemberAccountRecords($borrowernumber);
1116
1117 Looks up accounting data for the patron with the given borrowernumber.
1118
1119 C<&GetMemberAccountRecords> returns a three-element array. C<$acctlines> is a
1120 reference-to-array, where each element is a reference-to-hash; the
1121 keys are the fields of the C<accountlines> table in the Koha database.
1122 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1123 total amount outstanding for all of the account lines.
1124
1125 =cut
1126
1127 #'
1128 sub GetMemberAccountRecords {
1129     my ($borrowernumber,$date) = @_;
1130     my $dbh = C4::Context->dbh;
1131     my @acctlines;
1132     my $numlines = 0;
1133     my $strsth      = qq(
1134                         SELECT *
1135                         FROM accountlines
1136                         WHERE borrowernumber=?);
1137     my @bind = ($borrowernumber);
1138     if ($date && $date ne ''){
1139             $strsth.=" AND date < ? ";
1140             push(@bind,$date);
1141     }
1142     $strsth.=" ORDER BY date desc,timestamp DESC";
1143     my $sth= $dbh->prepare( $strsth );
1144     $sth->execute( @bind );
1145     my $total = 0;
1146     while ( my $data = $sth->fetchrow_hashref ) {
1147                 my $biblio = GetBiblioFromItemNumber($data->{itemnumber}) if $data->{itemnumber};
1148                 $data->{biblionumber} = $biblio->{biblionumber};
1149         $acctlines[$numlines] = $data;
1150         $numlines++;
1151         $total += $data->{'amountoutstanding'};
1152     }
1153     $sth->finish;
1154     return ( $total, \@acctlines,$numlines);
1155 }
1156
1157 =head2 GetBorNotifyAcctRecord
1158
1159   ($count, $acctlines, $total) = &GetBorNotifyAcctRecord($params,$notifyid);
1160
1161 Looks up accounting data for the patron with the given borrowernumber per file number.
1162
1163 (FIXME - I'm not at all sure what this is about.)
1164
1165 C<&GetBorNotifyAcctRecord> returns a three-element array. C<$acctlines> is a
1166 reference-to-array, where each element is a reference-to-hash; the
1167 keys are the fields of the C<accountlines> table in the Koha database.
1168 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1169 total amount outstanding for all of the account lines.
1170
1171 =cut
1172
1173 sub GetBorNotifyAcctRecord {
1174     my ( $borrowernumber, $notifyid ) = @_;
1175     my $dbh = C4::Context->dbh;
1176     my @acctlines;
1177     my $numlines = 0;
1178     my $sth = $dbh->prepare(
1179             "SELECT *
1180                 FROM accountlines
1181                 WHERE borrowernumber=?
1182                     AND notify_id=?
1183                     AND amountoutstanding != '0'
1184                 ORDER BY notify_id,accounttype
1185                 ");
1186 #                    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')
1187
1188     $sth->execute( $borrowernumber, $notifyid );
1189     my $total = 0;
1190     while ( my $data = $sth->fetchrow_hashref ) {
1191         $acctlines[$numlines] = $data;
1192         $numlines++;
1193         $total += $data->{'amountoutstanding'};
1194     }
1195     $sth->finish;
1196     return ( $total, \@acctlines, $numlines );
1197 }
1198
1199 =head2 checkuniquemember (OUEST-PROVENCE)
1200
1201   ($result,$categorycode)  = &checkuniquemember($collectivity,$surname,$firstname,$dateofbirth);
1202
1203 Checks that a member exists or not in the database.
1204
1205 C<&result> is nonzero (=exist) or 0 (=does not exist)
1206 C<&categorycode> is from categorycode table
1207 C<&collectivity> is 1 (= we add a collectivity) or 0 (= we add a physical member)
1208 C<&surname> is the surname
1209 C<&firstname> is the firstname (only if collectivity=0)
1210 C<&dateofbirth> is the date of birth in ISO format (only if collectivity=0)
1211
1212 =cut
1213
1214 # FIXME: This function is not legitimate.  Multiple patrons might have the same first/last name and birthdate.
1215 # This is especially true since first name is not even a required field.
1216
1217 sub checkuniquemember {
1218     my ( $collectivity, $surname, $firstname, $dateofbirth ) = @_;
1219     my $dbh = C4::Context->dbh;
1220     my $request = ($collectivity) ?
1221         "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? " :
1222         "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=? and dateofbirth=? ";
1223     my $sth = $dbh->prepare($request);
1224     if ($collectivity) {
1225         $sth->execute( uc($surname) );
1226     } else {
1227         $sth->execute( uc($surname), ucfirst($firstname), $dateofbirth );
1228     }
1229     my @data = $sth->fetchrow;
1230     $sth->finish;
1231     ( $data[0] ) and return $data[0], $data[1];
1232     return 0;
1233 }
1234
1235 sub checkcardnumber {
1236     my ($cardnumber,$borrowernumber) = @_;
1237     my $dbh = C4::Context->dbh;
1238     my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
1239     $query .= " AND borrowernumber <> ?" if ($borrowernumber);
1240   my $sth = $dbh->prepare($query);
1241   if ($borrowernumber) {
1242    $sth->execute($cardnumber,$borrowernumber);
1243   } else {
1244      $sth->execute($cardnumber);
1245   }
1246     if (my $data= $sth->fetchrow_hashref()){
1247         return 1;
1248     }
1249     else {
1250         return 0;
1251     }
1252     $sth->finish();
1253 }
1254
1255
1256 =head2 getzipnamecity (OUEST-PROVENCE)
1257
1258 take all info from table city for the fields city and  zip
1259 check for the name and the zip code of the city selected
1260
1261 =cut
1262
1263 sub getzipnamecity {
1264     my ($cityid) = @_;
1265     my $dbh      = C4::Context->dbh;
1266     my $sth      =
1267       $dbh->prepare(
1268         "select city_name,city_zipcode from cities where cityid=? ");
1269     $sth->execute($cityid);
1270     my @data = $sth->fetchrow;
1271     return $data[0], $data[1];
1272 }
1273
1274
1275 =head2 getdcity (OUEST-PROVENCE)
1276
1277 recover cityid  with city_name condition
1278
1279 =cut
1280
1281 sub getidcity {
1282     my ($city_name) = @_;
1283     my $dbh = C4::Context->dbh;
1284     my $sth = $dbh->prepare("select cityid from cities where city_name=? ");
1285     $sth->execute($city_name);
1286     my $data = $sth->fetchrow;
1287     return $data;
1288 }
1289
1290
1291 =head2 GetExpiryDate
1292
1293   $expirydate = GetExpiryDate($categorycode, $dateenrolled);
1294
1295 Calculate expiry date given a categorycode and starting date.  Date argument must be in ISO format.
1296 Return date is also in ISO format.
1297
1298 =cut
1299
1300 sub GetExpiryDate {
1301     my ( $categorycode, $dateenrolled ) = @_;
1302     my $enrolmentperiod = 12;   # reasonable default
1303     if ($categorycode) {
1304         my $dbh = C4::Context->dbh;
1305         my $sth = $dbh->prepare("select enrolmentperiod from categories where categorycode=?");
1306         $sth->execute($categorycode);
1307         $enrolmentperiod = $sth->fetchrow;
1308     }
1309     # die "GetExpiryDate: for enrollmentperiod $enrolmentperiod (category '$categorycode') starting $dateenrolled.\n";
1310     my @date = split /-/,$dateenrolled;
1311     return sprintf("%04d-%02d-%02d", Add_Delta_YM(@date,0,$enrolmentperiod));
1312 }
1313
1314 =head2 checkuserpassword (OUEST-PROVENCE)
1315
1316 check for the password and login are not used
1317 return the number of record
1318 0=> NOT USED 1=> USED
1319
1320 =cut
1321
1322 sub checkuserpassword {
1323     my ( $borrowernumber, $userid, $password ) = @_;
1324     $password = md5_base64($password);
1325     my $dbh = C4::Context->dbh;
1326     my $sth =
1327       $dbh->prepare(
1328 "Select count(*) from borrowers where borrowernumber !=? and userid =? and password=? "
1329       );
1330     $sth->execute( $borrowernumber, $userid, $password );
1331     my $number_rows = $sth->fetchrow;
1332     return $number_rows;
1333
1334 }
1335
1336 =head2 GetborCatFromCatType
1337
1338   ($codes_arrayref, $labels_hashref) = &GetborCatFromCatType();
1339
1340 Looks up the different types of borrowers in the database. Returns two
1341 elements: a reference-to-array, which lists the borrower category
1342 codes, and a reference-to-hash, which maps the borrower category codes
1343 to category descriptions.
1344
1345 =cut
1346
1347 #'
1348 sub GetborCatFromCatType {
1349     my ( $category_type, $action ) = @_;
1350         # FIXME - This API  seems both limited and dangerous.
1351     my $dbh     = C4::Context->dbh;
1352     my $request = qq|   SELECT categorycode,description
1353             FROM categories
1354             $action
1355             ORDER BY categorycode|;
1356     my $sth = $dbh->prepare($request);
1357         if ($action) {
1358         $sth->execute($category_type);
1359     }
1360     else {
1361         $sth->execute();
1362     }
1363
1364     my %labels;
1365     my @codes;
1366
1367     while ( my $data = $sth->fetchrow_hashref ) {
1368         push @codes, $data->{'categorycode'};
1369         $labels{ $data->{'categorycode'} } = $data->{'description'};
1370     }
1371     $sth->finish;
1372     return ( \@codes, \%labels );
1373 }
1374
1375 =head2 GetBorrowercategory
1376
1377   $hashref = &GetBorrowercategory($categorycode);
1378
1379 Given the borrower's category code, the function returns the corresponding
1380 data hashref for a comprehensive information display.
1381
1382   $arrayref_hashref = &GetBorrowercategory;
1383 If no category code provided, the function returns all the categories.
1384
1385 =cut
1386
1387 sub GetBorrowercategory {
1388     my ($catcode) = @_;
1389     my $dbh       = C4::Context->dbh;
1390     if ($catcode){
1391         my $sth       =
1392         $dbh->prepare(
1393     "SELECT description,dateofbirthrequired,upperagelimit,category_type
1394     FROM categories
1395     WHERE categorycode = ?"
1396         );
1397         $sth->execute($catcode);
1398         my $data =
1399         $sth->fetchrow_hashref;
1400         $sth->finish();
1401         return $data;
1402     }
1403     return;
1404 }    # sub getborrowercategory
1405
1406 =head2 GetBorrowercategoryList
1407
1408   $arrayref_hashref = &GetBorrowercategoryList;
1409 If no category code provided, the function returns all the categories.
1410
1411 =cut
1412
1413 sub GetBorrowercategoryList {
1414     my $dbh       = C4::Context->dbh;
1415     my $sth       =
1416     $dbh->prepare(
1417     "SELECT *
1418     FROM categories
1419     ORDER BY description"
1420         );
1421     $sth->execute;
1422     my $data =
1423     $sth->fetchall_arrayref({});
1424     $sth->finish();
1425     return $data;
1426 }    # sub getborrowercategory
1427
1428 =head2 ethnicitycategories
1429
1430   ($codes_arrayref, $labels_hashref) = &ethnicitycategories();
1431
1432 Looks up the different ethnic types in the database. Returns two
1433 elements: a reference-to-array, which lists the ethnicity codes, and a
1434 reference-to-hash, which maps the ethnicity codes to ethnicity
1435 descriptions.
1436
1437 =cut
1438
1439 #'
1440
1441 sub ethnicitycategories {
1442     my $dbh = C4::Context->dbh;
1443     my $sth = $dbh->prepare("Select code,name from ethnicity order by name");
1444     $sth->execute;
1445     my %labels;
1446     my @codes;
1447     while ( my $data = $sth->fetchrow_hashref ) {
1448         push @codes, $data->{'code'};
1449         $labels{ $data->{'code'} } = $data->{'name'};
1450     }
1451     $sth->finish;
1452     return ( \@codes, \%labels );
1453 }
1454
1455 =head2 fixEthnicity
1456
1457   $ethn_name = &fixEthnicity($ethn_code);
1458
1459 Takes an ethnicity code (e.g., "european" or "pi") and returns the
1460 corresponding descriptive name from the C<ethnicity> table in the
1461 Koha database ("European" or "Pacific Islander").
1462
1463 =cut
1464
1465 #'
1466
1467 sub fixEthnicity {
1468     my $ethnicity = shift;
1469     return unless $ethnicity;
1470     my $dbh       = C4::Context->dbh;
1471     my $sth       = $dbh->prepare("Select name from ethnicity where code = ?");
1472     $sth->execute($ethnicity);
1473     my $data = $sth->fetchrow_hashref;
1474     $sth->finish;
1475     return $data->{'name'};
1476 }    # sub fixEthnicity
1477
1478 =head2 GetAge
1479
1480   $dateofbirth,$date = &GetAge($date);
1481
1482 this function return the borrowers age with the value of dateofbirth
1483
1484 =cut
1485
1486 #'
1487 sub GetAge{
1488     my ( $date, $date_ref ) = @_;
1489
1490     if ( not defined $date_ref ) {
1491         $date_ref = sprintf( '%04d-%02d-%02d', Today() );
1492     }
1493
1494     my ( $year1, $month1, $day1 ) = split /-/, $date;
1495     my ( $year2, $month2, $day2 ) = split /-/, $date_ref;
1496
1497     my $age = $year2 - $year1;
1498     if ( $month1 . $day1 > $month2 . $day2 ) {
1499         $age--;
1500     }
1501
1502     return $age;
1503 }    # sub get_age
1504
1505 =head2 get_institutions
1506   $insitutions = get_institutions();
1507
1508 Just returns a list of all the borrowers of type I, borrownumber and name
1509
1510 =cut
1511
1512 #'
1513 sub get_institutions {
1514     my $dbh = C4::Context->dbh();
1515     my $sth =
1516       $dbh->prepare(
1517 "SELECT borrowernumber,surname FROM borrowers WHERE categorycode=? ORDER BY surname"
1518       );
1519     $sth->execute('I');
1520     my %orgs;
1521     while ( my $data = $sth->fetchrow_hashref() ) {
1522         $orgs{ $data->{'borrowernumber'} } = $data;
1523     }
1524     $sth->finish();
1525     return ( \%orgs );
1526
1527 }    # sub get_institutions
1528
1529 =head2 add_member_orgs
1530
1531   add_member_orgs($borrowernumber,$borrowernumbers);
1532
1533 Takes a borrowernumber and a list of other borrowernumbers and inserts them into the borrowers_to_borrowers table
1534
1535 =cut
1536
1537 #'
1538 sub add_member_orgs {
1539     my ( $borrowernumber, $otherborrowers ) = @_;
1540     my $dbh   = C4::Context->dbh();
1541     my $query =
1542       "INSERT INTO borrowers_to_borrowers (borrower1,borrower2) VALUES (?,?)";
1543     my $sth = $dbh->prepare($query);
1544     foreach my $otherborrowernumber (@$otherborrowers) {
1545         $sth->execute( $borrowernumber, $otherborrowernumber );
1546     }
1547     $sth->finish();
1548
1549 }    # sub add_member_orgs
1550
1551 =head2 GetCities (OUEST-PROVENCE)
1552
1553   ($id_cityarrayref, $city_hashref) = &GetCities();
1554
1555 Looks up the different city and zip in the database. Returns two
1556 elements: a reference-to-array, which lists the zip city
1557 codes, and a reference-to-hash, which maps the name of the city.
1558 WHERE =>OUEST PROVENCE OR EXTERIEUR
1559
1560 =cut
1561
1562 sub GetCities {
1563
1564     #my ($type_city) = @_;
1565     my $dbh   = C4::Context->dbh;
1566     my $query = qq|SELECT cityid,city_zipcode,city_name
1567         FROM cities
1568         ORDER BY city_name|;
1569     my $sth = $dbh->prepare($query);
1570
1571     #$sth->execute($type_city);
1572     $sth->execute();
1573     my %city;
1574     my @id;
1575     #    insert empty value to create a empty choice in cgi popup
1576     push @id, " ";
1577     $city{""} = "";
1578     while ( my $data = $sth->fetchrow_hashref ) {
1579         push @id, $data->{'city_zipcode'}."|".$data->{'city_name'};
1580         $city{ $data->{'city_zipcode'}."|".$data->{'city_name'} } = $data->{'city_name'};
1581     }
1582
1583 #test to know if the table contain some records if no the function return nothing
1584     my $id = @id;
1585     $sth->finish;
1586     if ( $id == 1 ) {
1587         # all we have is the one blank row
1588         return ();
1589     }
1590     else {
1591         unshift( @id, "" );
1592         return ( \@id, \%city );
1593     }
1594 }
1595
1596 =head2 GetSortDetails (OUEST-PROVENCE)
1597
1598   ($lib) = &GetSortDetails($category,$sortvalue);
1599
1600 Returns the authorized value  details
1601 C<&$lib>return value of authorized value details
1602 C<&$sortvalue>this is the value of authorized value
1603 C<&$category>this is the value of authorized value category
1604
1605 =cut
1606
1607 sub GetSortDetails {
1608     my ( $category, $sortvalue ) = @_;
1609     my $dbh   = C4::Context->dbh;
1610     my $query = qq|SELECT lib
1611         FROM authorised_values
1612         WHERE category=?
1613         AND authorised_value=? |;
1614     my $sth = $dbh->prepare($query);
1615     $sth->execute( $category, $sortvalue );
1616     my $lib = $sth->fetchrow;
1617     return ($lib) if ($lib);
1618     return ($sortvalue) unless ($lib);
1619 }
1620
1621 =head2 DeleteBorrower
1622
1623   () = &DeleteBorrower($member);
1624
1625 delete all data fo borrowers and add record to deletedborrowers table
1626 C<&$member>this is the borrowernumber
1627
1628 =cut
1629
1630 sub MoveMemberToDeleted {
1631     my ($member) = @_;
1632     my $dbh = C4::Context->dbh;
1633     my $query;
1634     $query = qq|SELECT *
1635           FROM borrowers
1636           WHERE borrowernumber=?|;
1637     my $sth = $dbh->prepare($query);
1638     $sth->execute($member);
1639     my @data = $sth->fetchrow_array;
1640     $sth->finish;
1641     $sth =
1642       $dbh->prepare( "INSERT INTO deletedborrowers VALUES ("
1643           . ( "?," x ( scalar(@data) - 1 ) )
1644           . "?)" );
1645     $sth->execute(@data);
1646     $sth->finish;
1647 }
1648
1649 =head2 DelMember
1650
1651 DelMember($borrowernumber);
1652
1653 This function remove directly a borrower whitout writing it on deleteborrower.
1654 + Deletes reserves for the borrower
1655
1656 =cut
1657
1658 sub DelMember {
1659     my $dbh            = C4::Context->dbh;
1660     my $borrowernumber = shift;
1661     #warn "in delmember with $borrowernumber";
1662     return unless $borrowernumber;    # borrowernumber is mandatory.
1663
1664     my $query = qq|DELETE
1665           FROM  reserves
1666           WHERE borrowernumber=?|;
1667     my $sth = $dbh->prepare($query);
1668     $sth->execute($borrowernumber);
1669     $sth->finish;
1670     $query = "
1671        DELETE
1672        FROM borrowers
1673        WHERE borrowernumber = ?
1674    ";
1675     $sth = $dbh->prepare($query);
1676     $sth->execute($borrowernumber);
1677     $sth->finish;
1678     logaction("MEMBERS", "DELETE", $borrowernumber, "") if C4::Context->preference("BorrowersLog");
1679     return $sth->rows;
1680 }
1681
1682 =head2 ExtendMemberSubscriptionTo (OUEST-PROVENCE)
1683
1684     $date = ExtendMemberSubscriptionTo($borrowerid, $date);
1685
1686 Extending the subscription to a given date or to the expiry date calculated on ISO date.
1687 Returns ISO date.
1688
1689 =cut
1690
1691 sub ExtendMemberSubscriptionTo {
1692     my ( $borrowerid,$date) = @_;
1693     my $dbh = C4::Context->dbh;
1694     my $borrower = GetMember($borrowerid,'borrowernumber');
1695     unless ($date){
1696       $date=POSIX::strftime("%Y-%m-%d",localtime());
1697       my $borrower = GetMember($borrowerid,'borrowernumber');
1698       $date = GetExpiryDate( $borrower->{'categorycode'}, $date );
1699     }
1700     my $sth = $dbh->do(<<EOF);
1701 UPDATE borrowers
1702 SET  dateexpiry='$date'
1703 WHERE borrowernumber='$borrowerid'
1704 EOF
1705     # add enrolmentfee if needed
1706     $sth = $dbh->prepare("SELECT enrolmentfee FROM categories WHERE categorycode=?");
1707     $sth->execute($borrower->{'categorycode'});
1708     my ($enrolmentfee) = $sth->fetchrow;
1709     if ($enrolmentfee) {
1710         # insert fee in patron debts
1711         manualinvoice($borrower->{'borrowernumber'}, '', '', 'A', $enrolmentfee);
1712     }
1713     return $date if ($sth);
1714     return 0;
1715 }
1716
1717 =head2 GetRoadTypes (OUEST-PROVENCE)
1718
1719   ($idroadtypearrayref, $roadttype_hashref) = &GetRoadTypes();
1720
1721 Looks up the different road type . Returns two
1722 elements: a reference-to-array, which lists the id_roadtype
1723 codes, and a reference-to-hash, which maps the road type of the road .
1724
1725 =cut
1726
1727 sub GetRoadTypes {
1728     my $dbh   = C4::Context->dbh;
1729     my $query = qq|
1730 SELECT roadtypeid,road_type
1731 FROM roadtype
1732 ORDER BY road_type|;
1733     my $sth = $dbh->prepare($query);
1734     $sth->execute();
1735     my %roadtype;
1736     my @id;
1737
1738     #    insert empty value to create a empty choice in cgi popup
1739
1740     while ( my $data = $sth->fetchrow_hashref ) {
1741
1742         push @id, $data->{'roadtypeid'};
1743         $roadtype{ $data->{'roadtypeid'} } = $data->{'road_type'};
1744     }
1745
1746 #test to know if the table contain some records if no the function return nothing
1747     my $id = @id;
1748     $sth->finish;
1749     if ( $id eq 0 ) {
1750         return ();
1751     }
1752     else {
1753         unshift( @id, "" );
1754         return ( \@id, \%roadtype );
1755     }
1756 }
1757
1758
1759
1760 =head2 GetTitles (OUEST-PROVENCE)
1761
1762   ($borrowertitle)= &GetTitles();
1763
1764 Looks up the different title . Returns array  with all borrowers title
1765
1766 =cut
1767
1768 sub GetTitles {
1769     my @borrowerTitle = split /,|\|/,C4::Context->preference('BorrowersTitles');
1770     unshift( @borrowerTitle, "" );
1771     my $count=@borrowerTitle;
1772     if ($count == 1){
1773         return ();
1774     }
1775     else {
1776         return ( \@borrowerTitle);
1777     }
1778 }
1779
1780 =head2 GetPatronImage
1781
1782     my ($imagedata, $dberror) = GetPatronImage($cardnumber);
1783
1784 Returns the mimetype and binary image data of the image for the patron with the supplied cardnumber.
1785
1786 =cut
1787
1788 sub GetPatronImage {
1789     my ($cardnumber) = @_;
1790     warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1791     my $dbh = C4::Context->dbh;
1792     my $query = 'SELECT mimetype, imagefile FROM patronimage WHERE cardnumber = ?';
1793     my $sth = $dbh->prepare($query);
1794     $sth->execute($cardnumber);
1795     my $imagedata = $sth->fetchrow_hashref;
1796     my $dberror = $sth->errstr;
1797     warn "Database error!" if $sth->errstr;
1798     $sth->finish;
1799     return $imagedata, $dberror;
1800 }
1801
1802 =head2 PutPatronImage
1803
1804     PutPatronImage($cardnumber, $mimetype, $imgfile);
1805
1806 Stores patron binary image data and mimetype in database.
1807 NOTE: This function is good for updating images as well as inserting new images in the database.
1808
1809 =cut
1810
1811 sub PutPatronImage {
1812     my ($cardnumber, $mimetype, $imgfile) = @_;
1813     warn "Parameters passed in: Cardnumber=$cardnumber, Mimetype=$mimetype, " . ($imgfile ? "Imagefile" : "No Imagefile") if $debug;
1814     my $dbh = C4::Context->dbh;
1815     my $query = "INSERT INTO patronimage (cardnumber, mimetype, imagefile) VALUES (?,?,?) ON DUPLICATE KEY UPDATE imagefile = ?;";
1816     my $sth = $dbh->prepare($query);
1817     $sth->execute($cardnumber,$mimetype,$imgfile,$imgfile);
1818     warn "Error returned inserting $cardnumber.$mimetype." if $sth->errstr;
1819     my $dberror = $sth->errstr;
1820     $sth->finish;
1821     return $dberror;
1822 }
1823
1824 =head2 RmPatronImage
1825
1826     my ($dberror) = RmPatronImage($cardnumber);
1827
1828 Removes the image for the patron with the supplied cardnumber.
1829
1830 =cut
1831
1832 sub RmPatronImage {
1833     my ($cardnumber) = @_;
1834     warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1835     my $dbh = C4::Context->dbh;
1836     my $query = "DELETE FROM patronimage WHERE cardnumber = ?;";
1837     my $sth = $dbh->prepare($query);
1838     $sth->execute($cardnumber);
1839     my $dberror = $sth->errstr;
1840     warn "Database error!" if $sth->errstr;
1841     $sth->finish;
1842     return $dberror;
1843 }
1844
1845 =head2 GetRoadTypeDetails (OUEST-PROVENCE)
1846
1847   ($roadtype) = &GetRoadTypeDetails($roadtypeid);
1848
1849 Returns the description of roadtype
1850 C<&$roadtype>return description of road type
1851 C<&$roadtypeid>this is the value of roadtype s
1852
1853 =cut
1854
1855 sub GetRoadTypeDetails {
1856     my ($roadtypeid) = @_;
1857     my $dbh          = C4::Context->dbh;
1858     my $query        = qq|
1859 SELECT road_type
1860 FROM roadtype
1861 WHERE roadtypeid=?|;
1862     my $sth = $dbh->prepare($query);
1863     $sth->execute($roadtypeid);
1864     my $roadtype = $sth->fetchrow;
1865     return ($roadtype);
1866 }
1867
1868 =head2 GetBorrowersWhoHaveNotBorrowedSince
1869
1870 &GetBorrowersWhoHaveNotBorrowedSince($date)
1871
1872 this function get all borrowers who haven't borrowed since the date given on input arg.
1873
1874 =cut
1875
1876 sub GetBorrowersWhoHaveNotBorrowedSince {
1877 ### 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.
1878
1879                 my $filterdate = shift||POSIX::strftime("%Y-%m-%d",localtime());
1880     my $filterbranch = shift ||
1881                         ((C4::Context->preference('IndependantBranches')
1882                              && C4::Context->userenv
1883                              && C4::Context->userenv->{flags}!=1
1884                              && C4::Context->userenv->{branch})
1885                          ? C4::Context->userenv->{branch}
1886                          : "");
1887     my $dbh   = C4::Context->dbh;
1888     my $query = "
1889         SELECT borrowers.borrowernumber,max(issues.timestamp) as latestissue
1890         FROM   borrowers
1891         JOIN   categories USING (categorycode)
1892         LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
1893         WHERE  category_type <> 'S'
1894    ";
1895     my @query_params;
1896     if ($filterbranch && $filterbranch ne ""){
1897         $query.=" AND borrowers.branchcode= ?";
1898         push @query_params,$filterbranch;
1899     }
1900     $query.=" GROUP BY borrowers.borrowernumber";
1901     if ($filterdate){
1902         $query.=" HAVING latestissue <? OR latestissue IS NULL";
1903         push @query_params,$filterdate;
1904     }
1905     warn $query if $debug;
1906     my $sth = $dbh->prepare($query);
1907     if (scalar(@query_params)>0){
1908         $sth->execute(@query_params);
1909     }
1910     else {
1911         $sth->execute;
1912     }
1913
1914     my @results;
1915     while ( my $data = $sth->fetchrow_hashref ) {
1916         push @results, $data;
1917     }
1918     return \@results;
1919 }
1920
1921 =head2 GetBorrowersWhoHaveNeverBorrowed
1922
1923 $results = &GetBorrowersWhoHaveNeverBorrowed
1924
1925 this function get all borrowers who have never borrowed.
1926
1927 I<$result> is a ref to an array which all elements are a hasref.
1928
1929 =cut
1930
1931 sub GetBorrowersWhoHaveNeverBorrowed {
1932     my $filterbranch = shift ||
1933                         ((C4::Context->preference('IndependantBranches')
1934                              && C4::Context->userenv
1935                              && C4::Context->userenv->{flags}!=1
1936                              && C4::Context->userenv->{branch})
1937                          ? C4::Context->userenv->{branch}
1938                          : "");
1939     my $dbh   = C4::Context->dbh;
1940     my $query = "
1941         SELECT borrowers.borrowernumber,max(timestamp) as latestissue
1942         FROM   borrowers
1943           LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
1944         WHERE issues.borrowernumber IS NULL
1945    ";
1946     my @query_params;
1947     if ($filterbranch && $filterbranch ne ""){
1948         $query.=" AND borrowers.branchcode= ?";
1949         push @query_params,$filterbranch;
1950     }
1951     warn $query if $debug;
1952
1953     my $sth = $dbh->prepare($query);
1954     if (scalar(@query_params)>0){
1955         $sth->execute(@query_params);
1956     }
1957     else {
1958         $sth->execute;
1959     }
1960
1961     my @results;
1962     while ( my $data = $sth->fetchrow_hashref ) {
1963         push @results, $data;
1964     }
1965     return \@results;
1966 }
1967
1968 =head2 GetBorrowersWithIssuesHistoryOlderThan
1969
1970 $results = &GetBorrowersWithIssuesHistoryOlderThan($date)
1971
1972 this function get all borrowers who has an issue history older than I<$date> given on input arg.
1973
1974 I<$result> is a ref to an array which all elements are a hashref.
1975 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
1976
1977 =cut
1978
1979 sub GetBorrowersWithIssuesHistoryOlderThan {
1980     my $dbh  = C4::Context->dbh;
1981     my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime());
1982     my $filterbranch = shift ||
1983                         ((C4::Context->preference('IndependantBranches')
1984                              && C4::Context->userenv
1985                              && C4::Context->userenv->{flags}!=1
1986                              && C4::Context->userenv->{branch})
1987                          ? C4::Context->userenv->{branch}
1988                          : "");
1989     my $query = "
1990        SELECT count(borrowernumber) as n,borrowernumber
1991        FROM old_issues
1992        WHERE returndate < ?
1993          AND borrowernumber IS NOT NULL
1994     ";
1995     my @query_params;
1996     push @query_params, $date;
1997     if ($filterbranch){
1998         $query.="   AND branchcode = ?";
1999         push @query_params, $filterbranch;
2000     }
2001     $query.=" GROUP BY borrowernumber ";
2002     warn $query if $debug;
2003     my $sth = $dbh->prepare($query);
2004     $sth->execute(@query_params);
2005     my @results;
2006
2007     while ( my $data = $sth->fetchrow_hashref ) {
2008         push @results, $data;
2009     }
2010     return \@results;
2011 }
2012
2013 =head2 GetBorrowersNamesAndLatestIssue
2014
2015 $results = &GetBorrowersNamesAndLatestIssueList(@borrowernumbers)
2016
2017 this function get borrowers Names and surnames and Issue information.
2018
2019 I<@borrowernumbers> is an array which all elements are borrowernumbers.
2020 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
2021
2022 =cut
2023
2024 sub GetBorrowersNamesAndLatestIssue {
2025     my $dbh  = C4::Context->dbh;
2026     my @borrowernumbers=@_;
2027     my $query = "
2028        SELECT surname,lastname, phone, email,max(timestamp)
2029        FROM borrowers
2030          LEFT JOIN issues ON borrowers.borrowernumber=issues.borrowernumber
2031        GROUP BY borrowernumber
2032    ";
2033     my $sth = $dbh->prepare($query);
2034     $sth->execute;
2035     my $results = $sth->fetchall_arrayref({});
2036     return $results;
2037 }
2038
2039 =head2 DebarMember
2040
2041 =over 4
2042
2043 my $success = DebarMember( $borrowernumber );
2044
2045 marks a Member as debarred, and therefore unable to checkout any more
2046 items.
2047
2048 return :
2049 true on success, false on failure
2050
2051 =back
2052
2053 =cut
2054
2055 sub DebarMember {
2056     my $borrowernumber = shift;
2057
2058     return unless defined $borrowernumber;
2059     return unless $borrowernumber =~ /^\d+$/;
2060
2061     return ModMember( borrowernumber => $borrowernumber,
2062                       debarred       => 1 );
2063
2064 }
2065
2066 END { }    # module clean-up code here (global destructor)
2067
2068 1;
2069
2070 __END__
2071
2072 =head1 AUTHOR
2073
2074 Koha Team
2075
2076 =cut