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