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