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