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      # MODIFIED BY JF: mysql4.1 allows casting as an integer, which is probably
 900      # better. I'll leave the original in in case it needs to be changed for you
 901      # my $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers");
 902         my $sth = $dbh->prepare(
 903             "select max(cast(cardnumber as signed)) from borrowers"
 904         );
 905         $sth->execute;
 906         my ($result) = $sth->fetchrow;
 907         return $result + 1;
 908     }
 909     return $cardnumber;     # just here as a fallback/reminder
 910 }
 911
 912 =head2 GetGuarantees
 913
 914   ($num_children, $children_arrayref) = &GetGuarantees($parent_borrno);
 915   $child0_cardno = $children_arrayref->[0]{"cardnumber"};
 916   $child0_borrno = $children_arrayref->[0]{"borrowernumber"};
 917
 918 C<&GetGuarantees> takes a borrower number (e.g., that of a patron
 919 with children) and looks up the borrowers who are guaranteed by that
 920 borrower (i.e., the patron's children).
 921
 922 C<&GetGuarantees> returns two values: an integer giving the number of
 923 borrowers guaranteed by C<$parent_borrno>, and a reference to an array
 924 of references to hash, which gives the actual results.
 925
 926 =cut
 927
 928 #'
 929 sub GetGuarantees {
 930     my ($borrowernumber) = @_;
 931     my $dbh              = C4::Context->dbh;
 932     my $sth              =
 933       $dbh->prepare(
 934 "select cardnumber,borrowernumber, firstname, surname from borrowers where guarantorid=?"
 935       );
 936     $sth->execute($borrowernumber);
 937
 938     my @dat;
 939     my $data = $sth->fetchall_arrayref({});
 940     return ( scalar(@$data), $data );
 941 }
 942
 943 =head2 UpdateGuarantees
 944
 945   &UpdateGuarantees($parent_borrno);
 946
 947
 948 C<&UpdateGuarantees> borrower data for an adult and updates all the guarantees
 949 with the modified information
 950
 951 =cut
 952
 953 #'
 954 sub UpdateGuarantees {
 955     my %data = shift;
 956     my $dbh = C4::Context->dbh;
 957     my ( $count, $guarantees ) = GetGuarantees( $data{'borrowernumber'} );
 958     foreach my $guarantee (@$guarantees){
 959         my $guaquery = qq|UPDATE borrowers
 960               SET address=?,fax=?,B_city=?,mobile=?,city=?,phone=?
 961               WHERE borrowernumber=?
 962         |;
 963         my $sth = $dbh->prepare($guaquery);
 964         $sth->execute($data{'address'},$data{'fax'},$data{'B_city'},$data{'mobile'},$data{'city'},$data{'phone'},$guarantee->{'borrowernumber'});
 965     }
 966 }
 967 =head2 GetPendingIssues
 968
 969   my $issues = &GetPendingIssues(@borrowernumber);
 970
 971 Looks up what the patron with the given borrowernumber has borrowed.
 972
 973 C<&GetPendingIssues> returns a
 974 reference-to-array where each element is a reference-to-hash; the
 975 keys are the fields from the C<issues>, C<biblio>, and C<items> tables.
 976 The keys include C<biblioitems> fields except marc and marcxml.
 977
 978 =cut
 979
 980 #'
 981 sub GetPendingIssues {
 982     my @borrowernumbers = @_;
 983
 984     unless (@borrowernumbers ) { # return a ref_to_array
 985         return \@borrowernumbers; # to not cause surprise to caller
 986     }
 987
 988     # Borrowers part of the query
 989     my $bquery = '';
 990     for (my $i = 0; $i < @borrowernumbers; $i++) {
 991         $bquery .= ' issues.borrowernumber = ?';
 992         if ($i < $#borrowernumbers ) {
 993             $bquery .= ' OR';
 994         }
 995     }
 996
 997     # must avoid biblioitems.* to prevent large marc and marcxml fields from killing performance
 998     # FIXME: namespace collision: each table has "timestamp" fields.  Which one is "timestamp" ?
 999     # FIXME: circ/ciculation.pl tries to sort by timestamp!
1000     # FIXME: namespace collision: other collisions possible.
1001     # FIXME: most of this data isn't really being used by callers.
1002     my $query =
1003    "SELECT issues.*,
1004             items.*,
1005            biblio.*,
1006            biblioitems.volume,
1007            biblioitems.number,
1008            biblioitems.itemtype,
1009            biblioitems.isbn,
1010            biblioitems.issn,
1011            biblioitems.publicationyear,
1012            biblioitems.publishercode,
1013            biblioitems.volumedate,
1014            biblioitems.volumedesc,
1015            biblioitems.lccn,
1016            biblioitems.url,
1017            borrowers.firstname,
1018            borrowers.surname,
1019            borrowers.cardnumber,
1020            issues.timestamp AS timestamp,
1021            issues.renewals  AS renewals,
1022            issues.borrowernumber AS borrowernumber,
1023             items.renewals  AS totalrenewals
1024     FROM   issues
1025     LEFT JOIN items       ON items.itemnumber       =      issues.itemnumber
1026     LEFT JOIN biblio      ON items.biblionumber     =      biblio.biblionumber
1027     LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
1028     LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
1029     WHERE
1030       $bquery
1031     ORDER BY issues.issuedate"
1032     ;
1033
1034     my $sth = C4::Context->dbh->prepare($query);
1035     $sth->execute(@borrowernumbers);
1036     my $data = $sth->fetchall_arrayref({});
1037     my $tz = C4::Context->tz();
1038     my $today = DateTime->now( time_zone => $tz);
1039     foreach (@{$data}) {
1040         if ($_->{issuedate}) {
1041             $_->{issuedate} = dt_from_string($_->{issuedate}, 'sql');
1042         }
1043         $_->{date_due} or next;
1044         $_->{date_due} = DateTime::Format::DateParse->parse_datetime($_->{date_due}, $tz->name());
1045         if ( DateTime->compare($_->{date_due}, $today) == -1 ) {
1046             $_->{overdue} = 1;
1047         }
1048     }
1049     return $data;
1050 }
1051
1052 =head2 GetAllIssues
1053
1054   $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
1055
1056 Looks up what the patron with the given borrowernumber has borrowed,
1057 and sorts the results.
1058
1059 C<$sortkey> is the name of a field on which to sort the results. This
1060 should be the name of a field in the C<issues>, C<biblio>,
1061 C<biblioitems>, or C<items> table in the Koha database.
1062
1063 C<$limit> is the maximum number of results to return.
1064
1065 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
1066 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
1067 C<items> tables of the Koha database.
1068
1069 =cut
1070
1071 #'
1072 sub GetAllIssues {
1073     my ( $borrowernumber, $order, $limit ) = @_;
1074
1075     #FIXME: sanity-check order and limit
1076     my $dbh   = C4::Context->dbh;
1077     my $query =
1078   "SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1079   FROM issues
1080   LEFT JOIN items on items.itemnumber=issues.itemnumber
1081   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1082   LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1083   WHERE borrowernumber=?
1084   UNION ALL
1085   SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1086   FROM old_issues
1087   LEFT JOIN items on items.itemnumber=old_issues.itemnumber
1088   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1089   LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1090   WHERE borrowernumber=? AND old_issues.itemnumber IS NOT NULL
1091   order by $order";
1092     if ( $limit != 0 ) {
1093         $query .= " limit $limit";
1094     }
1095
1096     my $sth = $dbh->prepare($query);
1097     $sth->execute($borrowernumber, $borrowernumber);
1098     my @result;
1099     my $i = 0;
1100     while ( my $data = $sth->fetchrow_hashref ) {
1101         push @result, $data;
1102     }
1103
1104     return \@result;
1105 }
1106
1107
1108 =head2 GetMemberAccountRecords
1109
1110   ($total, $acctlines, $count) = &GetMemberAccountRecords($borrowernumber);
1111
1112 Looks up accounting data for the patron with the given borrowernumber.
1113
1114 C<&GetMemberAccountRecords> returns a three-element array. C<$acctlines> is a
1115 reference-to-array, where each element is a reference-to-hash; the
1116 keys are the fields of the C<accountlines> table in the Koha database.
1117 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1118 total amount outstanding for all of the account lines.
1119
1120 =cut
1121
1122 #'
1123 sub GetMemberAccountRecords {
1124     my ($borrowernumber,$date) = @_;
1125     my $dbh = C4::Context->dbh;
1126     my @acctlines;
1127     my $numlines = 0;
1128     my $strsth      = qq(
1129                         SELECT *
1130                         FROM accountlines
1131                         WHERE borrowernumber=?);
1132     my @bind = ($borrowernumber);
1133     if ($date && $date ne ''){
1134             $strsth.=" AND date < ? ";
1135             push(@bind,$date);
1136     }
1137     $strsth.=" ORDER BY date desc,timestamp DESC";
1138     my $sth= $dbh->prepare( $strsth );
1139     $sth->execute( @bind );
1140     my $total = 0;
1141     while ( my $data = $sth->fetchrow_hashref ) {
1142         if ( $data->{itemnumber} ) {
1143             my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
1144             $data->{biblionumber} = $biblio->{biblionumber};
1145             $data->{title}        = $biblio->{title};
1146         }
1147         $acctlines[$numlines] = $data;
1148         $numlines++;
1149         $total += int(1000 * $data->{'amountoutstanding'}); # convert float to integer to avoid round-off errors
1150     }
1151     $total /= 1000;
1152     return ( $total, \@acctlines,$numlines);
1153 }
1154
1155 =head2 GetBorNotifyAcctRecord
1156
1157   ($total, $acctlines, $count) = &GetBorNotifyAcctRecord($params,$notifyid);
1158
1159 Looks up accounting data for the patron with the given borrowernumber per file number.
1160
1161 C<&GetBorNotifyAcctRecord> returns a three-element array. C<$acctlines> is a
1162 reference-to-array, where each element is a reference-to-hash; the
1163 keys are the fields of the C<accountlines> table in the Koha database.
1164 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1165 total amount outstanding for all of the account lines.
1166
1167 =cut
1168
1169 sub GetBorNotifyAcctRecord {
1170     my ( $borrowernumber, $notifyid ) = @_;
1171     my $dbh = C4::Context->dbh;
1172     my @acctlines;
1173     my $numlines = 0;
1174     my $sth = $dbh->prepare(
1175             "SELECT *
1176                 FROM accountlines
1177                 WHERE borrowernumber=?
1178                     AND notify_id=?
1179                     AND amountoutstanding != '0'
1180                 ORDER BY notify_id,accounttype
1181                 ");
1182
1183     $sth->execute( $borrowernumber, $notifyid );
1184     my $total = 0;
1185     while ( my $data = $sth->fetchrow_hashref ) {
1186         if ( $data->{itemnumber} ) {
1187             my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
1188             $data->{biblionumber} = $biblio->{biblionumber};
1189             $data->{title}        = $biblio->{title};
1190         }
1191         $acctlines[$numlines] = $data;
1192         $numlines++;
1193         $total += int(100 * $data->{'amountoutstanding'});
1194     }
1195     $total /= 100;
1196     return ( $total, \@acctlines, $numlines );
1197 }
1198
1199 =head2 checkuniquemember (OUEST-PROVENCE)
1200
1201   ($result,$categorycode)  = &checkuniquemember($collectivity,$surname,$firstname,$dateofbirth);
1202
1203 Checks that a member exists or not in the database.
1204
1205 C<&result> is nonzero (=exist) or 0 (=does not exist)
1206 C<&categorycode> is from categorycode table
1207 C<&collectivity> is 1 (= we add a collectivity) or 0 (= we add a physical member)
1208 C<&surname> is the surname
1209 C<&firstname> is the firstname (only if collectivity=0)
1210 C<&dateofbirth> is the date of birth in ISO format (only if collectivity=0)
1211
1212 =cut
1213
1214 # FIXME: This function is not legitimate.  Multiple patrons might have the same first/last name and birthdate.
1215 # This is especially true since first name is not even a required field.
1216
1217 sub checkuniquemember {
1218     my ( $collectivity, $surname, $firstname, $dateofbirth ) = @_;
1219     my $dbh = C4::Context->dbh;
1220     my $request = ($collectivity) ?
1221         "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? " :
1222             ($dateofbirth) ?
1223             "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=?  and dateofbirth=?" :
1224             "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=?";
1225     my $sth = $dbh->prepare($request);
1226     if ($collectivity) {
1227         $sth->execute( uc($surname) );
1228     } elsif($dateofbirth){
1229         $sth->execute( uc($surname), ucfirst($firstname), $dateofbirth );
1230     }else{
1231         $sth->execute( uc($surname), ucfirst($firstname));
1232     }
1233     my @data = $sth->fetchrow;
1234     ( $data[0] ) and return $data[0], $data[1];
1235     return 0;
1236 }
1237
1238 sub checkcardnumber {
1239     my ($cardnumber,$borrowernumber) = @_;
1240     # If cardnumber is null, we assume they're allowed.
1241     return 0 if !defined($cardnumber);
1242     my $dbh = C4::Context->dbh;
1243     my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
1244     $query .= " AND borrowernumber <> ?" if ($borrowernumber);
1245   my $sth = $dbh->prepare($query);
1246   if ($borrowernumber) {
1247    $sth->execute($cardnumber,$borrowernumber);
1248   } else {
1249      $sth->execute($cardnumber);
1250   }
1251     if (my $data= $sth->fetchrow_hashref()){
1252         return 1;
1253     }
1254     else {
1255         return 0;
1256     }
1257 }
1258
1259
1260 =head2 getzipnamecity (OUEST-PROVENCE)
1261
1262 take all info from table city for the fields city and  zip
1263 check for the name and the zip code of the city selected
1264
1265 =cut
1266
1267 sub getzipnamecity {
1268     my ($cityid) = @_;
1269     my $dbh      = C4::Context->dbh;
1270     my $sth      =
1271       $dbh->prepare(
1272         "select city_name,city_state,city_zipcode,city_country from cities where cityid=? ");
1273     $sth->execute($cityid);
1274     my @data = $sth->fetchrow;
1275     return $data[0], $data[1], $data[2], $data[3];
1276 }
1277
1278
1279 =head2 getdcity (OUEST-PROVENCE)
1280
1281 recover cityid  with city_name condition
1282
1283 =cut
1284
1285 sub getidcity {
1286     my ($city_name) = @_;
1287     my $dbh = C4::Context->dbh;
1288     my $sth = $dbh->prepare("select cityid from cities where city_name=? ");
1289     $sth->execute($city_name);
1290     my $data = $sth->fetchrow;
1291     return $data;
1292 }
1293
1294 =head2 GetFirstValidEmailAddress
1295
1296   $email = GetFirstValidEmailAddress($borrowernumber);
1297
1298 Return the first valid email address for a borrower, given the borrowernumber.  For now, the order
1299 is defined as email, emailpro, B_email.  Returns the empty string if the borrower has no email
1300 addresses.
1301
1302 =cut
1303
1304 sub GetFirstValidEmailAddress {
1305     my $borrowernumber = shift;
1306     my $dbh = C4::Context->dbh;
1307     my $sth = $dbh->prepare( "SELECT email, emailpro, B_email FROM borrowers where borrowernumber = ? ");
1308     $sth->execute( $borrowernumber );
1309     my $data = $sth->fetchrow_hashref;
1310
1311     if ($data->{'email'}) {
1312        return $data->{'email'};
1313     } elsif ($data->{'emailpro'}) {
1314        return $data->{'emailpro'};
1315     } elsif ($data->{'B_email'}) {
1316        return $data->{'B_email'};
1317     } else {
1318        return '';
1319     }
1320 }
1321
1322 =head2 GetExpiryDate
1323
1324   $expirydate = GetExpiryDate($categorycode, $dateenrolled);
1325
1326 Calculate expiry date given a categorycode and starting date.  Date argument must be in ISO format.
1327 Return date is also in ISO format.
1328
1329 =cut
1330
1331 sub GetExpiryDate {
1332     my ( $categorycode, $dateenrolled ) = @_;
1333     my $enrolments;
1334     if ($categorycode) {
1335         my $dbh = C4::Context->dbh;
1336         my $sth = $dbh->prepare("SELECT enrolmentperiod,enrolmentperioddate FROM categories WHERE categorycode=?");
1337         $sth->execute($categorycode);
1338         $enrolments = $sth->fetchrow_hashref;
1339     }
1340     # die "GetExpiryDate: for enrollmentperiod $enrolmentperiod (category '$categorycode') starting $dateenrolled.\n";
1341     my @date = split (/-/,$dateenrolled);
1342     if($enrolments->{enrolmentperiod}){
1343         return sprintf("%04d-%02d-%02d", Add_Delta_YM(@date,0,$enrolments->{enrolmentperiod}));
1344     }else{
1345         return $enrolments->{enrolmentperioddate};
1346     }
1347 }
1348
1349 =head2 checkuserpassword (OUEST-PROVENCE)
1350
1351 check for the password and login are not used
1352 return the number of record
1353 0=> NOT USED 1=> USED
1354
1355 =cut
1356
1357 sub checkuserpassword {
1358     my ( $borrowernumber, $userid, $password ) = @_;
1359     $password = md5_base64($password);
1360     my $dbh = C4::Context->dbh;
1361     my $sth =
1362       $dbh->prepare(
1363 "Select count(*) from borrowers where borrowernumber !=? and userid =? and password=? "
1364       );
1365     $sth->execute( $borrowernumber, $userid, $password );
1366     my $number_rows = $sth->fetchrow;
1367     return $number_rows;
1368
1369 }
1370
1371 =head2 GetborCatFromCatType
1372
1373   ($codes_arrayref, $labels_hashref) = &GetborCatFromCatType();
1374
1375 Looks up the different types of borrowers in the database. Returns two
1376 elements: a reference-to-array, which lists the borrower category
1377 codes, and a reference-to-hash, which maps the borrower category codes
1378 to category descriptions.
1379
1380 =cut
1381
1382 #'
1383 sub GetborCatFromCatType {
1384     my ( $category_type, $action ) = @_;
1385         # FIXME - This API  seems both limited and dangerous.
1386     my $dbh     = C4::Context->dbh;
1387     my $request = qq|   SELECT categorycode,description
1388             FROM categories
1389             $action
1390             ORDER BY categorycode|;
1391     my $sth = $dbh->prepare($request);
1392         if ($action) {
1393         $sth->execute($category_type);
1394     }
1395     else {
1396         $sth->execute();
1397     }
1398
1399     my %labels;
1400     my @codes;
1401
1402     while ( my $data = $sth->fetchrow_hashref ) {
1403         push @codes, $data->{'categorycode'};
1404         $labels{ $data->{'categorycode'} } = $data->{'description'};
1405     }
1406     return ( \@codes, \%labels );
1407 }
1408
1409 =head2 GetBorrowercategory
1410
1411   $hashref = &GetBorrowercategory($categorycode);
1412
1413 Given the borrower's category code, the function returns the corresponding
1414 data hashref for a comprehensive information display.
1415
1416   $arrayref_hashref = &GetBorrowercategory;
1417
1418 If no category code provided, the function returns all the categories.
1419
1420 =cut
1421
1422 sub GetBorrowercategory {
1423     my ($catcode) = @_;
1424     my $dbh       = C4::Context->dbh;
1425     if ($catcode){
1426         my $sth       =
1427         $dbh->prepare(
1428     "SELECT description,dateofbirthrequired,upperagelimit,category_type
1429     FROM categories
1430     WHERE categorycode = ?"
1431         );
1432         $sth->execute($catcode);
1433         my $data =
1434         $sth->fetchrow_hashref;
1435         return $data;
1436     }
1437     return;
1438 }    # sub getborrowercategory
1439
1440 =head2 GetBorrowercategoryList
1441
1442   $arrayref_hashref = &GetBorrowercategoryList;
1443 If no category code provided, the function returns all the categories.
1444
1445 =cut
1446
1447 sub GetBorrowercategoryList {
1448     my $dbh       = C4::Context->dbh;
1449     my $sth       =
1450     $dbh->prepare(
1451     "SELECT *
1452     FROM categories
1453     ORDER BY description"
1454         );
1455     $sth->execute;
1456     my $data =
1457     $sth->fetchall_arrayref({});
1458     return $data;
1459 }    # sub getborrowercategory
1460
1461 =head2 ethnicitycategories
1462
1463   ($codes_arrayref, $labels_hashref) = &ethnicitycategories();
1464
1465 Looks up the different ethnic types in the database. Returns two
1466 elements: a reference-to-array, which lists the ethnicity codes, and a
1467 reference-to-hash, which maps the ethnicity codes to ethnicity
1468 descriptions.
1469
1470 =cut
1471
1472 #'
1473
1474 sub ethnicitycategories {
1475     my $dbh = C4::Context->dbh;
1476     my $sth = $dbh->prepare("Select code,name from ethnicity order by name");
1477     $sth->execute;
1478     my %labels;
1479     my @codes;
1480     while ( my $data = $sth->fetchrow_hashref ) {
1481         push @codes, $data->{'code'};
1482         $labels{ $data->{'code'} } = $data->{'name'};
1483     }
1484     return ( \@codes, \%labels );
1485 }
1486
1487 =head2 fixEthnicity
1488
1489   $ethn_name = &fixEthnicity($ethn_code);
1490
1491 Takes an ethnicity code (e.g., "european" or "pi") and returns the
1492 corresponding descriptive name from the C<ethnicity> table in the
1493 Koha database ("European" or "Pacific Islander").
1494
1495 =cut
1496
1497 #'
1498
1499 sub fixEthnicity {
1500     my $ethnicity = shift;
1501     return unless $ethnicity;
1502     my $dbh       = C4::Context->dbh;
1503     my $sth       = $dbh->prepare("Select name from ethnicity where code = ?");
1504     $sth->execute($ethnicity);
1505     my $data = $sth->fetchrow_hashref;
1506     return $data->{'name'};
1507 }    # sub fixEthnicity
1508
1509 =head2 GetAge
1510
1511   $dateofbirth,$date = &GetAge($date);
1512
1513 this function return the borrowers age with the value of dateofbirth
1514
1515 =cut
1516
1517 #'
1518 sub GetAge{
1519     my ( $date, $date_ref ) = @_;
1520
1521     if ( not defined $date_ref ) {
1522         $date_ref = sprintf( '%04d-%02d-%02d', Today() );
1523     }
1524
1525     my ( $year1, $month1, $day1 ) = split /-/, $date;
1526     my ( $year2, $month2, $day2 ) = split /-/, $date_ref;
1527
1528     my $age = $year2 - $year1;
1529     if ( $month1 . $day1 > $month2 . $day2 ) {
1530         $age--;
1531     }
1532
1533     return $age;
1534 }    # sub get_age
1535
1536 =head2 get_institutions
1537
1538   $insitutions = get_institutions();
1539
1540 Just returns a list of all the borrowers of type I, borrownumber and name
1541
1542 =cut
1543
1544 #'
1545 sub get_institutions {
1546     my $dbh = C4::Context->dbh();
1547     my $sth =
1548       $dbh->prepare(
1549 "SELECT borrowernumber,surname FROM borrowers WHERE categorycode=? ORDER BY surname"
1550       );
1551     $sth->execute('I');
1552     my %orgs;
1553     while ( my $data = $sth->fetchrow_hashref() ) {
1554         $orgs{ $data->{'borrowernumber'} } = $data;
1555     }
1556     return ( \%orgs );
1557
1558 }    # sub get_institutions
1559
1560 =head2 add_member_orgs
1561
1562   add_member_orgs($borrowernumber,$borrowernumbers);
1563
1564 Takes a borrowernumber and a list of other borrowernumbers and inserts them into the borrowers_to_borrowers table
1565
1566 =cut
1567
1568 #'
1569 sub add_member_orgs {
1570     my ( $borrowernumber, $otherborrowers ) = @_;
1571     my $dbh   = C4::Context->dbh();
1572     my $query =
1573       "INSERT INTO borrowers_to_borrowers (borrower1,borrower2) VALUES (?,?)";
1574     my $sth = $dbh->prepare($query);
1575     foreach my $otherborrowernumber (@$otherborrowers) {
1576         $sth->execute( $borrowernumber, $otherborrowernumber );
1577     }
1578
1579 }    # sub add_member_orgs
1580
1581 =head2 GetCities
1582
1583   $cityarrayref = GetCities();
1584
1585   Returns an array_ref of the entries in the cities table
1586   If there are entries in the table an empty row is returned
1587   This is currently only used to populate a popup in memberentry
1588
1589 =cut
1590
1591 sub GetCities {
1592
1593     my $dbh   = C4::Context->dbh;
1594     my $city_arr = $dbh->selectall_arrayref(
1595         q|SELECT cityid,city_zipcode,city_name,city_state,city_country FROM cities ORDER BY city_name|,
1596         { Slice => {} });
1597     if ( @{$city_arr} ) {
1598         unshift @{$city_arr}, {
1599             city_zipcode => q{},
1600             city_name    => q{},
1601             cityid       => q{},
1602             city_state   => q{},
1603             city_country => q{},
1604         };
1605     }
1606
1607     return  $city_arr;
1608 }
1609
1610 =head2 GetSortDetails (OUEST-PROVENCE)
1611
1612   ($lib) = &GetSortDetails($category,$sortvalue);
1613
1614 Returns the authorized value  details
1615 C<&$lib>return value of authorized value details
1616 C<&$sortvalue>this is the value of authorized value
1617 C<&$category>this is the value of authorized value category
1618
1619 =cut
1620
1621 sub GetSortDetails {
1622     my ( $category, $sortvalue ) = @_;
1623     my $dbh   = C4::Context->dbh;
1624     my $query = qq|SELECT lib
1625         FROM authorised_values
1626         WHERE category=?
1627         AND authorised_value=? |;
1628     my $sth = $dbh->prepare($query);
1629     $sth->execute( $category, $sortvalue );
1630     my $lib = $sth->fetchrow;
1631     return ($lib) if ($lib);
1632     return ($sortvalue) unless ($lib);
1633 }
1634
1635 =head2 MoveMemberToDeleted
1636
1637   $result = &MoveMemberToDeleted($borrowernumber);
1638
1639 Copy the record from borrowers to deletedborrowers table.
1640
1641 =cut
1642
1643 # FIXME: should do it in one SQL statement w/ subquery
1644 # Otherwise, we should return the @data on success
1645
1646 sub MoveMemberToDeleted {
1647     my ($member) = shift or return;
1648     my $dbh = C4::Context->dbh;
1649     my $query = qq|SELECT *
1650           FROM borrowers
1651           WHERE borrowernumber=?|;
1652     my $sth = $dbh->prepare($query);
1653     $sth->execute($member);
1654     my @data = $sth->fetchrow_array;
1655     (@data) or return;  # if we got a bad borrowernumber, there's nothing to insert
1656     $sth =
1657       $dbh->prepare( "INSERT INTO deletedborrowers VALUES ("
1658           . ( "?," x ( scalar(@data) - 1 ) )
1659           . "?)" );
1660     $sth->execute(@data);
1661 }
1662
1663 =head2 DelMember
1664
1665     DelMember($borrowernumber);
1666
1667 This function remove directly a borrower whitout writing it on deleteborrower.
1668 + Deletes reserves for the borrower
1669
1670 =cut
1671
1672 sub DelMember {
1673     my $dbh            = C4::Context->dbh;
1674     my $borrowernumber = shift;
1675     #warn "in delmember with $borrowernumber";
1676     return unless $borrowernumber;    # borrowernumber is mandatory.
1677
1678     my $query = qq|DELETE
1679           FROM  reserves
1680           WHERE borrowernumber=?|;
1681     my $sth = $dbh->prepare($query);
1682     $sth->execute($borrowernumber);
1683     $query = "
1684        DELETE
1685        FROM borrowers
1686        WHERE borrowernumber = ?
1687    ";
1688     $sth = $dbh->prepare($query);
1689     $sth->execute($borrowernumber);
1690     logaction("MEMBERS", "DELETE", $borrowernumber, "") if C4::Context->preference("BorrowersLog");
1691     return $sth->rows;
1692 }
1693
1694 =head2 ExtendMemberSubscriptionTo (OUEST-PROVENCE)
1695
1696     $date = ExtendMemberSubscriptionTo($borrowerid, $date);
1697
1698 Extending the subscription to a given date or to the expiry date calculated on ISO date.
1699 Returns ISO date.
1700
1701 =cut
1702
1703 sub ExtendMemberSubscriptionTo {
1704     my ( $borrowerid,$date) = @_;
1705     my $dbh = C4::Context->dbh;
1706     my $borrower = GetMember('borrowernumber'=>$borrowerid);
1707     unless ($date){
1708       $date = (C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry') ?
1709                                         C4::Dates->new($borrower->{'dateexpiry'}, 'iso')->output("iso") :
1710                                         C4::Dates->new()->output("iso");
1711       $date = GetExpiryDate( $borrower->{'categorycode'}, $date );
1712     }
1713     my $sth = $dbh->do(<<EOF);
1714 UPDATE borrowers
1715 SET  dateexpiry='$date'
1716 WHERE borrowernumber='$borrowerid'
1717 EOF
1718     # add enrolmentfee if needed
1719     $sth = $dbh->prepare("SELECT enrolmentfee FROM categories WHERE categorycode=?");
1720     $sth->execute($borrower->{'categorycode'});
1721     my ($enrolmentfee) = $sth->fetchrow;
1722     if ($enrolmentfee && $enrolmentfee > 0) {
1723         # insert fee in patron debts
1724         manualinvoice($borrower->{'borrowernumber'}, '', '', 'A', $enrolmentfee);
1725     }
1726      logaction("MEMBERS", "RENEW", $borrower->{'borrowernumber'}, "Membership renewed")if C4::Context->preference("BorrowersLog");
1727     return $date if ($sth);
1728     return 0;
1729 }
1730
1731 =head2 GetRoadTypes (OUEST-PROVENCE)
1732
1733   ($idroadtypearrayref, $roadttype_hashref) = &GetRoadTypes();
1734
1735 Looks up the different road type . Returns two
1736 elements: a reference-to-array, which lists the id_roadtype
1737 codes, and a reference-to-hash, which maps the road type of the road .
1738
1739 =cut
1740
1741 sub GetRoadTypes {
1742     my $dbh   = C4::Context->dbh;
1743     my $query = qq|
1744 SELECT roadtypeid,road_type
1745 FROM roadtype
1746 ORDER BY road_type|;
1747     my $sth = $dbh->prepare($query);
1748     $sth->execute();
1749     my %roadtype;
1750     my @id;
1751
1752     #    insert empty value to create a empty choice in cgi popup
1753
1754     while ( my $data = $sth->fetchrow_hashref ) {
1755
1756         push @id, $data->{'roadtypeid'};
1757         $roadtype{ $data->{'roadtypeid'} } = $data->{'road_type'};
1758     }
1759
1760 #test to know if the table contain some records if no the function return nothing
1761     my $id = @id;
1762     if ( $id eq 0 ) {
1763         return ();
1764     }
1765     else {
1766         unshift( @id, "" );
1767         return ( \@id, \%roadtype );
1768     }
1769 }
1770
1771
1772
1773 =head2 GetTitles (OUEST-PROVENCE)
1774
1775   ($borrowertitle)= &GetTitles();
1776
1777 Looks up the different title . Returns array  with all borrowers title
1778
1779 =cut
1780
1781 sub GetTitles {
1782     my @borrowerTitle = split (/,|\|/,C4::Context->preference('BorrowersTitles'));
1783     unshift( @borrowerTitle, "" );
1784     my $count=@borrowerTitle;
1785     if ($count == 1){
1786         return ();
1787     }
1788     else {
1789         return ( \@borrowerTitle);
1790     }
1791 }
1792
1793 =head2 GetPatronImage
1794
1795     my ($imagedata, $dberror) = GetPatronImage($cardnumber);
1796
1797 Returns the mimetype and binary image data of the image for the patron with the supplied cardnumber.
1798
1799 =cut
1800
1801 sub GetPatronImage {
1802     my ($cardnumber) = @_;
1803     warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1804     my $dbh = C4::Context->dbh;
1805     my $query = 'SELECT mimetype, imagefile FROM patronimage WHERE cardnumber = ?';
1806     my $sth = $dbh->prepare($query);
1807     $sth->execute($cardnumber);
1808     my $imagedata = $sth->fetchrow_hashref;
1809     warn "Database error!" if $sth->errstr;
1810     return $imagedata, $sth->errstr;
1811 }
1812
1813 =head2 PutPatronImage
1814
1815     PutPatronImage($cardnumber, $mimetype, $imgfile);
1816
1817 Stores patron binary image data and mimetype in database.
1818 NOTE: This function is good for updating images as well as inserting new images in the database.
1819
1820 =cut
1821
1822 sub PutPatronImage {
1823     my ($cardnumber, $mimetype, $imgfile) = @_;
1824     warn "Parameters passed in: Cardnumber=$cardnumber, Mimetype=$mimetype, " . ($imgfile ? "Imagefile" : "No Imagefile") if $debug;
1825     my $dbh = C4::Context->dbh;
1826     my $query = "INSERT INTO patronimage (cardnumber, mimetype, imagefile) VALUES (?,?,?) ON DUPLICATE KEY UPDATE imagefile = ?;";
1827     my $sth = $dbh->prepare($query);
1828     $sth->execute($cardnumber,$mimetype,$imgfile,$imgfile);
1829     warn "Error returned inserting $cardnumber.$mimetype." if $sth->errstr;
1830     return $sth->errstr;
1831 }
1832
1833 =head2 RmPatronImage
1834
1835     my ($dberror) = RmPatronImage($cardnumber);
1836
1837 Removes the image for the patron with the supplied cardnumber.
1838
1839 =cut
1840
1841 sub RmPatronImage {
1842     my ($cardnumber) = @_;
1843     warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1844     my $dbh = C4::Context->dbh;
1845     my $query = "DELETE FROM patronimage WHERE cardnumber = ?;";
1846     my $sth = $dbh->prepare($query);
1847     $sth->execute($cardnumber);
1848     my $dberror = $sth->errstr;
1849     warn "Database error!" if $sth->errstr;
1850     return $dberror;
1851 }
1852
1853 =head2 GetHideLostItemsPreference
1854
1855   $hidelostitemspref = &GetHideLostItemsPreference($borrowernumber);
1856
1857 Returns the HideLostItems preference for the patron category of the supplied borrowernumber
1858 C<&$hidelostitemspref>return value of function, 0 or 1
1859
1860 =cut
1861
1862 sub GetHideLostItemsPreference {
1863     my ($borrowernumber) = @_;
1864     my $dbh = C4::Context->dbh;
1865     my $query = "SELECT hidelostitems FROM borrowers,categories WHERE borrowers.categorycode = categories.categorycode AND borrowernumber = ?";
1866     my $sth = $dbh->prepare($query);
1867     $sth->execute($borrowernumber);
1868     my $hidelostitems = $sth->fetchrow;
1869     return $hidelostitems;
1870 }
1871
1872 =head2 GetRoadTypeDetails (OUEST-PROVENCE)
1873
1874   ($roadtype) = &GetRoadTypeDetails($roadtypeid);
1875
1876 Returns the description of roadtype
1877 C<&$roadtype>return description of road type
1878 C<&$roadtypeid>this is the value of roadtype s
1879
1880 =cut
1881
1882 sub GetRoadTypeDetails {
1883     my ($roadtypeid) = @_;
1884     my $dbh          = C4::Context->dbh;
1885     my $query        = qq|
1886 SELECT road_type
1887 FROM roadtype
1888 WHERE roadtypeid=?|;
1889     my $sth = $dbh->prepare($query);
1890     $sth->execute($roadtypeid);
1891     my $roadtype = $sth->fetchrow;
1892     return ($roadtype);
1893 }
1894
1895 =head2 GetBorrowersWhoHaveNotBorrowedSince
1896
1897   &GetBorrowersWhoHaveNotBorrowedSince($date)
1898
1899 this function get all borrowers who haven't borrowed since the date given on input arg.
1900
1901 =cut
1902
1903 sub GetBorrowersWhoHaveNotBorrowedSince {
1904     my $filterdate = shift||POSIX::strftime("%Y-%m-%d",localtime());
1905     my $filterexpiry = shift;
1906     my $filterbranch = shift ||
1907                         ((C4::Context->preference('IndependantBranches')
1908                              && C4::Context->userenv
1909                              && C4::Context->userenv->{flags} % 2 !=1
1910                              && C4::Context->userenv->{branch})
1911                          ? C4::Context->userenv->{branch}
1912                          : "");
1913     my $dbh   = C4::Context->dbh;
1914     my $query = "
1915         SELECT borrowers.borrowernumber,
1916                max(old_issues.timestamp) as latestissue,
1917                max(issues.timestamp) as currentissue
1918         FROM   borrowers
1919         JOIN   categories USING (categorycode)
1920         LEFT JOIN old_issues USING (borrowernumber)
1921         LEFT JOIN issues USING (borrowernumber)
1922         WHERE  category_type <> 'S'
1923         AND borrowernumber NOT IN (SELECT guarantorid FROM borrowers WHERE guarantorid IS NOT NULL AND guarantorid <> 0)
1924    ";
1925     my @query_params;
1926     if ($filterbranch && $filterbranch ne ""){
1927         $query.=" AND borrowers.branchcode= ?";
1928         push @query_params,$filterbranch;
1929     }
1930     if($filterexpiry){
1931         $query .= " AND dateexpiry < ? ";
1932         push @query_params,$filterdate;
1933     }
1934     $query.=" GROUP BY borrowers.borrowernumber";
1935     if ($filterdate){
1936         $query.=" HAVING (latestissue < ? OR latestissue IS NULL)
1937                   AND currentissue IS NULL";
1938         push @query_params,$filterdate;
1939     }
1940     warn $query if $debug;
1941     my $sth = $dbh->prepare($query);
1942     if (scalar(@query_params)>0){
1943         $sth->execute(@query_params);
1944     }
1945     else {
1946         $sth->execute;
1947     }
1948
1949     my @results;
1950     while ( my $data = $sth->fetchrow_hashref ) {
1951         push @results, $data;
1952     }
1953     return \@results;
1954 }
1955
1956 =head2 GetBorrowersWhoHaveNeverBorrowed
1957
1958   $results = &GetBorrowersWhoHaveNeverBorrowed
1959
1960 This function get all borrowers who have never borrowed.
1961
1962 I<$result> is a ref to an array which all elements are a hasref.
1963
1964 =cut
1965
1966 sub GetBorrowersWhoHaveNeverBorrowed {
1967     my $filterbranch = shift ||
1968                         ((C4::Context->preference('IndependantBranches')
1969                              && C4::Context->userenv
1970                              && C4::Context->userenv->{flags} % 2 !=1
1971                              && C4::Context->userenv->{branch})
1972                          ? C4::Context->userenv->{branch}
1973                          : "");
1974     my $dbh   = C4::Context->dbh;
1975     my $query = "
1976         SELECT borrowers.borrowernumber,max(timestamp) as latestissue
1977         FROM   borrowers
1978           LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
1979         WHERE issues.borrowernumber IS NULL
1980    ";
1981     my @query_params;
1982     if ($filterbranch && $filterbranch ne ""){
1983         $query.=" AND borrowers.branchcode= ?";
1984         push @query_params,$filterbranch;
1985     }
1986     warn $query if $debug;
1987
1988     my $sth = $dbh->prepare($query);
1989     if (scalar(@query_params)>0){
1990         $sth->execute(@query_params);
1991     }
1992     else {
1993         $sth->execute;
1994     }
1995
1996     my @results;
1997     while ( my $data = $sth->fetchrow_hashref ) {
1998         push @results, $data;
1999     }
2000     return \@results;
2001 }
2002
2003 =head2 GetBorrowersWithIssuesHistoryOlderThan
2004
2005   $results = &GetBorrowersWithIssuesHistoryOlderThan($date)
2006
2007 this function get all borrowers who has an issue history older than I<$date> given on input arg.
2008
2009 I<$result> is a ref to an array which all elements are a hashref.
2010 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
2011
2012 =cut
2013
2014 sub GetBorrowersWithIssuesHistoryOlderThan {
2015     my $dbh  = C4::Context->dbh;
2016     my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime());
2017     my $filterbranch = shift ||
2018                         ((C4::Context->preference('IndependantBranches')
2019                              && C4::Context->userenv
2020                              && C4::Context->userenv->{flags} % 2 !=1
2021                              && C4::Context->userenv->{branch})
2022                          ? C4::Context->userenv->{branch}
2023                          : "");
2024     my $query = "
2025        SELECT count(borrowernumber) as n,borrowernumber
2026        FROM old_issues
2027        WHERE returndate < ?
2028          AND borrowernumber IS NOT NULL
2029     ";
2030     my @query_params;
2031     push @query_params, $date;
2032     if ($filterbranch){
2033         $query.="   AND branchcode = ?";
2034         push @query_params, $filterbranch;
2035     }
2036     $query.=" GROUP BY borrowernumber ";
2037     warn $query if $debug;
2038     my $sth = $dbh->prepare($query);
2039     $sth->execute(@query_params);
2040     my @results;
2041
2042     while ( my $data = $sth->fetchrow_hashref ) {
2043         push @results, $data;
2044     }
2045     return \@results;
2046 }
2047
2048 =head2 GetBorrowersNamesAndLatestIssue
2049
2050   $results = &GetBorrowersNamesAndLatestIssueList(@borrowernumbers)
2051
2052 this function get borrowers Names and surnames and Issue information.
2053
2054 I<@borrowernumbers> is an array which all elements are borrowernumbers.
2055 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
2056
2057 =cut
2058
2059 sub GetBorrowersNamesAndLatestIssue {
2060     my $dbh  = C4::Context->dbh;
2061     my @borrowernumbers=@_;
2062     my $query = "
2063        SELECT surname,lastname, phone, email,max(timestamp)
2064        FROM borrowers
2065          LEFT JOIN issues ON borrowers.borrowernumber=issues.borrowernumber
2066        GROUP BY borrowernumber
2067    ";
2068     my $sth = $dbh->prepare($query);
2069     $sth->execute;
2070     my $results = $sth->fetchall_arrayref({});
2071     return $results;
2072 }
2073
2074 =head2 DebarMember
2075
2076 my $success = DebarMember( $borrowernumber, $todate );
2077
2078 marks a Member as debarred, and therefore unable to checkout any more
2079 items.
2080
2081 return :
2082 true on success, false on failure
2083
2084 =cut
2085
2086 sub DebarMember {
2087     my $borrowernumber = shift;
2088     my $todate         = shift;
2089
2090     return unless defined $borrowernumber;
2091     return unless $borrowernumber =~ /^\d+$/;
2092
2093     return ModMember(
2094         borrowernumber => $borrowernumber,
2095         debarred       => $todate
2096     );
2097
2098 }
2099
2100 =head2 ModPrivacy
2101
2102 =over 4
2103
2104 my $success = ModPrivacy( $borrowernumber, $privacy );
2105
2106 Update the privacy of a patron.
2107
2108 return :
2109 true on success, false on failure
2110
2111 =back
2112
2113 =cut
2114
2115 sub ModPrivacy {
2116     my $borrowernumber = shift;
2117     my $privacy = shift;
2118     return unless defined $borrowernumber;
2119     return unless $borrowernumber =~ /^\d+$/;
2120
2121     return ModMember( borrowernumber => $borrowernumber,
2122                       privacy        => $privacy );
2123 }
2124
2125 =head2 AddMessage
2126
2127   AddMessage( $borrowernumber, $message_type, $message, $branchcode );
2128
2129 Adds a message to the messages table for the given borrower.
2130
2131 Returns:
2132   True on success
2133   False on failure
2134
2135 =cut
2136
2137 sub AddMessage {
2138     my ( $borrowernumber, $message_type, $message, $branchcode ) = @_;
2139
2140     my $dbh  = C4::Context->dbh;
2141
2142     if ( ! ( $borrowernumber && $message_type && $message && $branchcode ) ) {
2143       return;
2144     }
2145
2146     my $query = "INSERT INTO messages ( borrowernumber, branchcode, message_type, message ) VALUES ( ?, ?, ?, ? )";
2147     my $sth = $dbh->prepare($query);
2148     $sth->execute( $borrowernumber, $branchcode, $message_type, $message );
2149     logaction("MEMBERS", "ADDCIRCMESSAGE", $borrowernumber, $message) if C4::Context->preference("BorrowersLog");
2150     return 1;
2151 }
2152
2153 =head2 GetMessages
2154
2155   GetMessages( $borrowernumber, $type );
2156
2157 $type is message type, B for borrower, or L for Librarian.
2158 Empty type returns all messages of any type.
2159
2160 Returns all messages for the given borrowernumber
2161
2162 =cut
2163
2164 sub GetMessages {
2165     my ( $borrowernumber, $type, $branchcode ) = @_;
2166
2167     if ( ! $type ) {
2168       $type = '%';
2169     }
2170
2171     my $dbh  = C4::Context->dbh;
2172
2173     my $query = "SELECT
2174                   branches.branchname,
2175                   messages.*,
2176                   message_date,
2177                   messages.branchcode LIKE '$branchcode' AS can_delete
2178                   FROM messages, branches
2179                   WHERE borrowernumber = ?
2180                   AND message_type LIKE ?
2181                   AND messages.branchcode = branches.branchcode
2182                   ORDER BY message_date DESC";
2183     my $sth = $dbh->prepare($query);
2184     $sth->execute( $borrowernumber, $type ) ;
2185     my @results;
2186
2187     while ( my $data = $sth->fetchrow_hashref ) {
2188         my $d = C4::Dates->new( $data->{message_date}, 'iso' );
2189         $data->{message_date_formatted} = $d->output;
2190         push @results, $data;
2191     }
2192     return \@results;
2193
2194 }
2195
2196 =head2 GetMessages
2197
2198   GetMessagesCount( $borrowernumber, $type );
2199
2200 $type is message type, B for borrower, or L for Librarian.
2201 Empty type returns all messages of any type.
2202
2203 Returns the number of messages for the given borrowernumber
2204
2205 =cut
2206
2207 sub GetMessagesCount {
2208     my ( $borrowernumber, $type, $branchcode ) = @_;
2209
2210     if ( ! $type ) {
2211       $type = '%';
2212     }
2213
2214     my $dbh  = C4::Context->dbh;
2215
2216     my $query = "SELECT COUNT(*) as MsgCount FROM messages WHERE borrowernumber = ? AND message_type LIKE ?";
2217     my $sth = $dbh->prepare($query);
2218     $sth->execute( $borrowernumber, $type ) ;
2219     my @results;
2220
2221     my $data = $sth->fetchrow_hashref;
2222     my $count = $data->{'MsgCount'};
2223
2224     return $count;
2225 }
2226
2227
2228
2229 =head2 DeleteMessage
2230
2231   DeleteMessage( $message_id );
2232
2233 =cut
2234
2235 sub DeleteMessage {
2236     my ( $message_id ) = @_;
2237
2238     my $dbh = C4::Context->dbh;
2239     my $query = "SELECT * FROM messages WHERE message_id = ?";
2240     my $sth = $dbh->prepare($query);
2241     $sth->execute( $message_id );
2242     my $message = $sth->fetchrow_hashref();
2243
2244     $query = "DELETE FROM messages WHERE message_id = ?";
2245     $sth = $dbh->prepare($query);
2246     $sth->execute( $message_id );
2247     logaction("MEMBERS", "DELCIRCMESSAGE", $message->{'borrowernumber'}, $message->{'message'}) if C4::Context->preference("BorrowersLog");
2248 }
2249
2250 =head2 IssueSlip
2251
2252   IssueSlip($branchcode, $borrowernumber, $quickslip)
2253
2254   Returns letter hash ( see C4::Letters::GetPreparedLetter )
2255
2256   $quickslip is boolean, to indicate whether we want a quick slip
2257
2258 =cut
2259
2260 sub IssueSlip {
2261     my ($branch, $borrowernumber, $quickslip) = @_;
2262
2263 #   return unless ( C4::Context->boolean_preference('printcirculationslips') );
2264
2265     my $now       = POSIX::strftime("%Y-%m-%d", localtime);
2266
2267     my $issueslist = GetPendingIssues($borrowernumber);
2268     foreach my $it (@$issueslist){
2269         if ((substr $it->{'issuedate'}, 0, 10) eq $now) {
2270             $it->{'now'} = 1;
2271         }
2272         elsif ((substr $it->{'date_due'}, 0, 10) le $now) {
2273             $it->{'overdue'} = 1;
2274         }
2275
2276         $it->{'date_due'}=format_date($it->{'date_due'});
2277     }
2278     my @issues = sort { $b->{'timestamp'} <=> $a->{'timestamp'} } @$issueslist;
2279
2280     my ($letter_code, %repeat);
2281     if ( $quickslip ) {
2282         $letter_code = 'ISSUEQSLIP';
2283         %repeat =  (
2284             'checkedout' => [ map {
2285                 'biblio' => $_,
2286                 'items'  => $_,
2287                 'issues' => $_,
2288             }, grep { $_->{'now'} } @issues ],
2289         );
2290     }
2291     else {
2292         $letter_code = 'ISSUESLIP';
2293         %repeat =  (
2294             'checkedout' => [ map {
2295                 'biblio' => $_,
2296                 'items'  => $_,
2297                 'issues' => $_,
2298             }, grep { !$_->{'overdue'} } @issues ],
2299
2300             'overdue' => [ map {
2301                 'biblio' => $_,
2302                 'items'  => $_,
2303                 'issues' => $_,
2304             }, grep { $_->{'overdue'} } @issues ],
2305
2306             'news' => [ map {
2307                 $_->{'timestamp'} = $_->{'newdate'};
2308                 { opac_news => $_ }
2309             } @{ GetNewsToDisplay("slip") } ],
2310         );
2311     }
2312
2313     return  C4::Letters::GetPreparedLetter (
2314         module => 'circulation',
2315         letter_code => $letter_code,
2316         branchcode => $branch,
2317         tables => {
2318             'branches'    => $branch,
2319             'borrowers'   => $borrowernumber,
2320         },
2321         repeat => \%repeat,
2322     );
2323 }
2324
2325 =head2 GetBorrowersWithEmail
2326
2327     ([$borrnum,$userid], ...) = GetBorrowersWithEmail('me@example.com');
2328
2329 This gets a list of users and their basic details from their email address.
2330 As it's possible for multiple user to have the same email address, it provides
2331 you with all of them. If there is no userid for the user, there will be an
2332 C<undef> there. An empty list will be returned if there are no matches.
2333
2334 =cut
2335
2336 sub GetBorrowersWithEmail {
2337     my $email = shift;
2338
2339     my $dbh = C4::Context->dbh;
2340
2341     my $query = "SELECT borrowernumber, userid FROM borrowers WHERE email=?";
2342     my $sth=$dbh->prepare($query);
2343     $sth->execute($email);
2344     my @result = ();
2345     while (my $ref = $sth->fetch) {
2346         push @result, $ref;
2347     }
2348     die "Failure searching for borrowers by email address: $sth->errstr" if $sth->err;
2349     return @result;
2350 }
2351
2352
2353 END { }    # module clean-up code here (global destructor)
2354
2355 1;
2356
2357 __END__
2358
2359 =head1 AUTHOR
2360
2361 Koha Team
2362
2363 =cut