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