C4/Members.pm

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