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'}  = $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 $expires = GetUpcomingMembershipExpires({
1357         branch => $branch, before => $before, after => $after,
1358     });
1359
1360     $branch is an optional branch code.
1361     $before/$after is an optional number of days before/after the date that
1362     is set by the preference MembershipExpiryDaysNotice.
1363     If the pref would be 14, before 2 and after 3, you will get all expires
1364     from 12 to 17 days.
1365
1366 =cut
1367
1368 sub GetUpcomingMembershipExpires {
1369     my ( $params ) = @_;
1370     my $before = $params->{before} || 0;
1371     my $after  = $params->{after} || 0;
1372     my $branch = $params->{branch};
1373
1374     my $dbh = C4::Context->dbh;
1375     my $days = C4::Context->preference("MembershipExpiryDaysNotice") || 0;
1376     my $date1 = dt_from_string->add( days => $days - $before );
1377     my $date2 = dt_from_string->add( days => $days + $after );
1378     $date1= output_pref({ dt => $date1, dateformat => 'iso', dateonly => 1 });
1379     $date2= output_pref({ dt => $date2, dateformat => 'iso', dateonly => 1 });
1380
1381     my $query = q|
1382         SELECT borrowers.*, categories.description,
1383         branches.branchname, branches.branchemail FROM borrowers
1384         LEFT JOIN branches USING (branchcode)
1385         LEFT JOIN categories USING (categorycode)
1386     |;
1387     if( $branch ) {
1388         $query.= 'WHERE branchcode=? AND dateexpiry BETWEEN ? AND ?';
1389     } else {
1390         $query.= 'WHERE dateexpiry BETWEEN ? AND ?';
1391     }
1392
1393     my $sth = $dbh->prepare( $query );
1394     my @pars = $branch? ( $branch ): ();
1395     push @pars, $date1, $date2;
1396     $sth->execute( @pars );
1397     my $results = $sth->fetchall_arrayref( {} );
1398     return $results;
1399 }
1400
1401 =head2 GetborCatFromCatType
1402
1403   ($codes_arrayref, $labels_hashref) = &GetborCatFromCatType();
1404
1405 Looks up the different types of borrowers in the database. Returns two
1406 elements: a reference-to-array, which lists the borrower category
1407 codes, and a reference-to-hash, which maps the borrower category codes
1408 to category descriptions.
1409
1410 =cut
1411
1412 #'
1413 sub GetborCatFromCatType {
1414     my ( $category_type, $action, $no_branch_limit ) = @_;
1415
1416     my $branch_limit = $no_branch_limit
1417         ? 0
1418         : C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1419
1420     # FIXME - This API  seems both limited and dangerous.
1421     my $dbh     = C4::Context->dbh;
1422
1423     my $request = qq{
1424         SELECT categories.categorycode, categories.description
1425         FROM categories
1426     };
1427     $request .= qq{
1428         LEFT JOIN categories_branches ON categories.categorycode = categories_branches.categorycode
1429     } if $branch_limit;
1430     if($action) {
1431         $request .= " $action ";
1432         $request .= " AND (branchcode = ? OR branchcode IS NULL) GROUP BY description" if $branch_limit;
1433     } else {
1434         $request .= " WHERE branchcode = ? OR branchcode IS NULL GROUP BY description" if $branch_limit;
1435     }
1436     $request .= " ORDER BY categorycode";
1437
1438     my $sth = $dbh->prepare($request);
1439     $sth->execute(
1440         $action ? $category_type : (),
1441         $branch_limit ? $branch_limit : ()
1442     );
1443
1444     my %labels;
1445     my @codes;
1446
1447     while ( my $data = $sth->fetchrow_hashref ) {
1448         push @codes, $data->{'categorycode'};
1449         $labels{ $data->{'categorycode'} } = $data->{'description'};
1450     }
1451     $sth->finish;
1452     return ( \@codes, \%labels );
1453 }
1454
1455 =head2 GetBorrowercategory
1456
1457   $hashref = &GetBorrowercategory($categorycode);
1458
1459 Given the borrower's category code, the function returns the corresponding
1460 data hashref for a comprehensive information display.
1461
1462 =cut
1463
1464 sub GetBorrowercategory {
1465     my ($catcode) = @_;
1466     my $dbh       = C4::Context->dbh;
1467     if ($catcode){
1468         my $sth       =
1469         $dbh->prepare(
1470     "SELECT description,dateofbirthrequired,upperagelimit,category_type
1471     FROM categories
1472     WHERE categorycode = ?"
1473         );
1474         $sth->execute($catcode);
1475         my $data =
1476         $sth->fetchrow_hashref;
1477         return $data;
1478     }
1479     return;
1480 }    # sub getborrowercategory
1481
1482
1483 =head2 GetBorrowerCategorycode
1484
1485     $categorycode = &GetBorrowerCategoryCode( $borrowernumber );
1486
1487 Given the borrowernumber, the function returns the corresponding categorycode
1488
1489 =cut
1490
1491 sub GetBorrowerCategorycode {
1492     my ( $borrowernumber ) = @_;
1493     my $dbh = C4::Context->dbh;
1494     my $sth = $dbh->prepare( qq{
1495         SELECT categorycode
1496         FROM borrowers
1497         WHERE borrowernumber = ?
1498     } );
1499     $sth->execute( $borrowernumber );
1500     return $sth->fetchrow;
1501 }
1502
1503 =head2 GetBorrowercategoryList
1504
1505   $arrayref_hashref = &GetBorrowercategoryList;
1506 If no category code provided, the function returns all the categories.
1507
1508 =cut
1509
1510 sub GetBorrowercategoryList {
1511     my $no_branch_limit = @_ ? shift : 0;
1512     my $branch_limit = $no_branch_limit
1513         ? 0
1514         : C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1515     my $dbh       = C4::Context->dbh;
1516     my $query = "SELECT categories.* FROM categories";
1517     $query .= qq{
1518         LEFT JOIN categories_branches ON categories.categorycode = categories_branches.categorycode
1519         WHERE branchcode = ? OR branchcode IS NULL GROUP BY description
1520     } if $branch_limit;
1521     $query .= " ORDER BY description";
1522     my $sth = $dbh->prepare( $query );
1523     $sth->execute( $branch_limit ? $branch_limit : () );
1524     my $data = $sth->fetchall_arrayref( {} );
1525     $sth->finish;
1526     return $data;
1527 }    # sub getborrowercategory
1528
1529 =head2 GetAge
1530
1531   $dateofbirth,$date = &GetAge($date);
1532
1533 this function return the borrowers age with the value of dateofbirth
1534
1535 =cut
1536
1537 #'
1538 sub GetAge{
1539     my ( $date, $date_ref ) = @_;
1540
1541     if ( not defined $date_ref ) {
1542         $date_ref = sprintf( '%04d-%02d-%02d', Today() );
1543     }
1544
1545     my ( $year1, $month1, $day1 ) = split /-/, $date;
1546     my ( $year2, $month2, $day2 ) = split /-/, $date_ref;
1547
1548     my $age = $year2 - $year1;
1549     if ( $month1 . $day1 > $month2 . $day2 ) {
1550         $age--;
1551     }
1552
1553     return $age;
1554 }    # sub get_age
1555
1556 =head2 SetAge
1557
1558   $borrower = C4::Members::SetAge($borrower, $datetimeduration);
1559   $borrower = C4::Members::SetAge($borrower, '0015-12-10');
1560   $borrower = C4::Members::SetAge($borrower, $datetimeduration, $datetime_reference);
1561
1562   eval { $borrower = C4::Members::SetAge($borrower, '015-1-10'); };
1563   if ($@) {print $@;} #Catch a bad ISO Date or kill your script!
1564
1565 This function sets the borrower's dateofbirth to match the given age.
1566 Optionally relative to the given $datetime_reference.
1567
1568 @PARAM1 koha.borrowers-object
1569 @PARAM2 DateTime::Duration-object as the desired age
1570         OR a ISO 8601 Date. (To make the API more pleasant)
1571 @PARAM3 DateTime-object as the relative date, defaults to now().
1572 RETURNS The given borrower reference @PARAM1.
1573 DIES    If there was an error with the ISO Date handling.
1574
1575 =cut
1576
1577 #'
1578 sub SetAge{
1579     my ( $borrower, $datetimeduration, $datetime_ref ) = @_;
1580     $datetime_ref = DateTime->now() unless $datetime_ref;
1581
1582     if ($datetimeduration && ref $datetimeduration ne 'DateTime::Duration') {
1583         if ($datetimeduration =~ /^(\d{4})-(\d{2})-(\d{2})/) {
1584             $datetimeduration = DateTime::Duration->new(years => $1, months => $2, days => $3);
1585         }
1586         else {
1587             die "C4::Members::SetAge($borrower, $datetimeduration), datetimeduration not a valid ISO 8601 Date!\n";
1588         }
1589     }
1590
1591     my $new_datetime_ref = $datetime_ref->clone();
1592     $new_datetime_ref->subtract_duration( $datetimeduration );
1593
1594     $borrower->{dateofbirth} = $new_datetime_ref->ymd();
1595
1596     return $borrower;
1597 }    # sub SetAge
1598
1599 =head2 GetSortDetails (OUEST-PROVENCE)
1600
1601   ($lib) = &GetSortDetails($category,$sortvalue);
1602
1603 Returns the authorized value  details
1604 C<&$lib>return value of authorized value details
1605 C<&$sortvalue>this is the value of authorized value
1606 C<&$category>this is the value of authorized value category
1607
1608 =cut
1609
1610 sub GetSortDetails {
1611     my ( $category, $sortvalue ) = @_;
1612     my $dbh   = C4::Context->dbh;
1613     my $query = qq|SELECT lib
1614         FROM authorised_values
1615         WHERE category=?
1616         AND authorised_value=? |;
1617     my $sth = $dbh->prepare($query);
1618     $sth->execute( $category, $sortvalue );
1619     my $lib = $sth->fetchrow;
1620     return ($lib) if ($lib);
1621     return ($sortvalue) unless ($lib);
1622 }
1623
1624 =head2 MoveMemberToDeleted
1625
1626   $result = &MoveMemberToDeleted($borrowernumber);
1627
1628 Copy the record from borrowers to deletedborrowers table.
1629 The routine returns 1 for success, undef for failure.
1630
1631 =cut
1632
1633 sub MoveMemberToDeleted {
1634     my ($member) = shift or return;
1635
1636     my $schema       = Koha::Database->new()->schema();
1637     my $borrowers_rs = $schema->resultset('Borrower');
1638     $borrowers_rs->result_class('DBIx::Class::ResultClass::HashRefInflator');
1639     my $borrower = $borrowers_rs->find($member);
1640     return unless $borrower;
1641
1642     my $deleted = $schema->resultset('Deletedborrower')->create($borrower);
1643
1644     return $deleted ? 1 : undef;
1645 }
1646
1647 =head2 DelMember
1648
1649     DelMember($borrowernumber);
1650
1651 This function remove directly a borrower whitout writing it on deleteborrower.
1652 + Deletes reserves for the borrower
1653
1654 =cut
1655
1656 sub DelMember {
1657     my $dbh            = C4::Context->dbh;
1658     my $borrowernumber = shift;
1659     #warn "in delmember with $borrowernumber";
1660     return unless $borrowernumber;    # borrowernumber is mandatory.
1661
1662     my $query = qq|DELETE
1663           FROM  reserves
1664           WHERE borrowernumber=?|;
1665     my $sth = $dbh->prepare($query);
1666     $sth->execute($borrowernumber);
1667     $query = "
1668        DELETE
1669        FROM borrowers
1670        WHERE borrowernumber = ?
1671    ";
1672     $sth = $dbh->prepare($query);
1673     $sth->execute($borrowernumber);
1674     logaction("MEMBERS", "DELETE", $borrowernumber, "") if C4::Context->preference("BorrowersLog");
1675     return $sth->rows;
1676 }
1677
1678 =head2 HandleDelBorrower
1679
1680      HandleDelBorrower($borrower);
1681
1682 When a member is deleted (DelMember in Members.pm), you should call me first.
1683 This routine deletes/moves lists and entries for the deleted member/borrower.
1684 Lists owned by the borrower are deleted, but entries from the borrower to
1685 other lists are kept.
1686
1687 =cut
1688
1689 sub HandleDelBorrower {
1690     my ($borrower)= @_;
1691     my $query;
1692     my $dbh = C4::Context->dbh;
1693
1694     #Delete all lists and all shares of this borrower
1695     #Consistent with the approach Koha uses on deleting individual lists
1696     #Note that entries in virtualshelfcontents added by this borrower to
1697     #lists of others will be handled by a table constraint: the borrower
1698     #is set to NULL in those entries.
1699     $query="DELETE FROM virtualshelves WHERE owner=?";
1700     $dbh->do($query,undef,($borrower));
1701
1702     #NOTE:
1703     #We could handle the above deletes via a constraint too.
1704     #But a new BZ report 11889 has been opened to discuss another approach.
1705     #Instead of deleting we could also disown lists (based on a pref).
1706     #In that way we could save shared and public lists.
1707     #The current table constraints support that idea now.
1708     #This pref should then govern the results of other routines/methods such as
1709     #Koha::Virtualshelf->new->delete too.
1710 }
1711
1712 =head2 ExtendMemberSubscriptionTo (OUEST-PROVENCE)
1713
1714     $date = ExtendMemberSubscriptionTo($borrowerid, $date);
1715
1716 Extending the subscription to a given date or to the expiry date calculated on ISO date.
1717 Returns ISO date.
1718
1719 =cut
1720
1721 sub ExtendMemberSubscriptionTo {
1722     my ( $borrowerid,$date) = @_;
1723     my $dbh = C4::Context->dbh;
1724     my $borrower = GetMember('borrowernumber'=>$borrowerid);
1725     unless ($date){
1726       $date = (C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry') ?
1727                                         eval { output_pref( { dt => dt_from_string( $borrower->{'dateexpiry'}  ), dateonly => 1, dateformat => 'iso' } ); }
1728                                         :
1729                                         output_pref( { dt => dt_from_string, dateonly => 1, dateformat => 'iso' } );
1730       $date = GetExpiryDate( $borrower->{'categorycode'}, $date );
1731     }
1732     my $sth = $dbh->do(<<EOF);
1733 UPDATE borrowers
1734 SET  dateexpiry='$date'
1735 WHERE borrowernumber='$borrowerid'
1736 EOF
1737
1738     AddEnrolmentFeeIfNeeded( $borrower->{categorycode}, $borrower->{borrowernumber} );
1739
1740     logaction("MEMBERS", "RENEW", $borrower->{'borrowernumber'}, "Membership renewed")if C4::Context->preference("BorrowersLog");
1741     return $date if ($sth);
1742     return 0;
1743 }
1744
1745 =head2 GetTitles (OUEST-PROVENCE)
1746
1747   ($borrowertitle)= &GetTitles();
1748
1749 Looks up the different title . Returns array  with all borrowers title
1750
1751 =cut
1752
1753 sub GetTitles {
1754     my @borrowerTitle = split (/,|\|/,C4::Context->preference('BorrowersTitles'));
1755     unshift( @borrowerTitle, "" );
1756     my $count=@borrowerTitle;
1757     if ($count == 1){
1758         return ();
1759     }
1760     else {
1761         return ( \@borrowerTitle);
1762     }
1763 }
1764
1765 =head2 GetHideLostItemsPreference
1766
1767   $hidelostitemspref = &GetHideLostItemsPreference($borrowernumber);
1768
1769 Returns the HideLostItems preference for the patron category of the supplied borrowernumber
1770 C<&$hidelostitemspref>return value of function, 0 or 1
1771
1772 =cut
1773
1774 sub GetHideLostItemsPreference {
1775     my ($borrowernumber) = @_;
1776     my $dbh = C4::Context->dbh;
1777     my $query = "SELECT hidelostitems FROM borrowers,categories WHERE borrowers.categorycode = categories.categorycode AND borrowernumber = ?";
1778     my $sth = $dbh->prepare($query);
1779     $sth->execute($borrowernumber);
1780     my $hidelostitems = $sth->fetchrow;
1781     return $hidelostitems;
1782 }
1783
1784 =head2 GetBorrowersToExpunge
1785
1786   $borrowers = &GetBorrowersToExpunge(
1787       not_borrowed_since => $not_borrowed_since,
1788       expired_before       => $expired_before,
1789       category_code        => $category_code,
1790       patron_list_id       => $patron_list_id,
1791       branchcode           => $branchcode
1792   );
1793
1794   This function get all borrowers based on the given criteria.
1795
1796 =cut
1797
1798 sub GetBorrowersToExpunge {
1799
1800     my $params = shift;
1801     my $filterdate       = $params->{'not_borrowed_since'};
1802     my $filterexpiry     = $params->{'expired_before'};
1803     my $filtercategory   = $params->{'category_code'};
1804     my $filterbranch     = $params->{'branchcode'} ||
1805                         ((C4::Context->preference('IndependentBranches')
1806                              && C4::Context->userenv
1807                              && !C4::Context->IsSuperLibrarian()
1808                              && C4::Context->userenv->{branch})
1809                          ? C4::Context->userenv->{branch}
1810                          : "");
1811     my $filterpatronlist = $params->{'patron_list_id'};
1812
1813     my $dbh   = C4::Context->dbh;
1814     my $query = q|
1815         SELECT borrowers.borrowernumber,
1816                MAX(old_issues.timestamp) AS latestissue,
1817                MAX(issues.timestamp) AS currentissue
1818         FROM   borrowers
1819         JOIN   categories USING (categorycode)
1820         LEFT JOIN (
1821             SELECT guarantorid
1822             FROM borrowers
1823             WHERE guarantorid IS NOT NULL
1824                 AND guarantorid <> 0
1825         ) as tmp ON borrowers.borrowernumber=tmp.guarantorid
1826         LEFT JOIN old_issues USING (borrowernumber)
1827         LEFT JOIN issues USING (borrowernumber)|;
1828     if ( $filterpatronlist  ){
1829         $query .= q| LEFT JOIN patron_list_patrons USING (borrowernumber)|;
1830     }
1831     $query .= q| WHERE  category_type <> 'S'
1832         AND tmp.guarantorid IS NULL
1833    |;
1834     my @query_params;
1835     if ( $filterbranch && $filterbranch ne "" ) {
1836         $query.= " AND borrowers.branchcode = ? ";
1837         push( @query_params, $filterbranch );
1838     }
1839     if ( $filterexpiry ) {
1840         $query .= " AND dateexpiry < ? ";
1841         push( @query_params, $filterexpiry );
1842     }
1843     if ( $filtercategory ) {
1844         $query .= " AND categorycode = ? ";
1845         push( @query_params, $filtercategory );
1846     }
1847     if ( $filterpatronlist ){
1848         $query.=" AND patron_list_id = ? ";
1849         push( @query_params, $filterpatronlist );
1850     }
1851     $query.=" GROUP BY borrowers.borrowernumber HAVING currentissue IS NULL ";
1852     if ( $filterdate ) {
1853         $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
1854         push @query_params,$filterdate;
1855     }
1856     warn $query if $debug;
1857
1858     my $sth = $dbh->prepare($query);
1859     if (scalar(@query_params)>0){
1860         $sth->execute(@query_params);
1861     }
1862     else {
1863         $sth->execute;
1864     }
1865
1866     my @results;
1867     while ( my $data = $sth->fetchrow_hashref ) {
1868         push @results, $data;
1869     }
1870     return \@results;
1871 }
1872
1873 =head2 GetBorrowersWhoHaveNeverBorrowed
1874
1875   $results = &GetBorrowersWhoHaveNeverBorrowed
1876
1877 This function get all borrowers who have never borrowed.
1878
1879 I<$result> is a ref to an array which all elements are a hasref.
1880
1881 =cut
1882
1883 sub GetBorrowersWhoHaveNeverBorrowed {
1884     my $filterbranch = shift ||
1885                         ((C4::Context->preference('IndependentBranches')
1886                              && C4::Context->userenv
1887                              && !C4::Context->IsSuperLibrarian()
1888                              && C4::Context->userenv->{branch})
1889                          ? C4::Context->userenv->{branch}
1890                          : "");
1891     my $dbh   = C4::Context->dbh;
1892     my $query = "
1893         SELECT borrowers.borrowernumber,max(timestamp) as latestissue
1894         FROM   borrowers
1895           LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
1896         WHERE issues.borrowernumber IS NULL
1897    ";
1898     my @query_params;
1899     if ($filterbranch && $filterbranch ne ""){
1900         $query.=" AND borrowers.branchcode= ?";
1901         push @query_params,$filterbranch;
1902     }
1903     warn $query if $debug;
1904
1905     my $sth = $dbh->prepare($query);
1906     if (scalar(@query_params)>0){
1907         $sth->execute(@query_params);
1908     }
1909     else {
1910         $sth->execute;
1911     }
1912
1913     my @results;
1914     while ( my $data = $sth->fetchrow_hashref ) {
1915         push @results, $data;
1916     }
1917     return \@results;
1918 }
1919
1920 =head2 GetBorrowersWithIssuesHistoryOlderThan
1921
1922   $results = &GetBorrowersWithIssuesHistoryOlderThan($date)
1923
1924 this function get all borrowers who has an issue history older than I<$date> given on input arg.
1925
1926 I<$result> is a ref to an array which all elements are a hashref.
1927 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
1928
1929 =cut
1930
1931 sub GetBorrowersWithIssuesHistoryOlderThan {
1932     my $dbh  = C4::Context->dbh;
1933     my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime());
1934     my $filterbranch = shift ||
1935                         ((C4::Context->preference('IndependentBranches')
1936                              && C4::Context->userenv
1937                              && !C4::Context->IsSuperLibrarian()
1938                              && C4::Context->userenv->{branch})
1939                          ? C4::Context->userenv->{branch}
1940                          : "");
1941     my $query = "
1942        SELECT count(borrowernumber) as n,borrowernumber
1943        FROM old_issues
1944        WHERE returndate < ?
1945          AND borrowernumber IS NOT NULL
1946     ";
1947     my @query_params;
1948     push @query_params, $date;
1949     if ($filterbranch){
1950         $query.="   AND branchcode = ?";
1951         push @query_params, $filterbranch;
1952     }
1953     $query.=" GROUP BY borrowernumber ";
1954     warn $query if $debug;
1955     my $sth = $dbh->prepare($query);
1956     $sth->execute(@query_params);
1957     my @results;
1958
1959     while ( my $data = $sth->fetchrow_hashref ) {
1960         push @results, $data;
1961     }
1962     return \@results;
1963 }
1964
1965 =head2 GetBorrowersNamesAndLatestIssue
1966
1967   $results = &GetBorrowersNamesAndLatestIssueList(@borrowernumbers)
1968
1969 this function get borrowers Names and surnames and Issue information.
1970
1971 I<@borrowernumbers> is an array which all elements are borrowernumbers.
1972 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
1973
1974 =cut
1975
1976 sub GetBorrowersNamesAndLatestIssue {
1977     my $dbh  = C4::Context->dbh;
1978     my @borrowernumbers=@_;
1979     my $query = "
1980        SELECT surname,lastname, phone, email,max(timestamp)
1981        FROM borrowers
1982          LEFT JOIN issues ON borrowers.borrowernumber=issues.borrowernumber
1983        GROUP BY borrowernumber
1984    ";
1985     my $sth = $dbh->prepare($query);
1986     $sth->execute;
1987     my $results = $sth->fetchall_arrayref({});
1988     return $results;
1989 }
1990
1991 =head2 ModPrivacy
1992
1993   my $success = ModPrivacy( $borrowernumber, $privacy );
1994
1995 Update the privacy of a patron.
1996
1997 return :
1998 true on success, false on failure
1999
2000 =cut
2001
2002 sub ModPrivacy {
2003     my $borrowernumber = shift;
2004     my $privacy = shift;
2005     return unless defined $borrowernumber;
2006     return unless $borrowernumber =~ /^\d+$/;
2007
2008     return ModMember( borrowernumber => $borrowernumber,
2009                       privacy        => $privacy );
2010 }
2011
2012 =head2 IssueSlip
2013
2014   IssueSlip($branchcode, $borrowernumber, $quickslip)
2015
2016   Returns letter hash ( see C4::Letters::GetPreparedLetter )
2017
2018   $quickslip is boolean, to indicate whether we want a quick slip
2019
2020   IssueSlip populates ISSUESLIP and ISSUEQSLIP, and will make the following expansions:
2021
2022   Both slips:
2023
2024       <<branches.*>>
2025       <<borrowers.*>>
2026
2027   ISSUESLIP:
2028
2029       <checkedout>
2030          <<biblio.*>>
2031          <<items.*>>
2032          <<biblioitems.*>>
2033          <<issues.*>>
2034       </checkedout>
2035
2036       <overdue>
2037          <<biblio.*>>
2038          <<items.*>>
2039          <<biblioitems.*>>
2040          <<issues.*>>
2041       </overdue>
2042
2043       <news>
2044          <<opac_news.*>>
2045       </news>
2046
2047   ISSUEQSLIP:
2048
2049       <checkedout>
2050          <<biblio.*>>
2051          <<items.*>>
2052          <<biblioitems.*>>
2053          <<issues.*>>
2054       </checkedout>
2055
2056   NOTE: Not all table fields are available, pleasee see GetPendingIssues for a list of available fields.
2057
2058 =cut
2059
2060 sub IssueSlip {
2061     my ($branch, $borrowernumber, $quickslip) = @_;
2062
2063     # FIXME Check callers before removing this statement
2064     #return unless $borrowernumber;
2065
2066     my @issues = @{ GetPendingIssues($borrowernumber) };
2067
2068     for my $issue (@issues) {
2069         $issue->{date_due} = $issue->{date_due_sql};
2070         if ($quickslip) {
2071             my $today = output_pref({ dt => dt_from_string, dateformat => 'iso', dateonly => 1 });
2072             if ( substr( $issue->{issuedate}, 0, 10 ) eq $today
2073                 or substr( $issue->{lastreneweddate}, 0, 10 ) eq $today ) {
2074                   $issue->{now} = 1;
2075             };
2076         }
2077     }
2078
2079     # Sort on timestamp then on issuedate (useful for tests and could be if modified in a batch
2080     @issues = sort {
2081         my $s = $b->{timestamp} <=> $a->{timestamp};
2082         $s == 0 ?
2083              $b->{issuedate} <=> $a->{issuedate} : $s;
2084     } @issues;
2085
2086     my ($letter_code, %repeat);
2087     if ( $quickslip ) {
2088         $letter_code = 'ISSUEQSLIP';
2089         %repeat =  (
2090             'checkedout' => [ map {
2091                 'biblio'       => $_,
2092                 'items'        => $_,
2093                 'biblioitems'  => $_,
2094                 'issues'       => $_,
2095             }, grep { $_->{'now'} } @issues ],
2096         );
2097     }
2098     else {
2099         $letter_code = 'ISSUESLIP';
2100         %repeat =  (
2101             'checkedout' => [ map {
2102                 'biblio'       => $_,
2103                 'items'        => $_,
2104                 'biblioitems'  => $_,
2105                 'issues'       => $_,
2106             }, grep { !$_->{'overdue'} } @issues ],
2107
2108             'overdue' => [ map {
2109                 'biblio'       => $_,
2110                 'items'        => $_,
2111                 'biblioitems'  => $_,
2112                 'issues'       => $_,
2113             }, grep { $_->{'overdue'} } @issues ],
2114
2115             'news' => [ map {
2116                 $_->{'timestamp'} = $_->{'newdate'};
2117                 { opac_news => $_ }
2118             } @{ GetNewsToDisplay("slip",$branch) } ],
2119         );
2120     }
2121
2122     return  C4::Letters::GetPreparedLetter (
2123         module => 'circulation',
2124         letter_code => $letter_code,
2125         branchcode => $branch,
2126         tables => {
2127             'branches'    => $branch,
2128             'borrowers'   => $borrowernumber,
2129         },
2130         repeat => \%repeat,
2131     );
2132 }
2133
2134 =head2 GetBorrowersWithEmail
2135
2136     ([$borrnum,$userid], ...) = GetBorrowersWithEmail('me@example.com');
2137
2138 This gets a list of users and their basic details from their email address.
2139 As it's possible for multiple user to have the same email address, it provides
2140 you with all of them. If there is no userid for the user, there will be an
2141 C<undef> there. An empty list will be returned if there are no matches.
2142
2143 =cut
2144
2145 sub GetBorrowersWithEmail {
2146     my $email = shift;
2147
2148     my $dbh = C4::Context->dbh;
2149
2150     my $query = "SELECT borrowernumber, userid FROM borrowers WHERE email=?";
2151     my $sth=$dbh->prepare($query);
2152     $sth->execute($email);
2153     my @result = ();
2154     while (my $ref = $sth->fetch) {
2155         push @result, $ref;
2156     }
2157     die "Failure searching for borrowers by email address: $sth->errstr" if $sth->err;
2158     return @result;
2159 }
2160
2161 =head2 AddMember_Opac
2162
2163 =cut
2164
2165 sub AddMember_Opac {
2166     my ( %borrower ) = @_;
2167
2168     $borrower{'categorycode'} //= C4::Context->preference('PatronSelfRegistrationDefaultCategory');
2169     if (not defined $borrower{'password'}){
2170         my $sr = new String::Random;
2171         $sr->{'A'} = [ 'A'..'Z', 'a'..'z' ];
2172         my $password = $sr->randpattern("AAAAAAAAAA");
2173         $borrower{'password'} = $password;
2174     }
2175
2176     $borrower{'cardnumber'} = fixup_cardnumber( $borrower{'cardnumber'} );
2177
2178     my $borrowernumber = AddMember(%borrower);
2179
2180     return ( $borrowernumber, $borrower{'password'} );
2181 }
2182
2183 =head2 AddEnrolmentFeeIfNeeded
2184
2185     AddEnrolmentFeeIfNeeded( $borrower->{categorycode}, $borrower->{borrowernumber} );
2186
2187 Add enrolment fee for a patron if needed.
2188
2189 =cut
2190
2191 sub AddEnrolmentFeeIfNeeded {
2192     my ( $categorycode, $borrowernumber ) = @_;
2193     # check for enrollment fee & add it if needed
2194     my $dbh = C4::Context->dbh;
2195     my $sth = $dbh->prepare(q{
2196         SELECT enrolmentfee
2197         FROM categories
2198         WHERE categorycode=?
2199     });
2200     $sth->execute( $categorycode );
2201     if ( $sth->err ) {
2202         warn sprintf('Database returned the following error: %s', $sth->errstr);
2203         return;
2204     }
2205     my ($enrolmentfee) = $sth->fetchrow;
2206     if ($enrolmentfee && $enrolmentfee > 0) {
2207         # insert fee in patron debts
2208         C4::Accounts::manualinvoice( $borrowernumber, '', '', 'A', $enrolmentfee );
2209     }
2210 }
2211
2212 =head2 HasOverdues
2213
2214 =cut
2215
2216 sub HasOverdues {
2217     my ( $borrowernumber ) = @_;
2218
2219     my $sql = "SELECT COUNT(*) FROM issues WHERE date_due < NOW() AND borrowernumber = ?";
2220     my $sth = C4::Context->dbh->prepare( $sql );
2221     $sth->execute( $borrowernumber );
2222     my ( $count ) = $sth->fetchrow_array();
2223
2224     return $count;
2225 }
2226
2227 =head2 DeleteExpiredOpacRegistrations
2228
2229     Delete accounts that haven't been upgraded from the 'temporary' category
2230     Returns the number of removed patrons
2231
2232 =cut
2233
2234 sub DeleteExpiredOpacRegistrations {
2235
2236     my $delay = C4::Context->preference('PatronSelfRegistrationExpireTemporaryAccountsDelay');
2237     my $category_code = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
2238
2239     return 0 if not $category_code or not defined $delay or $delay eq q||;
2240
2241     my $query = qq|
2242 SELECT borrowernumber
2243 FROM borrowers
2244 WHERE categorycode = ? AND DATEDIFF( NOW(), dateenrolled ) > ? |;
2245
2246     my $dbh = C4::Context->dbh;
2247     my $sth = $dbh->prepare($query);
2248     $sth->execute( $category_code, $delay );
2249     my $cnt=0;
2250     while ( my ($borrowernumber) = $sth->fetchrow_array() ) {
2251         DelMember($borrowernumber);
2252         $cnt++;
2253     }
2254     return $cnt;
2255 }
2256
2257 =head2 DeleteUnverifiedOpacRegistrations
2258
2259     Delete all unverified self registrations in borrower_modifications,
2260     older than the specified number of days.
2261
2262 =cut
2263
2264 sub DeleteUnverifiedOpacRegistrations {
2265     my ( $days ) = @_;
2266     my $dbh = C4::Context->dbh;
2267     my $sql=qq|
2268 DELETE FROM borrower_modifications
2269 WHERE borrowernumber = 0 AND DATEDIFF( NOW(), timestamp ) > ?|;
2270     my $cnt=$dbh->do($sql, undef, ($days) );
2271     return $cnt eq '0E0'? 0: $cnt;
2272 }
2273
2274 sub GetOverduesForPatron {
2275     my ( $borrowernumber ) = @_;
2276
2277     my $sql = "
2278         SELECT *
2279         FROM issues, items, biblio, biblioitems
2280         WHERE items.itemnumber=issues.itemnumber
2281           AND biblio.biblionumber   = items.biblionumber
2282           AND biblio.biblionumber   = biblioitems.biblionumber
2283           AND issues.borrowernumber = ?
2284           AND date_due < NOW()
2285     ";
2286
2287     my $sth = C4::Context->dbh->prepare( $sql );
2288     $sth->execute( $borrowernumber );
2289
2290     return $sth->fetchall_arrayref({});
2291 }
2292
2293 END { }    # module clean-up code here (global destructor)
2294
2295 1;
2296
2297 __END__
2298
2299 =head1 AUTHOR
2300
2301 Koha Team
2302
2303 =cut