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