C4/Members.pm

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