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