C4/Members.pm

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