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
  44 our ($VERSION,@ISA,@EXPORT,@EXPORT_OK,$debug);
  45
  46 use Module::Load::Conditional qw( can_load );
  47 if ( ! can_load( modules => { 'Koha::NorwegianPatronDB' => undef } ) ) {
  48    $debug && warn "Unable to load Koha::NorwegianPatronDB";
  49 }
  50
  51
  52 BEGIN {
  53     $VERSION = 3.07.00.049;
  54     $debug = $ENV{DEBUG} || 0;
  55     require Exporter;
  56     @ISA = qw(Exporter);
  57     #Get data
  58     push @EXPORT, qw(
  59         &Search
  60         &GetMemberDetails
  61         &GetMemberRelatives
  62         &GetMember
  63
  64         &GetGuarantees
  65
  66         &GetMemberIssuesAndFines
  67         &GetPendingIssues
  68         &GetAllIssues
  69
  70         &getzipnamecity
  71         &getidcity
  72
  73         &GetFirstValidEmailAddress
  74         &GetNoticeEmailAddress
  75
  76         &GetAge
  77         &GetCities
  78         &GetSortDetails
  79         &GetTitles
  80
  81         &GetPatronImage
  82         &PutPatronImage
  83         &RmPatronImage
  84
  85         &GetHideLostItemsPreference
  86
  87         &IsMemberBlocked
  88         &GetMemberAccountRecords
  89         &GetBorNotifyAcctRecord
  90
  91         &GetborCatFromCatType
  92         &GetBorrowercategory
  93         GetBorrowerCategorycode
  94         &GetBorrowercategoryList
  95
  96         &GetBorrowersToExpunge
  97         &GetBorrowersWhoHaveNeverBorrowed
  98         &GetBorrowersWithIssuesHistoryOlderThan
  99
 100         &GetExpiryDate
 101         &GetUpcomingMembershipExpires
 102
 103         &AddMessage
 104         &DeleteMessage
 105         &GetMessages
 106         &GetMessagesCount
 107
 108         &IssueSlip
 109         GetBorrowersWithEmail
 110
 111         HasOverdues
 112         GetOverduesForPatron
 113     );
 114
 115     #Modify data
 116     push @EXPORT, qw(
 117         &ModMember
 118         &changepassword
 119     );
 120
 121     #Delete data
 122     push @EXPORT, qw(
 123         &DelMember
 124     );
 125
 126     #Insert data
 127     push @EXPORT, qw(
 128         &AddMember
 129         &AddMember_Opac
 130         &MoveMemberToDeleted
 131         &ExtendMemberSubscriptionTo
 132     );
 133
 134     #Check data
 135     push @EXPORT, qw(
 136         &checkuniquemember
 137         &checkuserpassword
 138         &Check_Userid
 139         &Generate_Userid
 140         &fixup_cardnumber
 141         &checkcardnumber
 142     );
 143 }
 144
 145 =head1 NAME
 146
 147 C4::Members - Perl Module containing convenience functions for member handling
 148
 149 =head1 SYNOPSIS
 150
 151 use C4::Members;
 152
 153 =head1 DESCRIPTION
 154
 155 This module contains routines for adding, modifying and deleting members/patrons/borrowers
 156
 157 =head1 FUNCTIONS
 158
 159 =head2 GetMemberDetails
 160
 161 ($borrower) = &GetMemberDetails($borrowernumber, $cardnumber);
 162
 163 Looks up a patron and returns information about him or her. If
 164 C<$borrowernumber> is true (nonzero), C<&GetMemberDetails> looks
 165 up the borrower by number; otherwise, it looks up the borrower by card
 166 number.
 167
 168 C<$borrower> is a reference-to-hash whose keys are the fields of the
 169 borrowers table in the Koha database. In addition,
 170 C<$borrower-E<gt>{flags}> is a hash giving more detailed information
 171 about the patron. Its keys act as flags :
 172
 173     if $borrower->{flags}->{LOST} {
 174         # Patron's card was reported lost
 175     }
 176
 177 If the state of a flag means that the patron should not be
 178 allowed to borrow any more books, then it will have a C<noissues> key
 179 with a true value.
 180
 181 See patronflags for more details.
 182
 183 C<$borrower-E<gt>{authflags}> is a hash giving more detailed information
 184 about the top-level permissions flags set for the borrower.  For example,
 185 if a user has the "editcatalogue" permission,
 186 C<$borrower-E<gt>{authflags}-E<gt>{editcatalogue}> will exist and have
 187 the value "1".
 188
 189 =cut
 190
 191 sub GetMemberDetails {
 192     my ( $borrowernumber, $cardnumber ) = @_;
 193     my $dbh = C4::Context->dbh;
 194     my $query;
 195     my $sth;
 196     if ($borrowernumber) {
 197         $sth = $dbh->prepare("
 198             SELECT borrowers.*,
 199                    category_type,
 200                    categories.description,
 201                    categories.BlockExpiredPatronOpacActions,
 202                    reservefee,
 203                    enrolmentperiod
 204             FROM borrowers
 205             LEFT JOIN categories ON borrowers.categorycode=categories.categorycode
 206             WHERE borrowernumber = ?
 207         ");
 208         $sth->execute($borrowernumber);
 209     }
 210     elsif ($cardnumber) {
 211         $sth = $dbh->prepare("
 212             SELECT borrowers.*,
 213                    category_type,
 214                    categories.description,
 215                    categories.BlockExpiredPatronOpacActions,
 216                    reservefee,
 217                    enrolmentperiod
 218             FROM borrowers
 219             LEFT JOIN categories ON borrowers.categorycode = categories.categorycode
 220             WHERE cardnumber = ?
 221         ");
 222         $sth->execute($cardnumber);
 223     }
 224     else {
 225         return;
 226     }
 227     my $borrower = $sth->fetchrow_hashref;
 228     return unless $borrower;
 229     my ($amount) = GetMemberAccountRecords($borrower->{borrowernumber});
 230     $borrower->{'amountoutstanding'} = $amount;
 231     # FIXME - patronflags calls GetMemberAccountRecords... just have patronflags return $amount
 232     my $flags = patronflags( $borrower);
 233     my $accessflagshash;
 234
 235     $sth = $dbh->prepare("select bit,flag from userflags");
 236     $sth->execute;
 237     while ( my ( $bit, $flag ) = $sth->fetchrow ) {
 238         if ( $borrower->{'flags'} && $borrower->{'flags'} & 2**$bit ) {
 239             $accessflagshash->{$flag} = 1;
 240         }
 241     }
 242     $borrower->{'flags'}     = $flags;
 243     $borrower->{'authflags'} = $accessflagshash;
 244
 245     # Handle setting the true behavior for BlockExpiredPatronOpacActions
 246     $borrower->{'BlockExpiredPatronOpacActions'} =
 247       C4::Context->preference('BlockExpiredPatronOpacActions')
 248       if ( $borrower->{'BlockExpiredPatronOpacActions'} == -1 );
 249
 250     $borrower->{'is_expired'} = 0;
 251     $borrower->{'is_expired'} = 1 if
 252       defined($borrower->{dateexpiry}) &&
 253       $borrower->{'dateexpiry'} ne '0000-00-00' &&
 254       Date_to_Days( Today() ) >
 255       Date_to_Days( split /-/, $borrower->{'dateexpiry'} );
 256
 257     return ($borrower);    #, $flags, $accessflagshash);
 258 }
 259
 260 =head2 patronflags
 261
 262  $flags = &patronflags($patron);
 263
 264 This function is not exported.
 265
 266 The following will be set where applicable:
 267  $flags->{CHARGES}->{amount}        Amount of debt
 268  $flags->{CHARGES}->{noissues}      Set if debt amount >$5.00 (or syspref noissuescharge)
 269  $flags->{CHARGES}->{message}       Message -- deprecated
 270
 271  $flags->{CREDITS}->{amount}        Amount of credit
 272  $flags->{CREDITS}->{message}       Message -- deprecated
 273
 274  $flags->{  GNA  }                  Patron has no valid address
 275  $flags->{  GNA  }->{noissues}      Set for each GNA
 276  $flags->{  GNA  }->{message}       "Borrower has no valid address" -- deprecated
 277
 278  $flags->{ LOST  }                  Patron's card reported lost
 279  $flags->{ LOST  }->{noissues}      Set for each LOST
 280  $flags->{ LOST  }->{message}       Message -- deprecated
 281
 282  $flags->{DBARRED}                  Set if patron debarred, no access
 283  $flags->{DBARRED}->{noissues}      Set for each DBARRED
 284  $flags->{DBARRED}->{message}       Message -- deprecated
 285
 286  $flags->{ NOTES }
 287  $flags->{ NOTES }->{message}       The note itself.  NOT deprecated
 288
 289  $flags->{ ODUES }                  Set if patron has overdue books.
 290  $flags->{ ODUES }->{message}       "Yes"  -- deprecated
 291  $flags->{ ODUES }->{itemlist}      ref-to-array: list of overdue books
 292  $flags->{ ODUES }->{itemlisttext}  Text list of overdue items -- deprecated
 293
 294  $flags->{WAITING}                  Set if any of patron's reserves are available
 295  $flags->{WAITING}->{message}       Message -- deprecated
 296  $flags->{WAITING}->{itemlist}      ref-to-array: list of available items
 297
 298 =over
 299
 300 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the
 301 overdue items. Its elements are references-to-hash, each describing an
 302 overdue item. The keys are selected fields from the issues, biblio,
 303 biblioitems, and items tables of the Koha database.
 304
 305 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlisttext}> is a string giving a text listing of
 306 the overdue items, one per line.  Deprecated.
 307
 308 =item C<$flags-E<gt>{WAITING}-E<gt>{itemlist}> is a reference-to-array listing the
 309 available items. Each element is a reference-to-hash whose keys are
 310 fields from the reserves table of the Koha database.
 311
 312 =back
 313
 314 All the "message" fields that include language generated in this function are deprecated,
 315 because such strings belong properly in the display layer.
 316
 317 The "message" field that comes from the DB is OK.
 318
 319 =cut
 320
 321 # TODO: use {anonymous => hashes} instead of a dozen %flaginfo
 322 # FIXME rename this function.
 323 sub patronflags {
 324     my %flags;
 325     my ( $patroninformation) = @_;
 326     my $dbh=C4::Context->dbh;
 327     my ($balance, $owing) = GetMemberAccountBalance( $patroninformation->{'borrowernumber'});
 328     if ( $owing > 0 ) {
 329         my %flaginfo;
 330         my $noissuescharge = C4::Context->preference("noissuescharge") || 5;
 331         $flaginfo{'message'} = sprintf 'Patron owes %.02f', $owing;
 332         $flaginfo{'amount'}  = sprintf "%.02f", $owing;
 333         if ( $owing > $noissuescharge && !C4::Context->preference("AllowFineOverride") ) {
 334             $flaginfo{'noissues'} = 1;
 335         }
 336         $flags{'CHARGES'} = \%flaginfo;
 337     }
 338     elsif ( $balance < 0 ) {
 339         my %flaginfo;
 340         $flaginfo{'message'} = sprintf 'Patron has credit of %.02f', -$balance;
 341         $flaginfo{'amount'}  = sprintf "%.02f", $balance;
 342         $flags{'CREDITS'} = \%flaginfo;
 343     }
 344     if (   $patroninformation->{'gonenoaddress'}
 345         && $patroninformation->{'gonenoaddress'} == 1 )
 346     {
 347         my %flaginfo;
 348         $flaginfo{'message'}  = 'Borrower has no valid address.';
 349         $flaginfo{'noissues'} = 1;
 350         $flags{'GNA'}         = \%flaginfo;
 351     }
 352     if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
 353         my %flaginfo;
 354         $flaginfo{'message'}  = 'Borrower\'s card reported lost.';
 355         $flaginfo{'noissues'} = 1;
 356         $flags{'LOST'}        = \%flaginfo;
 357     }
 358     if ( $patroninformation->{'debarred'} && check_date( split( /-/, $patroninformation->{'debarred'} ) ) ) {
 359         if ( Date_to_Days(Date::Calc::Today) < Date_to_Days( split( /-/, $patroninformation->{'debarred'} ) ) ) {
 360             my %flaginfo;
 361             $flaginfo{'debarredcomment'} = $patroninformation->{'debarredcomment'};
 362             $flaginfo{'message'}         = $patroninformation->{'debarredcomment'};
 363             $flaginfo{'noissues'}        = 1;
 364             $flaginfo{'dateend'}         = $patroninformation->{'debarred'};
 365             $flags{'DBARRED'}           = \%flaginfo;
 366         }
 367     }
 368     if (   $patroninformation->{'borrowernotes'}
 369         && $patroninformation->{'borrowernotes'} )
 370     {
 371         my %flaginfo;
 372         $flaginfo{'message'} = $patroninformation->{'borrowernotes'};
 373         $flags{'NOTES'}      = \%flaginfo;
 374     }
 375     my ( $odues, $itemsoverdue ) = C4::Overdues::checkoverdues($patroninformation->{'borrowernumber'});
 376     if ( $odues && $odues > 0 ) {
 377         my %flaginfo;
 378         $flaginfo{'message'}  = "Yes";
 379         $flaginfo{'itemlist'} = $itemsoverdue;
 380         foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
 381             @$itemsoverdue )
 382         {
 383             $flaginfo{'itemlisttext'} .=
 384               "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n";  # newline is display layer
 385         }
 386         $flags{'ODUES'} = \%flaginfo;
 387     }
 388     my @itemswaiting = C4::Reserves::GetReservesFromBorrowernumber( $patroninformation->{'borrowernumber'},'W' );
 389     my $nowaiting = scalar @itemswaiting;
 390     if ( $nowaiting > 0 ) {
 391         my %flaginfo;
 392         $flaginfo{'message'}  = "Reserved items available";
 393         $flaginfo{'itemlist'} = \@itemswaiting;
 394         $flags{'WAITING'}     = \%flaginfo;
 395     }
 396     return ( \%flags );
 397 }
 398
 399
 400 =head2 GetMember
 401
 402   $borrower = &GetMember(%information);
 403
 404 Retrieve the first patron record meeting on criteria listed in the
 405 C<%information> hash, which should contain one or more
 406 pairs of borrowers column names and values, e.g.,
 407
 408    $borrower = GetMember(borrowernumber => id);
 409
 410 C<&GetBorrower> returns a reference-to-hash whose keys are the fields of
 411 the C<borrowers> table in the Koha database.
 412
 413 FIXME: GetMember() is used throughout the code as a lookup
 414 on a unique key such as the borrowernumber, but this meaning is not
 415 enforced in the routine itself.
 416
 417 =cut
 418
 419 #'
 420 sub GetMember {
 421     my ( %information ) = @_;
 422     if (exists $information{borrowernumber} && !defined $information{borrowernumber}) {
 423         #passing mysql's kohaadmin?? Makes no sense as a query
 424         return;
 425     }
 426     my $dbh = C4::Context->dbh;
 427     my $select =
 428     q{SELECT borrowers.*, categories.category_type, categories.description
 429     FROM borrowers
 430     LEFT JOIN categories on borrowers.categorycode=categories.categorycode WHERE };
 431     my $more_p = 0;
 432     my @values = ();
 433     for (keys %information ) {
 434         if ($more_p) {
 435             $select .= ' AND ';
 436         }
 437         else {
 438             $more_p++;
 439         }
 440
 441         if (defined $information{$_}) {
 442             $select .= "$_ = ?";
 443             push @values, $information{$_};
 444         }
 445         else {
 446             $select .= "$_ IS NULL";
 447         }
 448     }
 449     $debug && warn $select, " ",values %information;
 450     my $sth = $dbh->prepare("$select");
 451     $sth->execute(map{$information{$_}} keys %information);
 452     my $data = $sth->fetchall_arrayref({});
 453     #FIXME interface to this routine now allows generation of a result set
 454     #so whole array should be returned but bowhere in the current code expects this
 455     if (@{$data} ) {
 456         return $data->[0];
 457     }
 458
 459     return;
 460 }
 461
 462 =head2 GetMemberRelatives
 463
 464  @borrowernumbers = GetMemberRelatives($borrowernumber);
 465
 466  C<GetMemberRelatives> returns a borrowersnumber's list of guarantor/guarantees of the member given in parameter
 467
 468 =cut
 469
 470 sub GetMemberRelatives {
 471     my $borrowernumber = shift;
 472     my $dbh = C4::Context->dbh;
 473     my @glist;
 474
 475     # Getting guarantor
 476     my $query = "SELECT guarantorid FROM borrowers WHERE borrowernumber=?";
 477     my $sth = $dbh->prepare($query);
 478     $sth->execute($borrowernumber);
 479     my $data = $sth->fetchrow_arrayref();
 480     push @glist, $data->[0] if $data->[0];
 481     my $guarantor = $data->[0] ? $data->[0] : undef;
 482
 483     # Getting guarantees
 484     $query = "SELECT borrowernumber FROM borrowers WHERE guarantorid=?";
 485     $sth = $dbh->prepare($query);
 486     $sth->execute($borrowernumber);
 487     while ($data = $sth->fetchrow_arrayref()) {
 488        push @glist, $data->[0];
 489     }
 490
 491     # Getting sibling guarantees
 492     if ($guarantor) {
 493         $query = "SELECT borrowernumber FROM borrowers WHERE guarantorid=?";
 494         $sth = $dbh->prepare($query);
 495         $sth->execute($guarantor);
 496         while ($data = $sth->fetchrow_arrayref()) {
 497            push @glist, $data->[0] if ($data->[0] != $borrowernumber);
 498         }
 499     }
 500
 501     return @glist;
 502 }
 503
 504 =head2 IsMemberBlocked
 505
 506   my ($block_status, $count) = IsMemberBlocked( $borrowernumber );
 507
 508 Returns whether a patron is restricted or has overdue items that may result
 509 in a block of circulation privileges.
 510
 511 C<$block_status> can have the following values:
 512
 513 1 if the patron is currently restricted, in which case
 514 C<$count> is the expiration date (9999-12-31 for indefinite)
 515
 516 -1 if the patron has overdue items, in which case C<$count> is the number of them
 517
 518 0 if the patron has no overdue items or outstanding fine days, in which case C<$count> is 0
 519
 520 Existing active restrictions are checked before current overdue items.
 521
 522 =cut
 523
 524 sub IsMemberBlocked {
 525     my $borrowernumber = shift;
 526     my $dbh            = C4::Context->dbh;
 527
 528     my $blockeddate = Koha::Borrower::Debarments::IsDebarred($borrowernumber);
 529
 530     return ( 1, $blockeddate ) if $blockeddate;
 531
 532     # if he have late issues
 533     my $sth = $dbh->prepare(
 534         "SELECT COUNT(*) as latedocs
 535          FROM issues
 536          WHERE borrowernumber = ?
 537          AND date_due < now()"
 538     );
 539     $sth->execute($borrowernumber);
 540     my $latedocs = $sth->fetchrow_hashref->{'latedocs'};
 541
 542     return ( -1, $latedocs ) if $latedocs > 0;
 543
 544     return ( 0, 0 );
 545 }
 546
 547 =head2 GetMemberIssuesAndFines
 548
 549   ($overdue_count, $issue_count, $total_fines) = &GetMemberIssuesAndFines($borrowernumber);
 550
 551 Returns aggregate data about items borrowed by the patron with the
 552 given borrowernumber.
 553
 554 C<&GetMemberIssuesAndFines> returns a three-element array.  C<$overdue_count> is the
 555 number of overdue items the patron currently has borrowed. C<$issue_count> is the
 556 number of books the patron currently has borrowed.  C<$total_fines> is
 557 the total fine currently due by the borrower.
 558
 559 =cut
 560
 561 #'
 562 sub GetMemberIssuesAndFines {
 563     my ( $borrowernumber ) = @_;
 564     my $dbh   = C4::Context->dbh;
 565     my $query = "SELECT COUNT(*) FROM issues WHERE borrowernumber = ?";
 566
 567     $debug and warn $query."\n";
 568     my $sth = $dbh->prepare($query);
 569     $sth->execute($borrowernumber);
 570     my $issue_count = $sth->fetchrow_arrayref->[0];
 571
 572     $sth = $dbh->prepare(
 573         "SELECT COUNT(*) FROM issues
 574          WHERE borrowernumber = ?
 575          AND date_due < now()"
 576     );
 577     $sth->execute($borrowernumber);
 578     my $overdue_count = $sth->fetchrow_arrayref->[0];
 579
 580     $sth = $dbh->prepare("SELECT SUM(amountoutstanding) FROM accountlines WHERE borrowernumber = ?");
 581     $sth->execute($borrowernumber);
 582     my $total_fines = $sth->fetchrow_arrayref->[0];
 583
 584     return ($overdue_count, $issue_count, $total_fines);
 585 }
 586
 587
 588 =head2 columns
 589
 590   my @columns = C4::Member::columns();
 591
 592 Returns an array of borrowers' table columns on success,
 593 and an empty array on failure.
 594
 595 =cut
 596
 597 sub columns {
 598
 599     # Pure ANSI SQL goodness.
 600     my $sql = 'SELECT * FROM borrowers WHERE 1=0;';
 601
 602     # Get the database handle.
 603     my $dbh = C4::Context->dbh;
 604
 605     # Run the SQL statement to load STH's readonly properties.
 606     my $sth = $dbh->prepare($sql);
 607     my $rv = $sth->execute();
 608
 609     # This only fails if the table doesn't exist.
 610     # This will always be called AFTER an install or upgrade,
 611     # so borrowers will exist!
 612     my @data;
 613     if ($sth->{NUM_OF_FIELDS}>0) {
 614         @data = @{$sth->{NAME}};
 615     }
 616     else {
 617         @data = ();
 618     }
 619     return @data;
 620 }
 621
 622
 623 =head2 ModMember
 624
 625   my $success = ModMember(borrowernumber => $borrowernumber,
 626                                             [ field => value ]... );
 627
 628 Modify borrower's data.  All date fields should ALREADY be in ISO format.
 629
 630 return :
 631 true on success, or false on failure
 632
 633 =cut
 634
 635 sub ModMember {
 636     my (%data) = @_;
 637     # test to know if you must update or not the borrower password
 638     if (exists $data{password}) {
 639         if ($data{password} eq '****' or $data{password} eq '') {
 640             delete $data{password};
 641         } else {
 642             if ( C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
 643                 # Update the hashed PIN in borrower_sync.hashed_pin, before Koha hashes it
 644                 Koha::NorwegianPatronDB::NLUpdateHashedPIN( $data{'borrowernumber'}, $data{password} );
 645             }
 646             $data{password} = hash_password($data{password});
 647         }
 648     }
 649
 650     my $old_categorycode = GetBorrowerCategorycode( $data{borrowernumber} );
 651
 652     # get only the columns of a borrower
 653     my $schema = Koha::Database->new()->schema;
 654     my @columns = $schema->source('Borrower')->columns;
 655     my $new_borrower = { map { join(' ', @columns) =~ /$_/ ? ( $_ => $data{$_} ) : () } keys(%data) };
 656     delete $new_borrower->{flags};
 657
 658     $new_borrower->{dateofbirth}     ||= undef if exists $new_borrower->{dateofbirth};
 659     $new_borrower->{dateenrolled}    ||= undef if exists $new_borrower->{dateenrolled};
 660     $new_borrower->{dateexpiry}      ||= undef if exists $new_borrower->{dateexpiry};
 661     $new_borrower->{debarred}        ||= undef if exists $new_borrower->{debarred};
 662     $new_borrower->{sms_provider_id} ||= undef if exists $new_borrower->{sms_provider_id};
 663
 664     my $rs = $schema->resultset('Borrower')->search({
 665         borrowernumber => $new_borrower->{borrowernumber},
 666      });
 667
 668     my $execute_success = $rs->update($new_borrower);
 669     if ($execute_success ne '0E0') { # only proceed if the update was a success
 670
 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 += int(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     return ( $min, $max );
1364 }
1365
1366 =head2 getzipnamecity (OUEST-PROVENCE)
1367
1368 take all info from table city for the fields city and  zip
1369 check for the name and the zip code of the city selected
1370
1371 =cut
1372
1373 sub getzipnamecity {
1374     my ($cityid) = @_;
1375     my $dbh      = C4::Context->dbh;
1376     my $sth      =
1377       $dbh->prepare(
1378         "select city_name,city_state,city_zipcode,city_country from cities where cityid=? ");
1379     $sth->execute($cityid);
1380     my @data = $sth->fetchrow;
1381     return $data[0], $data[1], $data[2], $data[3];
1382 }
1383
1384
1385 =head2 getdcity (OUEST-PROVENCE)
1386
1387 recover cityid  with city_name condition
1388
1389 =cut
1390
1391 sub getidcity {
1392     my ($city_name) = @_;
1393     my $dbh = C4::Context->dbh;
1394     my $sth = $dbh->prepare("select cityid from cities where city_name=? ");
1395     $sth->execute($city_name);
1396     my $data = $sth->fetchrow;
1397     return $data;
1398 }
1399
1400 =head2 GetFirstValidEmailAddress
1401
1402   $email = GetFirstValidEmailAddress($borrowernumber);
1403
1404 Return the first valid email address for a borrower, given the borrowernumber.  For now, the order
1405 is defined as email, emailpro, B_email.  Returns the empty string if the borrower has no email
1406 addresses.
1407
1408 =cut
1409
1410 sub GetFirstValidEmailAddress {
1411     my $borrowernumber = shift;
1412     my $dbh = C4::Context->dbh;
1413     my $sth = $dbh->prepare( "SELECT email, emailpro, B_email FROM borrowers where borrowernumber = ? ");
1414     $sth->execute( $borrowernumber );
1415     my $data = $sth->fetchrow_hashref;
1416
1417     if ($data->{'email'}) {
1418        return $data->{'email'};
1419     } elsif ($data->{'emailpro'}) {
1420        return $data->{'emailpro'};
1421     } elsif ($data->{'B_email'}) {
1422        return $data->{'B_email'};
1423     } else {
1424        return '';
1425     }
1426 }
1427
1428 =head2 GetNoticeEmailAddress
1429
1430   $email = GetNoticeEmailAddress($borrowernumber);
1431
1432 Return the email address of borrower used for notices, given the borrowernumber.
1433 Returns the empty string if no email address.
1434
1435 =cut
1436
1437 sub GetNoticeEmailAddress {
1438     my $borrowernumber = shift;
1439
1440     my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
1441     # if syspref is set to 'first valid' (value == OFF), look up email address
1442     if ( $which_address eq 'OFF' ) {
1443         return GetFirstValidEmailAddress($borrowernumber);
1444     }
1445     # specified email address field
1446     my $dbh = C4::Context->dbh;
1447     my $sth = $dbh->prepare( qq{
1448         SELECT $which_address AS primaryemail
1449         FROM borrowers
1450         WHERE borrowernumber=?
1451     } );
1452     $sth->execute($borrowernumber);
1453     my $data = $sth->fetchrow_hashref;
1454     return $data->{'primaryemail'} || '';
1455 }
1456
1457 =head2 GetExpiryDate
1458
1459   $expirydate = GetExpiryDate($categorycode, $dateenrolled);
1460
1461 Calculate expiry date given a categorycode and starting date.  Date argument must be in ISO format.
1462 Return date is also in ISO format.
1463
1464 =cut
1465
1466 sub GetExpiryDate {
1467     my ( $categorycode, $dateenrolled ) = @_;
1468     my $enrolments;
1469     if ($categorycode) {
1470         my $dbh = C4::Context->dbh;
1471         my $sth = $dbh->prepare("SELECT enrolmentperiod,enrolmentperioddate FROM categories WHERE categorycode=?");
1472         $sth->execute($categorycode);
1473         $enrolments = $sth->fetchrow_hashref;
1474     }
1475     # die "GetExpiryDate: for enrollmentperiod $enrolmentperiod (category '$categorycode') starting $dateenrolled.\n";
1476     my @date = split (/-/,$dateenrolled);
1477     if($enrolments->{enrolmentperiod}){
1478         return sprintf("%04d-%02d-%02d", Add_Delta_YM(@date,0,$enrolments->{enrolmentperiod}));
1479     }else{
1480         return $enrolments->{enrolmentperioddate};
1481     }
1482 }
1483
1484 =head2 GetUpcomingMembershipExpires
1485
1486   my $upcoming_mem_expires = GetUpcomingMembershipExpires();
1487
1488 =cut
1489
1490 sub GetUpcomingMembershipExpires {
1491     my $dbh = C4::Context->dbh;
1492     my $days = C4::Context->preference("MembershipExpiryDaysNotice") || 0;
1493     my $dateexpiry = output_pref({ dt => (dt_from_string()->add( days => $days)), dateformat => 'iso', dateonly => 1 });
1494
1495     my $query = "
1496         SELECT borrowers.*, categories.description,
1497         branches.branchname, branches.branchemail FROM borrowers
1498         LEFT JOIN branches on borrowers.branchcode = branches.branchcode
1499         LEFT JOIN categories on borrowers.categorycode = categories.categorycode
1500         WHERE dateexpiry = ?;
1501     ";
1502     my $sth = $dbh->prepare($query);
1503     $sth->execute($dateexpiry);
1504     my $results = $sth->fetchall_arrayref({});
1505     return $results;
1506 }
1507
1508 =head2 GetborCatFromCatType
1509
1510   ($codes_arrayref, $labels_hashref) = &GetborCatFromCatType();
1511
1512 Looks up the different types of borrowers in the database. Returns two
1513 elements: a reference-to-array, which lists the borrower category
1514 codes, and a reference-to-hash, which maps the borrower category codes
1515 to category descriptions.
1516
1517 =cut
1518
1519 #'
1520 sub GetborCatFromCatType {
1521     my ( $category_type, $action, $no_branch_limit ) = @_;
1522
1523     my $branch_limit = $no_branch_limit
1524         ? 0
1525         : C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1526
1527     # FIXME - This API  seems both limited and dangerous.
1528     my $dbh     = C4::Context->dbh;
1529
1530     my $request = qq{
1531         SELECT categories.categorycode, categories.description
1532         FROM categories
1533     };
1534     $request .= qq{
1535         LEFT JOIN categories_branches ON categories.categorycode = categories_branches.categorycode
1536     } if $branch_limit;
1537     if($action) {
1538         $request .= " $action ";
1539         $request .= " AND (branchcode = ? OR branchcode IS NULL) GROUP BY description" if $branch_limit;
1540     } else {
1541         $request .= " WHERE branchcode = ? OR branchcode IS NULL GROUP BY description" if $branch_limit;
1542     }
1543     $request .= " ORDER BY categorycode";
1544
1545     my $sth = $dbh->prepare($request);
1546     $sth->execute(
1547         $action ? $category_type : (),
1548         $branch_limit ? $branch_limit : ()
1549     );
1550
1551     my %labels;
1552     my @codes;
1553
1554     while ( my $data = $sth->fetchrow_hashref ) {
1555         push @codes, $data->{'categorycode'};
1556         $labels{ $data->{'categorycode'} } = $data->{'description'};
1557     }
1558     $sth->finish;
1559     return ( \@codes, \%labels );
1560 }
1561
1562 =head2 GetBorrowercategory
1563
1564   $hashref = &GetBorrowercategory($categorycode);
1565
1566 Given the borrower's category code, the function returns the corresponding
1567 data hashref for a comprehensive information display.
1568
1569 =cut
1570
1571 sub GetBorrowercategory {
1572     my ($catcode) = @_;
1573     my $dbh       = C4::Context->dbh;
1574     if ($catcode){
1575         my $sth       =
1576         $dbh->prepare(
1577     "SELECT description,dateofbirthrequired,upperagelimit,category_type
1578     FROM categories
1579     WHERE categorycode = ?"
1580         );
1581         $sth->execute($catcode);
1582         my $data =
1583         $sth->fetchrow_hashref;
1584         return $data;
1585     }
1586     return;
1587 }    # sub getborrowercategory
1588
1589
1590 =head2 GetBorrowerCategorycode
1591
1592     $categorycode = &GetBorrowerCategoryCode( $borrowernumber );
1593
1594 Given the borrowernumber, the function returns the corresponding categorycode
1595
1596 =cut
1597
1598 sub GetBorrowerCategorycode {
1599     my ( $borrowernumber ) = @_;
1600     my $dbh = C4::Context->dbh;
1601     my $sth = $dbh->prepare( qq{
1602         SELECT categorycode
1603         FROM borrowers
1604         WHERE borrowernumber = ?
1605     } );
1606     $sth->execute( $borrowernumber );
1607     return $sth->fetchrow;
1608 }
1609
1610 =head2 GetBorrowercategoryList
1611
1612   $arrayref_hashref = &GetBorrowercategoryList;
1613 If no category code provided, the function returns all the categories.
1614
1615 =cut
1616
1617 sub GetBorrowercategoryList {
1618     my $no_branch_limit = @_ ? shift : 0;
1619     my $branch_limit = $no_branch_limit
1620         ? 0
1621         : C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1622     my $dbh       = C4::Context->dbh;
1623     my $query = "SELECT categories.* FROM categories";
1624     $query .= qq{
1625         LEFT JOIN categories_branches ON categories.categorycode = categories_branches.categorycode
1626         WHERE branchcode = ? OR branchcode IS NULL GROUP BY description
1627     } if $branch_limit;
1628     $query .= " ORDER BY description";
1629     my $sth = $dbh->prepare( $query );
1630     $sth->execute( $branch_limit ? $branch_limit : () );
1631     my $data = $sth->fetchall_arrayref( {} );
1632     $sth->finish;
1633     return $data;
1634 }    # sub getborrowercategory
1635
1636 =head2 GetAge
1637
1638   $dateofbirth,$date = &GetAge($date);
1639
1640 this function return the borrowers age with the value of dateofbirth
1641
1642 =cut
1643
1644 #'
1645 sub GetAge{
1646     my ( $date, $date_ref ) = @_;
1647
1648     if ( not defined $date_ref ) {
1649         $date_ref = sprintf( '%04d-%02d-%02d', Today() );
1650     }
1651
1652     my ( $year1, $month1, $day1 ) = split /-/, $date;
1653     my ( $year2, $month2, $day2 ) = split /-/, $date_ref;
1654
1655     my $age = $year2 - $year1;
1656     if ( $month1 . $day1 > $month2 . $day2 ) {
1657         $age--;
1658     }
1659
1660     return $age;
1661 }    # sub get_age
1662
1663 =head2 SetAge
1664
1665   $borrower = C4::Members::SetAge($borrower, $datetimeduration);
1666   $borrower = C4::Members::SetAge($borrower, '0015-12-10');
1667   $borrower = C4::Members::SetAge($borrower, $datetimeduration, $datetime_reference);
1668
1669   eval { $borrower = C4::Members::SetAge($borrower, '015-1-10'); };
1670   if ($@) {print $@;} #Catch a bad ISO Date or kill your script!
1671
1672 This function sets the borrower's dateofbirth to match the given age.
1673 Optionally relative to the given $datetime_reference.
1674
1675 @PARAM1 koha.borrowers-object
1676 @PARAM2 DateTime::Duration-object as the desired age
1677         OR a ISO 8601 Date. (To make the API more pleasant)
1678 @PARAM3 DateTime-object as the relative date, defaults to now().
1679 RETURNS The given borrower reference @PARAM1.
1680 DIES    If there was an error with the ISO Date handling.
1681
1682 =cut
1683
1684 #'
1685 sub SetAge{
1686     my ( $borrower, $datetimeduration, $datetime_ref ) = @_;
1687     $datetime_ref = DateTime->now() unless $datetime_ref;
1688
1689     if ($datetimeduration && ref $datetimeduration ne 'DateTime::Duration') {
1690         if ($datetimeduration =~ /^(\d{4})-(\d{2})-(\d{2})/) {
1691             $datetimeduration = DateTime::Duration->new(years => $1, months => $2, days => $3);
1692         }
1693         else {
1694             die "C4::Members::SetAge($borrower, $datetimeduration), datetimeduration not a valid ISO 8601 Date!\n";
1695         }
1696     }
1697
1698     my $new_datetime_ref = $datetime_ref->clone();
1699     $new_datetime_ref->subtract_duration( $datetimeduration );
1700
1701     $borrower->{dateofbirth} = $new_datetime_ref->ymd();
1702
1703     return $borrower;
1704 }    # sub SetAge
1705
1706 =head2 GetCities
1707
1708   $cityarrayref = GetCities();
1709
1710   Returns an array_ref of the entries in the cities table
1711   If there are entries in the table an empty row is returned
1712   This is currently only used to populate a popup in memberentry
1713
1714 =cut
1715
1716 sub GetCities {
1717
1718     my $dbh   = C4::Context->dbh;
1719     my $city_arr = $dbh->selectall_arrayref(
1720         q|SELECT cityid,city_zipcode,city_name,city_state,city_country FROM cities ORDER BY city_name|,
1721         { Slice => {} });
1722     if ( @{$city_arr} ) {
1723         unshift @{$city_arr}, {
1724             city_zipcode => q{},
1725             city_name    => q{},
1726             cityid       => q{},
1727             city_state   => q{},
1728             city_country => q{},
1729         };
1730     }
1731
1732     return  $city_arr;
1733 }
1734
1735 =head2 GetSortDetails (OUEST-PROVENCE)
1736
1737   ($lib) = &GetSortDetails($category,$sortvalue);
1738
1739 Returns the authorized value  details
1740 C<&$lib>return value of authorized value details
1741 C<&$sortvalue>this is the value of authorized value
1742 C<&$category>this is the value of authorized value category
1743
1744 =cut
1745
1746 sub GetSortDetails {
1747     my ( $category, $sortvalue ) = @_;
1748     my $dbh   = C4::Context->dbh;
1749     my $query = qq|SELECT lib
1750         FROM authorised_values
1751         WHERE category=?
1752         AND authorised_value=? |;
1753     my $sth = $dbh->prepare($query);
1754     $sth->execute( $category, $sortvalue );
1755     my $lib = $sth->fetchrow;
1756     return ($lib) if ($lib);
1757     return ($sortvalue) unless ($lib);
1758 }
1759
1760 =head2 MoveMemberToDeleted
1761
1762   $result = &MoveMemberToDeleted($borrowernumber);
1763
1764 Copy the record from borrowers to deletedborrowers table.
1765 The routine returns 1 for success, undef for failure.
1766
1767 =cut
1768
1769 sub MoveMemberToDeleted {
1770     my ($member) = shift or return;
1771
1772     my $schema       = Koha::Database->new()->schema();
1773     my $borrowers_rs = $schema->resultset('Borrower');
1774     $borrowers_rs->result_class('DBIx::Class::ResultClass::HashRefInflator');
1775     my $borrower = $borrowers_rs->find($member);
1776     return unless $borrower;
1777
1778     my $deleted = $schema->resultset('Deletedborrower')->create($borrower);
1779
1780     return $deleted ? 1 : undef;
1781 }
1782
1783 =head2 DelMember
1784
1785     DelMember($borrowernumber);
1786
1787 This function remove directly a borrower whitout writing it on deleteborrower.
1788 + Deletes reserves for the borrower
1789
1790 =cut
1791
1792 sub DelMember {
1793     my $dbh            = C4::Context->dbh;
1794     my $borrowernumber = shift;
1795     #warn "in delmember with $borrowernumber";
1796     return unless $borrowernumber;    # borrowernumber is mandatory.
1797
1798     my $query = qq|DELETE
1799           FROM  reserves
1800           WHERE borrowernumber=?|;
1801     my $sth = $dbh->prepare($query);
1802     $sth->execute($borrowernumber);
1803     $query = "
1804        DELETE
1805        FROM borrowers
1806        WHERE borrowernumber = ?
1807    ";
1808     $sth = $dbh->prepare($query);
1809     $sth->execute($borrowernumber);
1810     logaction("MEMBERS", "DELETE", $borrowernumber, "") if C4::Context->preference("BorrowersLog");
1811     return $sth->rows;
1812 }
1813
1814 =head2 HandleDelBorrower
1815
1816      HandleDelBorrower($borrower);
1817
1818 When a member is deleted (DelMember in Members.pm), you should call me first.
1819 This routine deletes/moves lists and entries for the deleted member/borrower.
1820 Lists owned by the borrower are deleted, but entries from the borrower to
1821 other lists are kept.
1822
1823 =cut
1824
1825 sub HandleDelBorrower {
1826     my ($borrower)= @_;
1827     my $query;
1828     my $dbh = C4::Context->dbh;
1829
1830     #Delete all lists and all shares of this borrower
1831     #Consistent with the approach Koha uses on deleting individual lists
1832     #Note that entries in virtualshelfcontents added by this borrower to
1833     #lists of others will be handled by a table constraint: the borrower
1834     #is set to NULL in those entries.
1835     $query="DELETE FROM virtualshelves WHERE owner=?";
1836     $dbh->do($query,undef,($borrower));
1837
1838     #NOTE:
1839     #We could handle the above deletes via a constraint too.
1840     #But a new BZ report 11889 has been opened to discuss another approach.
1841     #Instead of deleting we could also disown lists (based on a pref).
1842     #In that way we could save shared and public lists.
1843     #The current table constraints support that idea now.
1844     #This pref should then govern the results of other routines/methods such as
1845     #Koha::Virtualshelf->new->delete too.
1846 }
1847
1848 =head2 ExtendMemberSubscriptionTo (OUEST-PROVENCE)
1849
1850     $date = ExtendMemberSubscriptionTo($borrowerid, $date);
1851
1852 Extending the subscription to a given date or to the expiry date calculated on ISO date.
1853 Returns ISO date.
1854
1855 =cut
1856
1857 sub ExtendMemberSubscriptionTo {
1858     my ( $borrowerid,$date) = @_;
1859     my $dbh = C4::Context->dbh;
1860     my $borrower = GetMember('borrowernumber'=>$borrowerid);
1861     unless ($date){
1862       $date = (C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry') ?
1863                                         eval { output_pref( { dt => dt_from_string( $borrower->{'dateexpiry'}  ), dateonly => 1, dateformat => 'iso' } ); }
1864                                         :
1865                                         output_pref( { dt => dt_from_string, dateonly => 1, dateformat => 'iso' } );
1866       $date = GetExpiryDate( $borrower->{'categorycode'}, $date );
1867     }
1868     my $sth = $dbh->do(<<EOF);
1869 UPDATE borrowers
1870 SET  dateexpiry='$date'
1871 WHERE borrowernumber='$borrowerid'
1872 EOF
1873
1874     AddEnrolmentFeeIfNeeded( $borrower->{categorycode}, $borrower->{borrowernumber} );
1875
1876     logaction("MEMBERS", "RENEW", $borrower->{'borrowernumber'}, "Membership renewed")if C4::Context->preference("BorrowersLog");
1877     return $date if ($sth);
1878     return 0;
1879 }
1880
1881 =head2 GetTitles (OUEST-PROVENCE)
1882
1883   ($borrowertitle)= &GetTitles();
1884
1885 Looks up the different title . Returns array  with all borrowers title
1886
1887 =cut
1888
1889 sub GetTitles {
1890     my @borrowerTitle = split (/,|\|/,C4::Context->preference('BorrowersTitles'));
1891     unshift( @borrowerTitle, "" );
1892     my $count=@borrowerTitle;
1893     if ($count == 1){
1894         return ();
1895     }
1896     else {
1897         return ( \@borrowerTitle);
1898     }
1899 }
1900
1901 =head2 GetPatronImage
1902
1903     my ($imagedata, $dberror) = GetPatronImage($borrowernumber);
1904
1905 Returns the mimetype and binary image data of the image for the patron with the supplied borrowernumber.
1906
1907 =cut
1908
1909 sub GetPatronImage {
1910     my ($borrowernumber) = @_;
1911     warn "Borrowernumber passed to GetPatronImage is $borrowernumber" if $debug;
1912     my $dbh = C4::Context->dbh;
1913     my $query = 'SELECT mimetype, imagefile FROM patronimage WHERE borrowernumber = ?';
1914     my $sth = $dbh->prepare($query);
1915     $sth->execute($borrowernumber);
1916     my $imagedata = $sth->fetchrow_hashref;
1917     warn "Database error!" if $sth->errstr;
1918     return $imagedata, $sth->errstr;
1919 }
1920
1921 =head2 PutPatronImage
1922
1923     PutPatronImage($cardnumber, $mimetype, $imgfile);
1924
1925 Stores patron binary image data and mimetype in database.
1926 NOTE: This function is good for updating images as well as inserting new images in the database.
1927
1928 =cut
1929
1930 sub PutPatronImage {
1931     my ($cardnumber, $mimetype, $imgfile) = @_;
1932     warn "Parameters passed in: Cardnumber=$cardnumber, Mimetype=$mimetype, " . ($imgfile ? "Imagefile" : "No Imagefile") if $debug;
1933     my $dbh = C4::Context->dbh;
1934     my $query = "INSERT INTO patronimage (borrowernumber, mimetype, imagefile) VALUES ( ( SELECT borrowernumber from borrowers WHERE cardnumber = ? ),?,?) ON DUPLICATE KEY UPDATE imagefile = ?;";
1935     my $sth = $dbh->prepare($query);
1936     $sth->execute($cardnumber,$mimetype,$imgfile,$imgfile);
1937     warn "Error returned inserting $cardnumber.$mimetype." if $sth->errstr;
1938     return $sth->errstr;
1939 }
1940
1941 =head2 RmPatronImage
1942
1943     my ($dberror) = RmPatronImage($borrowernumber);
1944
1945 Removes the image for the patron with the supplied borrowernumber.
1946
1947 =cut
1948
1949 sub RmPatronImage {
1950     my ($borrowernumber) = @_;
1951     warn "Borrowernumber passed to GetPatronImage is $borrowernumber" if $debug;
1952     my $dbh = C4::Context->dbh;
1953     my $query = "DELETE FROM patronimage WHERE borrowernumber = ?;";
1954     my $sth = $dbh->prepare($query);
1955     $sth->execute($borrowernumber);
1956     my $dberror = $sth->errstr;
1957     warn "Database error!" if $sth->errstr;
1958     return $dberror;
1959 }
1960
1961 =head2 GetHideLostItemsPreference
1962
1963   $hidelostitemspref = &GetHideLostItemsPreference($borrowernumber);
1964
1965 Returns the HideLostItems preference for the patron category of the supplied borrowernumber
1966 C<&$hidelostitemspref>return value of function, 0 or 1
1967
1968 =cut
1969
1970 sub GetHideLostItemsPreference {
1971     my ($borrowernumber) = @_;
1972     my $dbh = C4::Context->dbh;
1973     my $query = "SELECT hidelostitems FROM borrowers,categories WHERE borrowers.categorycode = categories.categorycode AND borrowernumber = ?";
1974     my $sth = $dbh->prepare($query);
1975     $sth->execute($borrowernumber);
1976     my $hidelostitems = $sth->fetchrow;
1977     return $hidelostitems;
1978 }
1979
1980 =head2 GetBorrowersToExpunge
1981
1982   $borrowers = &GetBorrowersToExpunge(
1983       not_borrowered_since => $not_borrowered_since,
1984       expired_before       => $expired_before,
1985       category_code        => $category_code,
1986       branchcode           => $branchcode
1987   );
1988
1989   This function get all borrowers based on the given criteria.
1990
1991 =cut
1992
1993 sub GetBorrowersToExpunge {
1994     my $params = shift;
1995
1996     my $filterdate     = $params->{'not_borrowered_since'};
1997     my $filterexpiry   = $params->{'expired_before'};
1998     my $filtercategory = $params->{'category_code'};
1999     my $filterbranch   = $params->{'branchcode'} ||
2000                         ((C4::Context->preference('IndependentBranches')
2001                              && C4::Context->userenv
2002                              && !C4::Context->IsSuperLibrarian()
2003                              && C4::Context->userenv->{branch})
2004                          ? C4::Context->userenv->{branch}
2005                          : "");
2006
2007     my $dbh   = C4::Context->dbh;
2008     my $query = q|
2009         SELECT borrowers.borrowernumber,
2010                MAX(old_issues.timestamp) AS latestissue,
2011                MAX(issues.timestamp) AS currentissue
2012         FROM   borrowers
2013         JOIN   categories USING (categorycode)
2014         LEFT JOIN (
2015             SELECT guarantorid
2016             FROM borrowers
2017             WHERE guarantorid IS NOT NULL
2018                 AND guarantorid <> 0
2019         ) as tmp ON borrowers.borrowernumber=tmp.guarantorid
2020         LEFT JOIN old_issues USING (borrowernumber)
2021         LEFT JOIN issues USING (borrowernumber)
2022         WHERE  category_type <> 'S'
2023         AND tmp.guarantorid IS NULL
2024    |;
2025
2026     my @query_params;
2027     if ( $filterbranch && $filterbranch ne "" ) {
2028         $query.= " AND borrowers.branchcode = ? ";
2029         push( @query_params, $filterbranch );
2030     }
2031     if ( $filterexpiry ) {
2032         $query .= " AND dateexpiry < ? ";
2033         push( @query_params, $filterexpiry );
2034     }
2035     if ( $filtercategory ) {
2036         $query .= " AND categorycode = ? ";
2037         push( @query_params, $filtercategory );
2038     }
2039     $query.=" GROUP BY borrowers.borrowernumber HAVING currentissue IS NULL ";
2040     if ( $filterdate ) {
2041         $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
2042         push @query_params,$filterdate;
2043     }
2044     warn $query if $debug;
2045
2046     my $sth = $dbh->prepare($query);
2047     if (scalar(@query_params)>0){
2048         $sth->execute(@query_params);
2049     }
2050     else {
2051         $sth->execute;
2052     }
2053
2054     my @results;
2055     while ( my $data = $sth->fetchrow_hashref ) {
2056         push @results, $data;
2057     }
2058     return \@results;
2059 }
2060
2061 =head2 GetBorrowersWhoHaveNeverBorrowed
2062
2063   $results = &GetBorrowersWhoHaveNeverBorrowed
2064
2065 This function get all borrowers who have never borrowed.
2066
2067 I<$result> is a ref to an array which all elements are a hasref.
2068
2069 =cut
2070
2071 sub GetBorrowersWhoHaveNeverBorrowed {
2072     my $filterbranch = shift ||
2073                         ((C4::Context->preference('IndependentBranches')
2074                              && C4::Context->userenv
2075                              && !C4::Context->IsSuperLibrarian()
2076                              && C4::Context->userenv->{branch})
2077                          ? C4::Context->userenv->{branch}
2078                          : "");
2079     my $dbh   = C4::Context->dbh;
2080     my $query = "
2081         SELECT borrowers.borrowernumber,max(timestamp) as latestissue
2082         FROM   borrowers
2083           LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
2084         WHERE issues.borrowernumber IS NULL
2085    ";
2086     my @query_params;
2087     if ($filterbranch && $filterbranch ne ""){
2088         $query.=" AND borrowers.branchcode= ?";
2089         push @query_params,$filterbranch;
2090     }
2091     warn $query if $debug;
2092
2093     my $sth = $dbh->prepare($query);
2094     if (scalar(@query_params)>0){
2095         $sth->execute(@query_params);
2096     }
2097     else {
2098         $sth->execute;
2099     }
2100
2101     my @results;
2102     while ( my $data = $sth->fetchrow_hashref ) {
2103         push @results, $data;
2104     }
2105     return \@results;
2106 }
2107
2108 =head2 GetBorrowersWithIssuesHistoryOlderThan
2109
2110   $results = &GetBorrowersWithIssuesHistoryOlderThan($date)
2111
2112 this function get all borrowers who has an issue history older than I<$date> given on input arg.
2113
2114 I<$result> is a ref to an array which all elements are a hashref.
2115 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
2116
2117 =cut
2118
2119 sub GetBorrowersWithIssuesHistoryOlderThan {
2120     my $dbh  = C4::Context->dbh;
2121     my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime());
2122     my $filterbranch = shift ||
2123                         ((C4::Context->preference('IndependentBranches')
2124                              && C4::Context->userenv
2125                              && !C4::Context->IsSuperLibrarian()
2126                              && C4::Context->userenv->{branch})
2127                          ? C4::Context->userenv->{branch}
2128                          : "");
2129     my $query = "
2130        SELECT count(borrowernumber) as n,borrowernumber
2131        FROM old_issues
2132        WHERE returndate < ?
2133          AND borrowernumber IS NOT NULL
2134     ";
2135     my @query_params;
2136     push @query_params, $date;
2137     if ($filterbranch){
2138         $query.="   AND branchcode = ?";
2139         push @query_params, $filterbranch;
2140     }
2141     $query.=" GROUP BY borrowernumber ";
2142     warn $query if $debug;
2143     my $sth = $dbh->prepare($query);
2144     $sth->execute(@query_params);
2145     my @results;
2146
2147     while ( my $data = $sth->fetchrow_hashref ) {
2148         push @results, $data;
2149     }
2150     return \@results;
2151 }
2152
2153 =head2 GetBorrowersNamesAndLatestIssue
2154
2155   $results = &GetBorrowersNamesAndLatestIssueList(@borrowernumbers)
2156
2157 this function get borrowers Names and surnames and Issue information.
2158
2159 I<@borrowernumbers> is an array which all elements are borrowernumbers.
2160 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
2161
2162 =cut
2163
2164 sub GetBorrowersNamesAndLatestIssue {
2165     my $dbh  = C4::Context->dbh;
2166     my @borrowernumbers=@_;
2167     my $query = "
2168        SELECT surname,lastname, phone, email,max(timestamp)
2169        FROM borrowers
2170          LEFT JOIN issues ON borrowers.borrowernumber=issues.borrowernumber
2171        GROUP BY borrowernumber
2172    ";
2173     my $sth = $dbh->prepare($query);
2174     $sth->execute;
2175     my $results = $sth->fetchall_arrayref({});
2176     return $results;
2177 }
2178
2179 =head2 ModPrivacy
2180
2181   my $success = ModPrivacy( $borrowernumber, $privacy );
2182
2183 Update the privacy of a patron.
2184
2185 return :
2186 true on success, false on failure
2187
2188 =cut
2189
2190 sub ModPrivacy {
2191     my $borrowernumber = shift;
2192     my $privacy = shift;
2193     return unless defined $borrowernumber;
2194     return unless $borrowernumber =~ /^\d+$/;
2195
2196     return ModMember( borrowernumber => $borrowernumber,
2197                       privacy        => $privacy );
2198 }
2199
2200 =head2 AddMessage
2201
2202   AddMessage( $borrowernumber, $message_type, $message, $branchcode );
2203
2204 Adds a message to the messages table for the given borrower.
2205
2206 Returns:
2207   True on success
2208   False on failure
2209
2210 =cut
2211
2212 sub AddMessage {
2213     my ( $borrowernumber, $message_type, $message, $branchcode ) = @_;
2214
2215     my $dbh  = C4::Context->dbh;
2216
2217     if ( ! ( $borrowernumber && $message_type && $message && $branchcode ) ) {
2218       return;
2219     }
2220
2221     my $query = "INSERT INTO messages ( borrowernumber, branchcode, message_type, message ) VALUES ( ?, ?, ?, ? )";
2222     my $sth = $dbh->prepare($query);
2223     $sth->execute( $borrowernumber, $branchcode, $message_type, $message );
2224     logaction("MEMBERS", "ADDCIRCMESSAGE", $borrowernumber, $message) if C4::Context->preference("BorrowersLog");
2225     return 1;
2226 }
2227
2228 =head2 GetMessages
2229
2230   GetMessages( $borrowernumber, $type );
2231
2232 $type is message type, B for borrower, or L for Librarian.
2233 Empty type returns all messages of any type.
2234
2235 Returns all messages for the given borrowernumber
2236
2237 =cut
2238
2239 sub GetMessages {
2240     my ( $borrowernumber, $type, $branchcode ) = @_;
2241
2242     if ( ! $type ) {
2243       $type = '%';
2244     }
2245
2246     my $dbh  = C4::Context->dbh;
2247
2248     my $query = "SELECT
2249                   branches.branchname,
2250                   messages.*,
2251                   message_date,
2252                   messages.branchcode LIKE '$branchcode' AS can_delete
2253                   FROM messages, branches
2254                   WHERE borrowernumber = ?
2255                   AND message_type LIKE ?
2256                   AND messages.branchcode = branches.branchcode
2257                   ORDER BY message_date DESC";
2258     my $sth = $dbh->prepare($query);
2259     $sth->execute( $borrowernumber, $type ) ;
2260     my @results;
2261
2262     while ( my $data = $sth->fetchrow_hashref ) {
2263         $data->{message_date_formatted} = output_pref( { dt => dt_from_string( $data->{message_date} ), dateonly => 1, dateformat => 'iso' } );
2264         push @results, $data;
2265     }
2266     return \@results;
2267
2268 }
2269
2270 =head2 GetMessages
2271
2272   GetMessagesCount( $borrowernumber, $type );
2273
2274 $type is message type, B for borrower, or L for Librarian.
2275 Empty type returns all messages of any type.
2276
2277 Returns the number of messages for the given borrowernumber
2278
2279 =cut
2280
2281 sub GetMessagesCount {
2282     my ( $borrowernumber, $type, $branchcode ) = @_;
2283
2284     if ( ! $type ) {
2285       $type = '%';
2286     }
2287
2288     my $dbh  = C4::Context->dbh;
2289
2290     my $query = "SELECT COUNT(*) as MsgCount FROM messages WHERE borrowernumber = ? AND message_type LIKE ?";
2291     my $sth = $dbh->prepare($query);
2292     $sth->execute( $borrowernumber, $type ) ;
2293     my @results;
2294
2295     my $data = $sth->fetchrow_hashref;
2296     my $count = $data->{'MsgCount'};
2297
2298     return $count;
2299 }
2300
2301
2302
2303 =head2 DeleteMessage
2304
2305   DeleteMessage( $message_id );
2306
2307 =cut
2308
2309 sub DeleteMessage {
2310     my ( $message_id ) = @_;
2311
2312     my $dbh = C4::Context->dbh;
2313     my $query = "SELECT * FROM messages WHERE message_id = ?";
2314     my $sth = $dbh->prepare($query);
2315     $sth->execute( $message_id );
2316     my $message = $sth->fetchrow_hashref();
2317
2318     $query = "DELETE FROM messages WHERE message_id = ?";
2319     $sth = $dbh->prepare($query);
2320     $sth->execute( $message_id );
2321     logaction("MEMBERS", "DELCIRCMESSAGE", $message->{'borrowernumber'}, $message->{'message'}) if C4::Context->preference("BorrowersLog");
2322 }
2323
2324 =head2 IssueSlip
2325
2326   IssueSlip($branchcode, $borrowernumber, $quickslip)
2327
2328   Returns letter hash ( see C4::Letters::GetPreparedLetter )
2329
2330   $quickslip is boolean, to indicate whether we want a quick slip
2331
2332   IssueSlip populates ISSUESLIP and ISSUEQSLIP, and will make the following expansions:
2333
2334   Both slips:
2335
2336       <<branches.*>>
2337       <<borrowers.*>>
2338
2339   ISSUESLIP:
2340
2341       <checkedout>
2342          <<biblio.*>>
2343          <<items.*>>
2344          <<biblioitems.*>>
2345          <<issues.*>>
2346       </checkedout>
2347
2348       <overdue>
2349          <<biblio.*>>
2350          <<items.*>>
2351          <<biblioitems.*>>
2352          <<issues.*>>
2353       </overdue>
2354
2355       <news>
2356          <<opac_news.*>>
2357       </news>
2358
2359   ISSUEQSLIP:
2360
2361       <checkedout>
2362          <<biblio.*>>
2363          <<items.*>>
2364          <<biblioitems.*>>
2365          <<issues.*>>
2366       </checkedout>
2367
2368   NOTE: Not all table fields are available, pleasee see GetPendingIssues for a list of available fields.
2369
2370 =cut
2371
2372 sub IssueSlip {
2373     my ($branch, $borrowernumber, $quickslip) = @_;
2374
2375     # FIXME Check callers before removing this statement
2376     #return unless $borrowernumber;
2377
2378     my @issues = @{ GetPendingIssues($borrowernumber) };
2379
2380     for my $issue (@issues) {
2381         $issue->{date_due} = $issue->{date_due_sql};
2382         if ($quickslip) {
2383             my $today = output_pref({ dt => dt_from_string, dateformat => 'iso', dateonly => 1 });
2384             if ( substr( $issue->{issuedate}, 0, 10 ) eq $today
2385                 or substr( $issue->{lastreneweddate}, 0, 10 ) eq $today ) {
2386                   $issue->{now} = 1;
2387             };
2388         }
2389     }
2390
2391     # Sort on timestamp then on issuedate (useful for tests and could be if modified in a batch
2392     @issues = sort {
2393         my $s = $b->{timestamp} <=> $a->{timestamp};
2394         $s == 0 ?
2395              $b->{issuedate} <=> $a->{issuedate} : $s;
2396     } @issues;
2397
2398     my ($letter_code, %repeat);
2399     if ( $quickslip ) {
2400         $letter_code = 'ISSUEQSLIP';
2401         %repeat =  (
2402             'checkedout' => [ map {
2403                 'biblio'       => $_,
2404                 'items'        => $_,
2405                 'biblioitems'  => $_,
2406                 'issues'       => $_,
2407             }, grep { $_->{'now'} } @issues ],
2408         );
2409     }
2410     else {
2411         $letter_code = 'ISSUESLIP';
2412         %repeat =  (
2413             'checkedout' => [ map {
2414                 'biblio'       => $_,
2415                 'items'        => $_,
2416                 'biblioitems'  => $_,
2417                 'issues'       => $_,
2418             }, grep { !$_->{'overdue'} } @issues ],
2419
2420             'overdue' => [ map {
2421                 'biblio'       => $_,
2422                 'items'        => $_,
2423                 'biblioitems'  => $_,
2424                 'issues'       => $_,
2425             }, grep { $_->{'overdue'} } @issues ],
2426
2427             'news' => [ map {
2428                 $_->{'timestamp'} = $_->{'newdate'};
2429                 { opac_news => $_ }
2430             } @{ GetNewsToDisplay("slip",$branch) } ],
2431         );
2432     }
2433
2434     return  C4::Letters::GetPreparedLetter (
2435         module => 'circulation',
2436         letter_code => $letter_code,
2437         branchcode => $branch,
2438         tables => {
2439             'branches'    => $branch,
2440             'borrowers'   => $borrowernumber,
2441         },
2442         repeat => \%repeat,
2443     );
2444 }
2445
2446 =head2 GetBorrowersWithEmail
2447
2448     ([$borrnum,$userid], ...) = GetBorrowersWithEmail('me@example.com');
2449
2450 This gets a list of users and their basic details from their email address.
2451 As it's possible for multiple user to have the same email address, it provides
2452 you with all of them. If there is no userid for the user, there will be an
2453 C<undef> there. An empty list will be returned if there are no matches.
2454
2455 =cut
2456
2457 sub GetBorrowersWithEmail {
2458     my $email = shift;
2459
2460     my $dbh = C4::Context->dbh;
2461
2462     my $query = "SELECT borrowernumber, userid FROM borrowers WHERE email=?";
2463     my $sth=$dbh->prepare($query);
2464     $sth->execute($email);
2465     my @result = ();
2466     while (my $ref = $sth->fetch) {
2467         push @result, $ref;
2468     }
2469     die "Failure searching for borrowers by email address: $sth->errstr" if $sth->err;
2470     return @result;
2471 }
2472
2473 =head2 AddMember_Opac
2474
2475 =cut
2476
2477 sub AddMember_Opac {
2478     my ( %borrower ) = @_;
2479
2480     $borrower{'categorycode'} = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
2481
2482     my $sr = new String::Random;
2483     $sr->{'A'} = [ 'A'..'Z', 'a'..'z' ];
2484     my $password = $sr->randpattern("AAAAAAAAAA");
2485     $borrower{'password'} = $password;
2486
2487     $borrower{'cardnumber'} = fixup_cardnumber();
2488
2489     my $borrowernumber = AddMember(%borrower);
2490
2491     return ( $borrowernumber, $password );
2492 }
2493
2494 =head2 AddEnrolmentFeeIfNeeded
2495
2496     AddEnrolmentFeeIfNeeded( $borrower->{categorycode}, $borrower->{borrowernumber} );
2497
2498 Add enrolment fee for a patron if needed.
2499
2500 =cut
2501
2502 sub AddEnrolmentFeeIfNeeded {
2503     my ( $categorycode, $borrowernumber ) = @_;
2504     # check for enrollment fee & add it if needed
2505     my $dbh = C4::Context->dbh;
2506     my $sth = $dbh->prepare(q{
2507         SELECT enrolmentfee
2508         FROM categories
2509         WHERE categorycode=?
2510     });
2511     $sth->execute( $categorycode );
2512     if ( $sth->err ) {
2513         warn sprintf('Database returned the following error: %s', $sth->errstr);
2514         return;
2515     }
2516     my ($enrolmentfee) = $sth->fetchrow;
2517     if ($enrolmentfee && $enrolmentfee > 0) {
2518         # insert fee in patron debts
2519         C4::Accounts::manualinvoice( $borrowernumber, '', '', 'A', $enrolmentfee );
2520     }
2521 }
2522
2523 =head2 HasOverdues
2524
2525 =cut
2526
2527 sub HasOverdues {
2528     my ( $borrowernumber ) = @_;
2529
2530     my $sql = "SELECT COUNT(*) FROM issues WHERE date_due < NOW() AND borrowernumber = ?";
2531     my $sth = C4::Context->dbh->prepare( $sql );
2532     $sth->execute( $borrowernumber );
2533     my ( $count ) = $sth->fetchrow_array();
2534
2535     return $count;
2536 }
2537
2538 =head2 DeleteExpiredOpacRegistrations
2539
2540     Delete accounts that haven't been upgraded from the 'temporary' category
2541     Returns the number of removed patrons
2542
2543 =cut
2544
2545 sub DeleteExpiredOpacRegistrations {
2546
2547     my $delay = C4::Context->preference('PatronSelfRegistrationExpireTemporaryAccountsDelay');
2548     my $category_code = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
2549
2550     return 0 if not $category_code or not defined $delay or $delay eq q||;
2551
2552     my $query = qq|
2553 SELECT borrowernumber
2554 FROM borrowers
2555 WHERE categorycode = ? AND DATEDIFF( NOW(), dateenrolled ) > ? |;
2556
2557     my $dbh = C4::Context->dbh;
2558     my $sth = $dbh->prepare($query);
2559     $sth->execute( $category_code, $delay );
2560     my $cnt=0;
2561     while ( my ($borrowernumber) = $sth->fetchrow_array() ) {
2562         DelMember($borrowernumber);
2563         $cnt++;
2564     }
2565     return $cnt;
2566 }
2567
2568 =head2 DeleteUnverifiedOpacRegistrations
2569
2570     Delete all unverified self registrations in borrower_modifications,
2571     older than the specified number of days.
2572
2573 =cut
2574
2575 sub DeleteUnverifiedOpacRegistrations {
2576     my ( $days ) = @_;
2577     my $dbh = C4::Context->dbh;
2578     my $sql=qq|
2579 DELETE FROM borrower_modifications
2580 WHERE borrowernumber = 0 AND DATEDIFF( NOW(), timestamp ) > ?|;
2581     my $cnt=$dbh->do($sql, undef, ($days) );
2582     return $cnt eq '0E0'? 0: $cnt;
2583 }
2584
2585 sub GetOverduesForPatron {
2586     my ( $borrowernumber ) = @_;
2587
2588     my $sql = "
2589         SELECT *
2590         FROM issues, items, biblio, biblioitems
2591         WHERE items.itemnumber=issues.itemnumber
2592           AND biblio.biblionumber   = items.biblionumber
2593           AND biblio.biblionumber   = biblioitems.biblionumber
2594           AND issues.borrowernumber = ?
2595           AND date_due < NOW()
2596     ";
2597
2598     my $sth = C4::Context->dbh->prepare( $sql );
2599     $sth->execute( $borrowernumber );
2600
2601     return $sth->fetchall_arrayref({});
2602 }
2603
2604 END { }    # module clean-up code here (global destructor)
2605
2606 1;
2607
2608 __END__
2609
2610 =head1 AUTHOR
2611
2612 Koha Team
2613
2614 =cut