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