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