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