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