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     delete $borrower->{updated_on};
1650
1651     my $deleted = $schema->resultset('Deletedborrower')->create($borrower);
1652
1653     return $deleted ? 1 : undef;
1654 }
1655
1656 =head2 DelMember
1657
1658     DelMember($borrowernumber);
1659
1660 This function remove directly a borrower whitout writing it on deleteborrower.
1661 + Deletes reserves for the borrower
1662
1663 =cut
1664
1665 sub DelMember {
1666     my $dbh            = C4::Context->dbh;
1667     my $borrowernumber = shift;
1668     #warn "in delmember with $borrowernumber";
1669     return unless $borrowernumber;    # borrowernumber is mandatory.
1670     # Delete Patron's holds
1671     my @holds = Koha::Holds->search({ borrowernumber => $borrowernumber });
1672     $_->delete for @holds;
1673
1674     my $query = "
1675        DELETE
1676        FROM borrowers
1677        WHERE borrowernumber = ?
1678    ";
1679     my $sth = $dbh->prepare($query);
1680     $sth->execute($borrowernumber);
1681     logaction("MEMBERS", "DELETE", $borrowernumber, "") if C4::Context->preference("BorrowersLog");
1682     return $sth->rows;
1683 }
1684
1685 =head2 HandleDelBorrower
1686
1687      HandleDelBorrower($borrower);
1688
1689 When a member is deleted (DelMember in Members.pm), you should call me first.
1690 This routine deletes/moves lists and entries for the deleted member/borrower.
1691 Lists owned by the borrower are deleted, but entries from the borrower to
1692 other lists are kept.
1693
1694 =cut
1695
1696 sub HandleDelBorrower {
1697     my ($borrower)= @_;
1698     my $query;
1699     my $dbh = C4::Context->dbh;
1700
1701     #Delete all lists and all shares of this borrower
1702     #Consistent with the approach Koha uses on deleting individual lists
1703     #Note that entries in virtualshelfcontents added by this borrower to
1704     #lists of others will be handled by a table constraint: the borrower
1705     #is set to NULL in those entries.
1706     $query="DELETE FROM virtualshelves WHERE owner=?";
1707     $dbh->do($query,undef,($borrower));
1708
1709     #NOTE:
1710     #We could handle the above deletes via a constraint too.
1711     #But a new BZ report 11889 has been opened to discuss another approach.
1712     #Instead of deleting we could also disown lists (based on a pref).
1713     #In that way we could save shared and public lists.
1714     #The current table constraints support that idea now.
1715     #This pref should then govern the results of other routines/methods such as
1716     #Koha::Virtualshelf->new->delete too.
1717 }
1718
1719 =head2 ExtendMemberSubscriptionTo (OUEST-PROVENCE)
1720
1721     $date = ExtendMemberSubscriptionTo($borrowerid, $date);
1722
1723 Extending the subscription to a given date or to the expiry date calculated on ISO date.
1724 Returns ISO date.
1725
1726 =cut
1727
1728 sub ExtendMemberSubscriptionTo {
1729     my ( $borrowerid,$date) = @_;
1730     my $dbh = C4::Context->dbh;
1731     my $borrower = GetMember('borrowernumber'=>$borrowerid);
1732     unless ($date){
1733       $date = (C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry') ?
1734                                         eval { output_pref( { dt => dt_from_string( $borrower->{'dateexpiry'}  ), dateonly => 1, dateformat => 'iso' } ); }
1735                                         :
1736                                         output_pref( { dt => dt_from_string, dateonly => 1, dateformat => 'iso' } );
1737       $date = GetExpiryDate( $borrower->{'categorycode'}, $date );
1738     }
1739     my $sth = $dbh->do(<<EOF);
1740 UPDATE borrowers
1741 SET  dateexpiry='$date'
1742 WHERE borrowernumber='$borrowerid'
1743 EOF
1744
1745     AddEnrolmentFeeIfNeeded( $borrower->{categorycode}, $borrower->{borrowernumber} );
1746
1747     logaction("MEMBERS", "RENEW", $borrower->{'borrowernumber'}, "Membership renewed")if C4::Context->preference("BorrowersLog");
1748     return $date if ($sth);
1749     return 0;
1750 }
1751
1752 =head2 GetHideLostItemsPreference
1753
1754   $hidelostitemspref = &GetHideLostItemsPreference($borrowernumber);
1755
1756 Returns the HideLostItems preference for the patron category of the supplied borrowernumber
1757 C<&$hidelostitemspref>return value of function, 0 or 1
1758
1759 =cut
1760
1761 sub GetHideLostItemsPreference {
1762     my ($borrowernumber) = @_;
1763     my $dbh = C4::Context->dbh;
1764     my $query = "SELECT hidelostitems FROM borrowers,categories WHERE borrowers.categorycode = categories.categorycode AND borrowernumber = ?";
1765     my $sth = $dbh->prepare($query);
1766     $sth->execute($borrowernumber);
1767     my $hidelostitems = $sth->fetchrow;
1768     return $hidelostitems;
1769 }
1770
1771 =head2 GetBorrowersToExpunge
1772
1773   $borrowers = &GetBorrowersToExpunge(
1774       not_borrowed_since => $not_borrowed_since,
1775       expired_before       => $expired_before,
1776       category_code        => $category_code,
1777       patron_list_id       => $patron_list_id,
1778       branchcode           => $branchcode
1779   );
1780
1781   This function get all borrowers based on the given criteria.
1782
1783 =cut
1784
1785 sub GetBorrowersToExpunge {
1786
1787     my $params = shift;
1788     my $filterdate       = $params->{'not_borrowed_since'};
1789     my $filterexpiry     = $params->{'expired_before'};
1790     my $filtercategory   = $params->{'category_code'};
1791     my $filterbranch     = $params->{'branchcode'} ||
1792                         ((C4::Context->preference('IndependentBranches')
1793                              && C4::Context->userenv
1794                              && !C4::Context->IsSuperLibrarian()
1795                              && C4::Context->userenv->{branch})
1796                          ? C4::Context->userenv->{branch}
1797                          : "");
1798     my $filterpatronlist = $params->{'patron_list_id'};
1799
1800     my $dbh   = C4::Context->dbh;
1801     my $query = q|
1802         SELECT borrowers.borrowernumber,
1803                MAX(old_issues.timestamp) AS latestissue,
1804                MAX(issues.timestamp) AS currentissue
1805         FROM   borrowers
1806         JOIN   categories USING (categorycode)
1807         LEFT JOIN (
1808             SELECT guarantorid
1809             FROM borrowers
1810             WHERE guarantorid IS NOT NULL
1811                 AND guarantorid <> 0
1812         ) as tmp ON borrowers.borrowernumber=tmp.guarantorid
1813         LEFT JOIN old_issues USING (borrowernumber)
1814         LEFT JOIN issues USING (borrowernumber)|;
1815     if ( $filterpatronlist  ){
1816         $query .= q| LEFT JOIN patron_list_patrons USING (borrowernumber)|;
1817     }
1818     $query .= q| WHERE  category_type <> 'S'
1819         AND tmp.guarantorid IS NULL
1820    |;
1821     my @query_params;
1822     if ( $filterbranch && $filterbranch ne "" ) {
1823         $query.= " AND borrowers.branchcode = ? ";
1824         push( @query_params, $filterbranch );
1825     }
1826     if ( $filterexpiry ) {
1827         $query .= " AND dateexpiry < ? ";
1828         push( @query_params, $filterexpiry );
1829     }
1830     if ( $filtercategory ) {
1831         $query .= " AND categorycode = ? ";
1832         push( @query_params, $filtercategory );
1833     }
1834     if ( $filterpatronlist ){
1835         $query.=" AND patron_list_id = ? ";
1836         push( @query_params, $filterpatronlist );
1837     }
1838     $query.=" GROUP BY borrowers.borrowernumber HAVING currentissue IS NULL ";
1839     if ( $filterdate ) {
1840         $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
1841         push @query_params,$filterdate;
1842     }
1843     warn $query if $debug;
1844
1845     my $sth = $dbh->prepare($query);
1846     if (scalar(@query_params)>0){
1847         $sth->execute(@query_params);
1848     }
1849     else {
1850         $sth->execute;
1851     }
1852
1853     my @results;
1854     while ( my $data = $sth->fetchrow_hashref ) {
1855         push @results, $data;
1856     }
1857     return \@results;
1858 }
1859
1860 =head2 GetBorrowersWhoHaveNeverBorrowed
1861
1862   $results = &GetBorrowersWhoHaveNeverBorrowed
1863
1864 This function get all borrowers who have never borrowed.
1865
1866 I<$result> is a ref to an array which all elements are a hasref.
1867
1868 =cut
1869
1870 sub GetBorrowersWhoHaveNeverBorrowed {
1871     my $filterbranch = shift ||
1872                         ((C4::Context->preference('IndependentBranches')
1873                              && C4::Context->userenv
1874                              && !C4::Context->IsSuperLibrarian()
1875                              && C4::Context->userenv->{branch})
1876                          ? C4::Context->userenv->{branch}
1877                          : "");
1878     my $dbh   = C4::Context->dbh;
1879     my $query = "
1880         SELECT borrowers.borrowernumber,max(timestamp) as latestissue
1881         FROM   borrowers
1882           LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
1883         WHERE issues.borrowernumber IS NULL
1884    ";
1885     my @query_params;
1886     if ($filterbranch && $filterbranch ne ""){
1887         $query.=" AND borrowers.branchcode= ?";
1888         push @query_params,$filterbranch;
1889     }
1890     warn $query if $debug;
1891
1892     my $sth = $dbh->prepare($query);
1893     if (scalar(@query_params)>0){
1894         $sth->execute(@query_params);
1895     }
1896     else {
1897         $sth->execute;
1898     }
1899
1900     my @results;
1901     while ( my $data = $sth->fetchrow_hashref ) {
1902         push @results, $data;
1903     }
1904     return \@results;
1905 }
1906
1907 =head2 GetBorrowersWithIssuesHistoryOlderThan
1908
1909   $results = &GetBorrowersWithIssuesHistoryOlderThan($date)
1910
1911 this function get all borrowers who has an issue history older than I<$date> given on input arg.
1912
1913 I<$result> is a ref to an array which all elements are a hashref.
1914 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
1915
1916 =cut
1917
1918 sub GetBorrowersWithIssuesHistoryOlderThan {
1919     my $dbh  = C4::Context->dbh;
1920     my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime());
1921     my $filterbranch = shift ||
1922                         ((C4::Context->preference('IndependentBranches')
1923                              && C4::Context->userenv
1924                              && !C4::Context->IsSuperLibrarian()
1925                              && C4::Context->userenv->{branch})
1926                          ? C4::Context->userenv->{branch}
1927                          : "");
1928     my $query = "
1929        SELECT count(borrowernumber) as n,borrowernumber
1930        FROM old_issues
1931        WHERE returndate < ?
1932          AND borrowernumber IS NOT NULL
1933     ";
1934     my @query_params;
1935     push @query_params, $date;
1936     if ($filterbranch){
1937         $query.="   AND branchcode = ?";
1938         push @query_params, $filterbranch;
1939     }
1940     $query.=" GROUP BY borrowernumber ";
1941     warn $query if $debug;
1942     my $sth = $dbh->prepare($query);
1943     $sth->execute(@query_params);
1944     my @results;
1945
1946     while ( my $data = $sth->fetchrow_hashref ) {
1947         push @results, $data;
1948     }
1949     return \@results;
1950 }
1951
1952 =head2 GetBorrowersNamesAndLatestIssue
1953
1954   $results = &GetBorrowersNamesAndLatestIssueList(@borrowernumbers)
1955
1956 this function get borrowers Names and surnames and Issue information.
1957
1958 I<@borrowernumbers> is an array which all elements are borrowernumbers.
1959 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
1960
1961 =cut
1962
1963 sub GetBorrowersNamesAndLatestIssue {
1964     my $dbh  = C4::Context->dbh;
1965     my @borrowernumbers=@_;
1966     my $query = "
1967        SELECT surname,lastname, phone, email,max(timestamp)
1968        FROM borrowers
1969          LEFT JOIN issues ON borrowers.borrowernumber=issues.borrowernumber
1970        GROUP BY borrowernumber
1971    ";
1972     my $sth = $dbh->prepare($query);
1973     $sth->execute;
1974     my $results = $sth->fetchall_arrayref({});
1975     return $results;
1976 }
1977
1978 =head2 IssueSlip
1979
1980   IssueSlip($branchcode, $borrowernumber, $quickslip)
1981
1982   Returns letter hash ( see C4::Letters::GetPreparedLetter )
1983
1984   $quickslip is boolean, to indicate whether we want a quick slip
1985
1986   IssueSlip populates ISSUESLIP and ISSUEQSLIP, and will make the following expansions:
1987
1988   Both slips:
1989
1990       <<branches.*>>
1991       <<borrowers.*>>
1992
1993   ISSUESLIP:
1994
1995       <checkedout>
1996          <<biblio.*>>
1997          <<items.*>>
1998          <<biblioitems.*>>
1999          <<issues.*>>
2000       </checkedout>
2001
2002       <overdue>
2003          <<biblio.*>>
2004          <<items.*>>
2005          <<biblioitems.*>>
2006          <<issues.*>>
2007       </overdue>
2008
2009       <news>
2010          <<opac_news.*>>
2011       </news>
2012
2013   ISSUEQSLIP:
2014
2015       <checkedout>
2016          <<biblio.*>>
2017          <<items.*>>
2018          <<biblioitems.*>>
2019          <<issues.*>>
2020       </checkedout>
2021
2022   NOTE: Not all table fields are available, pleasee see GetPendingIssues for a list of available fields.
2023
2024 =cut
2025
2026 sub IssueSlip {
2027     my ($branch, $borrowernumber, $quickslip) = @_;
2028
2029     # FIXME Check callers before removing this statement
2030     #return unless $borrowernumber;
2031
2032     my @issues = @{ GetPendingIssues($borrowernumber) };
2033
2034     for my $issue (@issues) {
2035         $issue->{date_due} = $issue->{date_due_sql};
2036         if ($quickslip) {
2037             my $today = output_pref({ dt => dt_from_string, dateformat => 'iso', dateonly => 1 });
2038             if ( substr( $issue->{issuedate}, 0, 10 ) eq $today
2039                 or substr( $issue->{lastreneweddate}, 0, 10 ) eq $today ) {
2040                   $issue->{now} = 1;
2041             };
2042         }
2043     }
2044
2045     # Sort on timestamp then on issuedate (useful for tests and could be if modified in a batch
2046     @issues = sort {
2047         my $s = $b->{timestamp} <=> $a->{timestamp};
2048         $s == 0 ?
2049              $b->{issuedate} <=> $a->{issuedate} : $s;
2050     } @issues;
2051
2052     my ($letter_code, %repeat);
2053     if ( $quickslip ) {
2054         $letter_code = 'ISSUEQSLIP';
2055         %repeat =  (
2056             'checkedout' => [ map {
2057                 'biblio'       => $_,
2058                 'items'        => $_,
2059                 'biblioitems'  => $_,
2060                 'issues'       => $_,
2061             }, grep { $_->{'now'} } @issues ],
2062         );
2063     }
2064     else {
2065         $letter_code = 'ISSUESLIP';
2066         %repeat =  (
2067             'checkedout' => [ map {
2068                 'biblio'       => $_,
2069                 'items'        => $_,
2070                 'biblioitems'  => $_,
2071                 'issues'       => $_,
2072             }, grep { !$_->{'overdue'} } @issues ],
2073
2074             'overdue' => [ map {
2075                 'biblio'       => $_,
2076                 'items'        => $_,
2077                 'biblioitems'  => $_,
2078                 'issues'       => $_,
2079             }, grep { $_->{'overdue'} } @issues ],
2080
2081             'news' => [ map {
2082                 $_->{'timestamp'} = $_->{'newdate'};
2083                 { opac_news => $_ }
2084             } @{ GetNewsToDisplay("slip",$branch) } ],
2085         );
2086     }
2087
2088     return  C4::Letters::GetPreparedLetter (
2089         module => 'circulation',
2090         letter_code => $letter_code,
2091         branchcode => $branch,
2092         tables => {
2093             'branches'    => $branch,
2094             'borrowers'   => $borrowernumber,
2095         },
2096         repeat => \%repeat,
2097     );
2098 }
2099
2100 =head2 GetBorrowersWithEmail
2101
2102     ([$borrnum,$userid], ...) = GetBorrowersWithEmail('me@example.com');
2103
2104 This gets a list of users and their basic details from their email address.
2105 As it's possible for multiple user to have the same email address, it provides
2106 you with all of them. If there is no userid for the user, there will be an
2107 C<undef> there. An empty list will be returned if there are no matches.
2108
2109 =cut
2110
2111 sub GetBorrowersWithEmail {
2112     my $email = shift;
2113
2114     my $dbh = C4::Context->dbh;
2115
2116     my $query = "SELECT borrowernumber, userid FROM borrowers WHERE email=?";
2117     my $sth=$dbh->prepare($query);
2118     $sth->execute($email);
2119     my @result = ();
2120     while (my $ref = $sth->fetch) {
2121         push @result, $ref;
2122     }
2123     die "Failure searching for borrowers by email address: $sth->errstr" if $sth->err;
2124     return @result;
2125 }
2126
2127 =head2 AddMember_Opac
2128
2129 =cut
2130
2131 sub AddMember_Opac {
2132     my ( %borrower ) = @_;
2133
2134     $borrower{'categorycode'} //= C4::Context->preference('PatronSelfRegistrationDefaultCategory');
2135     if (not defined $borrower{'password'}){
2136         my $sr = new String::Random;
2137         $sr->{'A'} = [ 'A'..'Z', 'a'..'z' ];
2138         my $password = $sr->randpattern("AAAAAAAAAA");
2139         $borrower{'password'} = $password;
2140     }
2141
2142     $borrower{'cardnumber'} = fixup_cardnumber( $borrower{'cardnumber'} );
2143
2144     my $borrowernumber = AddMember(%borrower);
2145
2146     return ( $borrowernumber, $borrower{'password'} );
2147 }
2148
2149 =head2 AddEnrolmentFeeIfNeeded
2150
2151     AddEnrolmentFeeIfNeeded( $borrower->{categorycode}, $borrower->{borrowernumber} );
2152
2153 Add enrolment fee for a patron if needed.
2154
2155 =cut
2156
2157 sub AddEnrolmentFeeIfNeeded {
2158     my ( $categorycode, $borrowernumber ) = @_;
2159     # check for enrollment fee & add it if needed
2160     my $dbh = C4::Context->dbh;
2161     my $sth = $dbh->prepare(q{
2162         SELECT enrolmentfee
2163         FROM categories
2164         WHERE categorycode=?
2165     });
2166     $sth->execute( $categorycode );
2167     if ( $sth->err ) {
2168         warn sprintf('Database returned the following error: %s', $sth->errstr);
2169         return;
2170     }
2171     my ($enrolmentfee) = $sth->fetchrow;
2172     if ($enrolmentfee && $enrolmentfee > 0) {
2173         # insert fee in patron debts
2174         C4::Accounts::manualinvoice( $borrowernumber, '', '', 'A', $enrolmentfee );
2175     }
2176 }
2177
2178 =head2 HasOverdues
2179
2180 =cut
2181
2182 sub HasOverdues {
2183     my ( $borrowernumber ) = @_;
2184
2185     my $sql = "SELECT COUNT(*) FROM issues WHERE date_due < NOW() AND borrowernumber = ?";
2186     my $sth = C4::Context->dbh->prepare( $sql );
2187     $sth->execute( $borrowernumber );
2188     my ( $count ) = $sth->fetchrow_array();
2189
2190     return $count;
2191 }
2192
2193 =head2 DeleteExpiredOpacRegistrations
2194
2195     Delete accounts that haven't been upgraded from the 'temporary' category
2196     Returns the number of removed patrons
2197
2198 =cut
2199
2200 sub DeleteExpiredOpacRegistrations {
2201
2202     my $delay = C4::Context->preference('PatronSelfRegistrationExpireTemporaryAccountsDelay');
2203     my $category_code = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
2204
2205     return 0 if not $category_code or not defined $delay or $delay eq q||;
2206
2207     my $query = qq|
2208 SELECT borrowernumber
2209 FROM borrowers
2210 WHERE categorycode = ? AND DATEDIFF( NOW(), dateenrolled ) > ? |;
2211
2212     my $dbh = C4::Context->dbh;
2213     my $sth = $dbh->prepare($query);
2214     $sth->execute( $category_code, $delay );
2215     my $cnt=0;
2216     while ( my ($borrowernumber) = $sth->fetchrow_array() ) {
2217         DelMember($borrowernumber);
2218         $cnt++;
2219     }
2220     return $cnt;
2221 }
2222
2223 =head2 DeleteUnverifiedOpacRegistrations
2224
2225     Delete all unverified self registrations in borrower_modifications,
2226     older than the specified number of days.
2227
2228 =cut
2229
2230 sub DeleteUnverifiedOpacRegistrations {
2231     my ( $days ) = @_;
2232     my $dbh = C4::Context->dbh;
2233     my $sql=qq|
2234 DELETE FROM borrower_modifications
2235 WHERE borrowernumber = 0 AND DATEDIFF( NOW(), timestamp ) > ?|;
2236     my $cnt=$dbh->do($sql, undef, ($days) );
2237     return $cnt eq '0E0'? 0: $cnt;
2238 }
2239
2240 sub GetOverduesForPatron {
2241     my ( $borrowernumber ) = @_;
2242
2243     my $sql = "
2244         SELECT *
2245         FROM issues, items, biblio, biblioitems
2246         WHERE items.itemnumber=issues.itemnumber
2247           AND biblio.biblionumber   = items.biblionumber
2248           AND biblio.biblionumber   = biblioitems.biblionumber
2249           AND issues.borrowernumber = ?
2250           AND date_due < NOW()
2251     ";
2252
2253     my $sth = C4::Context->dbh->prepare( $sql );
2254     $sth->execute( $borrowernumber );
2255
2256     return $sth->fetchall_arrayref({});
2257 }
2258
2259 END { }    # module clean-up code here (global destructor)
2260
2261 1;
2262
2263 __END__
2264
2265 =head1 AUTHOR
2266
2267 Koha Team
2268
2269 =cut