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