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 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 Text::Unaccent qw( unac_string );
  41 use Koha::AuthUtils qw(hash_password);
  42 use Koha::Database;
  43 use Koha::Holds;
  44 use Koha::List::Patron;
  45 use Koha::Patrons;
  46 use Koha::Patron::Categories;
  47 use Koha::Schema;
  48
  49 our (@ISA,@EXPORT,@EXPORT_OK,$debug);
  50
  51 use Module::Load::Conditional qw( can_load );
  52 if ( ! can_load( modules => { 'Koha::NorwegianPatronDB' => undef } ) ) {
  53    $debug && warn "Unable to load Koha::NorwegianPatronDB";
  54 }
  55
  56
  57 BEGIN {
  58     $debug = $ENV{DEBUG} || 0;
  59     require Exporter;
  60     @ISA = qw(Exporter);
  61     #Get data
  62     push @EXPORT, qw(
  63         &GetMemberDetails
  64         &GetMember
  65
  66         &GetMemberIssuesAndFines
  67         &GetPendingIssues
  68         &GetAllIssues
  69
  70         &GetFirstValidEmailAddress
  71         &GetNoticeEmailAddress
  72
  73         &GetAge
  74
  75         &GetMemberAccountRecords
  76         &GetBorNotifyAcctRecord
  77
  78         &GetBorrowersToExpunge
  79         &GetBorrowersWhoHaveNeverBorrowed
  80         &GetBorrowersWithIssuesHistoryOlderThan
  81
  82         &GetUpcomingMembershipExpires
  83
  84         &IssueSlip
  85         GetBorrowersWithEmail
  86
  87         GetOverduesForPatron
  88     );
  89
  90     #Modify data
  91     push @EXPORT, qw(
  92         &ModMember
  93         &changepassword
  94     );
  95
  96     #Insert data
  97     push @EXPORT, qw(
  98         &AddMember
  99         &AddMember_Opac
 100     );
 101
 102     #Check data
 103     push @EXPORT, qw(
 104         &checkuniquemember
 105         &checkuserpassword
 106         &Check_Userid
 107         &Generate_Userid
 108         &fixup_cardnumber
 109         &checkcardnumber
 110     );
 111 }
 112
 113 =head1 NAME
 114
 115 C4::Members - Perl Module containing convenience functions for member handling
 116
 117 =head1 SYNOPSIS
 118
 119 use C4::Members;
 120
 121 =head1 DESCRIPTION
 122
 123 This module contains routines for adding, modifying and deleting members/patrons/borrowers
 124
 125 =head1 FUNCTIONS
 126
 127 =head2 GetMemberDetails
 128
 129 ($borrower) = &GetMemberDetails($borrowernumber, $cardnumber);
 130
 131 Looks up a patron and returns information about him or her. If
 132 C<$borrowernumber> is true (nonzero), C<&GetMemberDetails> looks
 133 up the borrower by number; otherwise, it looks up the borrower by card
 134 number.
 135
 136 C<$borrower> is a reference-to-hash whose keys are the fields of the
 137 borrowers table in the Koha database. In addition,
 138 C<$borrower-E<gt>{flags}> is a hash giving more detailed information
 139 about the patron. Its keys act as flags :
 140
 141     if $borrower->{flags}->{LOST} {
 142         # Patron's card was reported lost
 143     }
 144
 145 If the state of a flag means that the patron should not be
 146 allowed to borrow any more books, then it will have a C<noissues> key
 147 with a true value.
 148
 149 See patronflags for more details.
 150
 151 C<$borrower-E<gt>{authflags}> is a hash giving more detailed information
 152 about the top-level permissions flags set for the borrower.  For example,
 153 if a user has the "editcatalogue" permission,
 154 C<$borrower-E<gt>{authflags}-E<gt>{editcatalogue}> will exist and have
 155 the value "1".
 156
 157 =cut
 158
 159 sub GetMemberDetails {
 160     my ( $borrowernumber, $cardnumber ) = @_;
 161     my $dbh = C4::Context->dbh;
 162     my $query;
 163     my $sth;
 164     if ($borrowernumber) {
 165         $sth = $dbh->prepare("
 166             SELECT borrowers.*,
 167                    category_type,
 168                    categories.description,
 169                    categories.BlockExpiredPatronOpacActions,
 170                    reservefee,
 171                    enrolmentperiod
 172             FROM borrowers
 173             LEFT JOIN categories ON borrowers.categorycode=categories.categorycode
 174             WHERE borrowernumber = ?
 175         ");
 176         $sth->execute($borrowernumber);
 177     }
 178     elsif ($cardnumber) {
 179         $sth = $dbh->prepare("
 180             SELECT borrowers.*,
 181                    category_type,
 182                    categories.description,
 183                    categories.BlockExpiredPatronOpacActions,
 184                    reservefee,
 185                    enrolmentperiod
 186             FROM borrowers
 187             LEFT JOIN categories ON borrowers.categorycode = categories.categorycode
 188             WHERE cardnumber = ?
 189         ");
 190         $sth->execute($cardnumber);
 191     }
 192     else {
 193         return;
 194     }
 195     my $borrower = $sth->fetchrow_hashref;
 196     return unless $borrower;
 197     my ($amount) = GetMemberAccountRecords($borrower->{borrowernumber});
 198     $borrower->{'amountoutstanding'} = $amount;
 199     # FIXME - patronflags calls GetMemberAccountRecords... just have patronflags return $amount
 200     my $flags = patronflags( $borrower);
 201     my $accessflagshash;
 202
 203     $sth = $dbh->prepare("select bit,flag from userflags");
 204     $sth->execute;
 205     while ( my ( $bit, $flag ) = $sth->fetchrow ) {
 206         if ( $borrower->{'flags'} && $borrower->{'flags'} & 2**$bit ) {
 207             $accessflagshash->{$flag} = 1;
 208         }
 209     }
 210     $borrower->{'flags'}     = $flags;
 211     $borrower->{'authflags'} = $accessflagshash;
 212
 213     # Handle setting the true behavior for BlockExpiredPatronOpacActions
 214     $borrower->{'BlockExpiredPatronOpacActions'} =
 215       C4::Context->preference('BlockExpiredPatronOpacActions')
 216       if ( $borrower->{'BlockExpiredPatronOpacActions'} == -1 );
 217
 218     $borrower->{'is_expired'} = 0;
 219     $borrower->{'is_expired'} = 1 if
 220       defined($borrower->{dateexpiry}) &&
 221       $borrower->{'dateexpiry'} ne '0000-00-00' &&
 222       Date_to_Days( Today() ) >
 223       Date_to_Days( split /-/, $borrower->{'dateexpiry'} );
 224
 225     return ($borrower);    #, $flags, $accessflagshash);
 226 }
 227
 228 =head2 patronflags
 229
 230  $flags = &patronflags($patron);
 231
 232 This function is not exported.
 233
 234 The following will be set where applicable:
 235  $flags->{CHARGES}->{amount}        Amount of debt
 236  $flags->{CHARGES}->{noissues}      Set if debt amount >$5.00 (or syspref noissuescharge)
 237  $flags->{CHARGES}->{message}       Message -- deprecated
 238
 239  $flags->{CREDITS}->{amount}        Amount of credit
 240  $flags->{CREDITS}->{message}       Message -- deprecated
 241
 242  $flags->{  GNA  }                  Patron has no valid address
 243  $flags->{  GNA  }->{noissues}      Set for each GNA
 244  $flags->{  GNA  }->{message}       "Borrower has no valid address" -- deprecated
 245
 246  $flags->{ LOST  }                  Patron's card reported lost
 247  $flags->{ LOST  }->{noissues}      Set for each LOST
 248  $flags->{ LOST  }->{message}       Message -- deprecated
 249
 250  $flags->{DBARRED}                  Set if patron debarred, no access
 251  $flags->{DBARRED}->{noissues}      Set for each DBARRED
 252  $flags->{DBARRED}->{message}       Message -- deprecated
 253
 254  $flags->{ NOTES }
 255  $flags->{ NOTES }->{message}       The note itself.  NOT deprecated
 256
 257  $flags->{ ODUES }                  Set if patron has overdue books.
 258  $flags->{ ODUES }->{message}       "Yes"  -- deprecated
 259  $flags->{ ODUES }->{itemlist}      ref-to-array: list of overdue books
 260  $flags->{ ODUES }->{itemlisttext}  Text list of overdue items -- deprecated
 261
 262  $flags->{WAITING}                  Set if any of patron's reserves are available
 263  $flags->{WAITING}->{message}       Message -- deprecated
 264  $flags->{WAITING}->{itemlist}      ref-to-array: list of available items
 265
 266 =over
 267
 268 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the
 269 overdue items. Its elements are references-to-hash, each describing an
 270 overdue item. The keys are selected fields from the issues, biblio,
 271 biblioitems, and items tables of the Koha database.
 272
 273 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlisttext}> is a string giving a text listing of
 274 the overdue items, one per line.  Deprecated.
 275
 276 =item C<$flags-E<gt>{WAITING}-E<gt>{itemlist}> is a reference-to-array listing the
 277 available items. Each element is a reference-to-hash whose keys are
 278 fields from the reserves table of the Koha database.
 279
 280 =back
 281
 282 All the "message" fields that include language generated in this function are deprecated,
 283 because such strings belong properly in the display layer.
 284
 285 The "message" field that comes from the DB is OK.
 286
 287 =cut
 288
 289 # TODO: use {anonymous => hashes} instead of a dozen %flaginfo
 290 # FIXME rename this function.
 291 sub patronflags {
 292     my %flags;
 293     my ( $patroninformation) = @_;
 294     my $dbh=C4::Context->dbh;
 295     my ($balance, $owing) = GetMemberAccountBalance( $patroninformation->{'borrowernumber'});
 296     if ( $owing > 0 ) {
 297         my %flaginfo;
 298         my $noissuescharge = C4::Context->preference("noissuescharge") || 5;
 299         $flaginfo{'message'} = sprintf 'Patron owes %.02f', $owing;
 300         $flaginfo{'amount'}  = sprintf "%.02f", $owing;
 301         if ( $owing > $noissuescharge && !C4::Context->preference("AllowFineOverride") ) {
 302             $flaginfo{'noissues'} = 1;
 303         }
 304         $flags{'CHARGES'} = \%flaginfo;
 305     }
 306     elsif ( $balance < 0 ) {
 307         my %flaginfo;
 308         $flaginfo{'message'} = sprintf 'Patron has credit of %.02f', -$balance;
 309         $flaginfo{'amount'}  = sprintf "%.02f", $balance;
 310         $flags{'CREDITS'} = \%flaginfo;
 311     }
 312
 313     # Check the debt of the guarntees of this patron
 314     my $no_issues_charge_guarantees = C4::Context->preference("NoIssuesChargeGuarantees");
 315     $no_issues_charge_guarantees = undef unless looks_like_number( $no_issues_charge_guarantees );
 316     if ( defined $no_issues_charge_guarantees ) {
 317         my $p = Koha::Patrons->find( $patroninformation->{borrowernumber} );
 318         my @guarantees = $p->guarantees();
 319         my $guarantees_non_issues_charges;
 320         foreach my $g ( @guarantees ) {
 321             my ( $b, $n, $o ) = C4::Members::GetMemberAccountBalance( $g->id );
 322             $guarantees_non_issues_charges += $n;
 323         }
 324
 325         if ( $guarantees_non_issues_charges > $no_issues_charge_guarantees ) {
 326             my %flaginfo;
 327             $flaginfo{'message'} = sprintf 'patron guarantees owe %.02f', $guarantees_non_issues_charges;
 328             $flaginfo{'amount'}  = $guarantees_non_issues_charges;
 329             $flaginfo{'noissues'} = 1 unless C4::Context->preference("allowfineoverride");
 330             $flags{'CHARGES_GUARANTEES'} = \%flaginfo;
 331         }
 332     }
 333
 334     if (   $patroninformation->{'gonenoaddress'}
 335         && $patroninformation->{'gonenoaddress'} == 1 )
 336     {
 337         my %flaginfo;
 338         $flaginfo{'message'}  = 'Borrower has no valid address.';
 339         $flaginfo{'noissues'} = 1;
 340         $flags{'GNA'}         = \%flaginfo;
 341     }
 342     if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
 343         my %flaginfo;
 344         $flaginfo{'message'}  = 'Borrower\'s card reported lost.';
 345         $flaginfo{'noissues'} = 1;
 346         $flags{'LOST'}        = \%flaginfo;
 347     }
 348     if ( $patroninformation->{'debarred'} && check_date( split( /-/, $patroninformation->{'debarred'} ) ) ) {
 349         if ( Date_to_Days(Date::Calc::Today) < Date_to_Days( split( /-/, $patroninformation->{'debarred'} ) ) ) {
 350             my %flaginfo;
 351             $flaginfo{'debarredcomment'} = $patroninformation->{'debarredcomment'};
 352             $flaginfo{'message'}         = $patroninformation->{'debarredcomment'};
 353             $flaginfo{'noissues'}        = 1;
 354             $flaginfo{'dateend'}         = $patroninformation->{'debarred'};
 355             $flags{'DBARRED'}           = \%flaginfo;
 356         }
 357     }
 358     if (   $patroninformation->{'borrowernotes'}
 359         && $patroninformation->{'borrowernotes'} )
 360     {
 361         my %flaginfo;
 362         $flaginfo{'message'} = $patroninformation->{'borrowernotes'};
 363         $flags{'NOTES'}      = \%flaginfo;
 364     }
 365     my ( $odues, $itemsoverdue ) = C4::Overdues::checkoverdues($patroninformation->{'borrowernumber'});
 366     if ( $odues && $odues > 0 ) {
 367         my %flaginfo;
 368         $flaginfo{'message'}  = "Yes";
 369         $flaginfo{'itemlist'} = $itemsoverdue;
 370         foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
 371             @$itemsoverdue )
 372         {
 373             $flaginfo{'itemlisttext'} .=
 374               "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n";  # newline is display layer
 375         }
 376         $flags{'ODUES'} = \%flaginfo;
 377     }
 378     my @itemswaiting = C4::Reserves::GetReservesFromBorrowernumber( $patroninformation->{'borrowernumber'},'W' );
 379     my $nowaiting = scalar @itemswaiting;
 380     if ( $nowaiting > 0 ) {
 381         my %flaginfo;
 382         $flaginfo{'message'}  = "Reserved items available";
 383         $flaginfo{'itemlist'} = \@itemswaiting;
 384         $flags{'WAITING'}     = \%flaginfo;
 385     }
 386     return ( \%flags );
 387 }
 388
 389
 390 =head2 GetMember
 391
 392   $borrower = &GetMember(%information);
 393
 394 Retrieve the first patron record meeting on criteria listed in the
 395 C<%information> hash, which should contain one or more
 396 pairs of borrowers column names and values, e.g.,
 397
 398    $borrower = GetMember(borrowernumber => id);
 399
 400 C<&GetBorrower> returns a reference-to-hash whose keys are the fields of
 401 the C<borrowers> table in the Koha database.
 402
 403 FIXME: GetMember() is used throughout the code as a lookup
 404 on a unique key such as the borrowernumber, but this meaning is not
 405 enforced in the routine itself.
 406
 407 =cut
 408
 409 #'
 410 sub GetMember {
 411     my ( %information ) = @_;
 412     if (exists $information{borrowernumber} && !defined $information{borrowernumber}) {
 413         #passing mysql's kohaadmin?? Makes no sense as a query
 414         return;
 415     }
 416     my $dbh = C4::Context->dbh;
 417     my $select =
 418     q{SELECT borrowers.*, categories.category_type, categories.description
 419     FROM borrowers
 420     LEFT JOIN categories on borrowers.categorycode=categories.categorycode WHERE };
 421     my $more_p = 0;
 422     my @values = ();
 423     for (keys %information ) {
 424         if ($more_p) {
 425             $select .= ' AND ';
 426         }
 427         else {
 428             $more_p++;
 429         }
 430
 431         if (defined $information{$_}) {
 432             $select .= "$_ = ?";
 433             push @values, $information{$_};
 434         }
 435         else {
 436             $select .= "$_ IS NULL";
 437         }
 438     }
 439     $debug && warn $select, " ",values %information;
 440     my $sth = $dbh->prepare("$select");
 441     $sth->execute(@values);
 442     my $data = $sth->fetchall_arrayref({});
 443     #FIXME interface to this routine now allows generation of a result set
 444     #so whole array should be returned but bowhere in the current code expects this
 445     if (@{$data} ) {
 446         return $data->[0];
 447     }
 448
 449     return;
 450 }
 451
 452 =head2 GetMemberIssuesAndFines
 453
 454   ($overdue_count, $issue_count, $total_fines) = &GetMemberIssuesAndFines($borrowernumber);
 455
 456 Returns aggregate data about items borrowed by the patron with the
 457 given borrowernumber.
 458
 459 C<&GetMemberIssuesAndFines> returns a three-element array.  C<$overdue_count> is the
 460 number of overdue items the patron currently has borrowed. C<$issue_count> is the
 461 number of books the patron currently has borrowed.  C<$total_fines> is
 462 the total fine currently due by the borrower.
 463
 464 =cut
 465
 466 #'
 467 sub GetMemberIssuesAndFines {
 468     my ( $borrowernumber ) = @_;
 469     my $dbh   = C4::Context->dbh;
 470     my $query = "SELECT COUNT(*) FROM issues WHERE borrowernumber = ?";
 471
 472     $debug and warn $query."\n";
 473     my $sth = $dbh->prepare($query);
 474     $sth->execute($borrowernumber);
 475     my $issue_count = $sth->fetchrow_arrayref->[0];
 476
 477     $sth = $dbh->prepare(
 478         "SELECT COUNT(*) FROM issues
 479          WHERE borrowernumber = ?
 480          AND date_due < now()"
 481     );
 482     $sth->execute($borrowernumber);
 483     my $overdue_count = $sth->fetchrow_arrayref->[0];
 484
 485     $sth = $dbh->prepare("SELECT SUM(amountoutstanding) FROM accountlines WHERE borrowernumber = ?");
 486     $sth->execute($borrowernumber);
 487     my $total_fines = $sth->fetchrow_arrayref->[0];
 488
 489     return ($overdue_count, $issue_count, $total_fines);
 490 }
 491
 492
 493 =head2 ModMember
 494
 495   my $success = ModMember(borrowernumber => $borrowernumber,
 496                                             [ field => value ]... );
 497
 498 Modify borrower's data.  All date fields should ALREADY be in ISO format.
 499
 500 return :
 501 true on success, or false on failure
 502
 503 =cut
 504
 505 sub ModMember {
 506     my (%data) = @_;
 507     # test to know if you must update or not the borrower password
 508     if (exists $data{password}) {
 509         if ($data{password} eq '****' or $data{password} eq '') {
 510             delete $data{password};
 511         } else {
 512             if ( C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
 513                 # Update the hashed PIN in borrower_sync.hashed_pin, before Koha hashes it
 514                 Koha::NorwegianPatronDB::NLUpdateHashedPIN( $data{'borrowernumber'}, $data{password} );
 515             }
 516             $data{password} = hash_password($data{password});
 517         }
 518     }
 519
 520     my $old_categorycode = Koha::Patrons->find( $data{borrowernumber} )->categorycode;
 521
 522     # get only the columns of a borrower
 523     my $schema = Koha::Database->new()->schema;
 524     my @columns = $schema->source('Borrower')->columns;
 525     my $new_borrower = { map { join(' ', @columns) =~ /$_/ ? ( $_ => $data{$_} ) : () } keys(%data) };
 526     delete $new_borrower->{flags};
 527
 528     $new_borrower->{dateofbirth}     ||= undef if exists $new_borrower->{dateofbirth};
 529     $new_borrower->{dateenrolled}    ||= undef if exists $new_borrower->{dateenrolled};
 530     $new_borrower->{dateexpiry}      ||= undef if exists $new_borrower->{dateexpiry};
 531     $new_borrower->{debarred}        ||= undef if exists $new_borrower->{debarred};
 532     $new_borrower->{sms_provider_id} ||= undef if exists $new_borrower->{sms_provider_id};
 533     $new_borrower->{guarantorid}     ||= undef if exists $new_borrower->{guarantorid};
 534
 535     my $patron = Koha::Patrons->find( $new_borrower->{borrowernumber} );
 536
 537     delete $new_borrower->{userid} if exists $new_borrower->{userid} and not $new_borrower->{userid};
 538
 539     my $execute_success = $patron->store if $patron->set($new_borrower);
 540
 541     if ($execute_success) { # only proceed if the update was a success
 542         # If the patron changes to a category with enrollment fee, we add a fee
 543         if ( $data{categorycode} and $data{categorycode} ne $old_categorycode ) {
 544             if ( C4::Context->preference('FeeOnChangePatronCategory') ) {
 545                 $patron->add_enrolment_fee_if_needed;
 546             }
 547         }
 548
 549         # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
 550         # cronjob will use for syncing with NL
 551         if ( C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
 552             my $borrowersync = Koha::Database->new->schema->resultset('BorrowerSync')->find({
 553                 'synctype'       => 'norwegianpatrondb',
 554                 'borrowernumber' => $data{'borrowernumber'}
 555             });
 556             # Do not set to "edited" if syncstatus is "new". We need to sync as new before
 557             # we can sync as changed. And the "new sync" will pick up all changes since
 558             # the patron was created anyway.
 559             if ( $borrowersync->syncstatus ne 'new' && $borrowersync->syncstatus ne 'delete' ) {
 560                 $borrowersync->update( { 'syncstatus' => 'edited' } );
 561             }
 562             # Set the value of 'sync'
 563             $borrowersync->update( { 'sync' => $data{'sync'} } );
 564             # Try to do the live sync
 565             Koha::NorwegianPatronDB::NLSync({ 'borrowernumber' => $data{'borrowernumber'} });
 566         }
 567
 568         logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "UPDATE (executed w/ arg: $data{'borrowernumber'})") if C4::Context->preference("BorrowersLog");
 569     }
 570     return $execute_success;
 571 }
 572
 573 =head2 AddMember
 574
 575   $borrowernumber = &AddMember(%borrower);
 576
 577 insert new borrower into table
 578
 579 (%borrower keys are database columns. Database columns could be
 580 different in different versions. Please look into database for correct
 581 column names.)
 582
 583 Returns the borrowernumber upon success
 584
 585 Returns as undef upon any db error without further processing
 586
 587 =cut
 588
 589 #'
 590 sub AddMember {
 591     my (%data) = @_;
 592     my $dbh = C4::Context->dbh;
 593     my $schema = Koha::Database->new()->schema;
 594
 595     # generate a proper login if none provided
 596     $data{'userid'} = Generate_Userid( $data{'borrowernumber'}, $data{'firstname'}, $data{'surname'} )
 597       if ( $data{'userid'} eq '' || !Check_Userid( $data{'userid'} ) );
 598
 599     # add expiration date if it isn't already there
 600     $data{dateexpiry} ||= Koha::Patron::Categories->find( $data{categorycode} )->get_expiry_date;
 601
 602     # add enrollment date if it isn't already there
 603     unless ( $data{'dateenrolled'} ) {
 604         $data{'dateenrolled'} = output_pref( { dt => dt_from_string, dateonly => 1, dateformat => 'iso' } );
 605     }
 606
 607     my $patron_category = $schema->resultset('Category')->find( $data{'categorycode'} );
 608     $data{'privacy'} =
 609         $patron_category->default_privacy() eq 'default' ? 1
 610       : $patron_category->default_privacy() eq 'never'   ? 2
 611       : $patron_category->default_privacy() eq 'forever' ? 0
 612       :                                                    undef;
 613
 614     $data{'privacy_guarantor_checkouts'} = 0 unless defined( $data{'privacy_guarantor_checkouts'} );
 615
 616     # Make a copy of the plain text password for later use
 617     my $plain_text_password = $data{'password'};
 618
 619     # create a disabled account if no password provided
 620     $data{'password'} = ($data{'password'})? hash_password($data{'password'}) : '!';
 621
 622     # we don't want invalid dates in the db (mysql has a bad habit of inserting 0000-00-00
 623     $data{'dateofbirth'}     = undef if ( not $data{'dateofbirth'} );
 624     $data{'debarred'}        = undef if ( not $data{'debarred'} );
 625     $data{'sms_provider_id'} = undef if ( not $data{'sms_provider_id'} );
 626
 627     # get only the columns of Borrower
 628     # FIXME Do we really need this check?
 629     my @columns = $schema->source('Borrower')->columns;
 630     my $new_member = { map { join(' ',@columns) =~ /$_/ ? ( $_ => $data{$_} )  : () } keys(%data) } ;
 631
 632     delete $new_member->{borrowernumber};
 633
 634     my $patron = Koha::Patron->new( $new_member )->store;
 635     $data{borrowernumber} = $patron->borrowernumber;
 636
 637     # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
 638     # cronjob will use for syncing with NL
 639     if ( exists $data{'borrowernumber'} && C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
 640         Koha::Database->new->schema->resultset('BorrowerSync')->create({
 641             'borrowernumber' => $data{'borrowernumber'},
 642             'synctype'       => 'norwegianpatrondb',
 643             'sync'           => 1,
 644             'syncstatus'     => 'new',
 645             'hashed_pin'     => Koha::NorwegianPatronDB::NLEncryptPIN( $plain_text_password ),
 646         });
 647     }
 648
 649     logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");
 650
 651     $patron->add_enrolment_fee_if_needed;
 652
 653     return $data{borrowernumber};
 654 }
 655
 656 =head2 Check_Userid
 657
 658     my $uniqueness = Check_Userid($userid,$borrowernumber);
 659
 660     $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 != '').
 661
 662     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.
 663
 664     return :
 665         0 for not unique (i.e. this $userid already exists)
 666         1 for unique (i.e. this $userid does not exist, or this $userid/$borrowernumber combination already exists)
 667
 668 =cut
 669
 670 sub Check_Userid {
 671     my ( $uid, $borrowernumber ) = @_;
 672
 673     return 0 unless ($uid); # userid is a unique column, we should assume NULL is not unique
 674
 675     return 0 if ( $uid eq C4::Context->config('user') );
 676
 677     my $rs = Koha::Database->new()->schema()->resultset('Borrower');
 678
 679     my $params;
 680     $params->{userid} = $uid;
 681     $params->{borrowernumber} = { '!=' => $borrowernumber } if ($borrowernumber);
 682
 683     my $count = $rs->count( $params );
 684
 685     return $count ? 0 : 1;
 686 }
 687
 688 =head2 Generate_Userid
 689
 690     my $newuid = Generate_Userid($borrowernumber, $firstname, $surname);
 691
 692     Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
 693
 694     $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.
 695
 696     return :
 697         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).
 698
 699 =cut
 700
 701 sub Generate_Userid {
 702   my ($borrowernumber, $firstname, $surname) = @_;
 703   my $newuid;
 704   my $offset = 0;
 705   #The script will "do" the following code and increment the $offset until Check_Userid = 1 (i.e. until $newuid comes back as unique)
 706   do {
 707     $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
 708     $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
 709     $newuid = lc(($firstname)? "$firstname.$surname" : $surname);
 710     $newuid = unac_string('utf-8',$newuid);
 711     $newuid .= $offset unless $offset == 0;
 712     $offset++;
 713
 714    } while (!Check_Userid($newuid,$borrowernumber));
 715
 716    return $newuid;
 717 }
 718
 719 =head2 fixup_cardnumber
 720
 721 Warning: The caller is responsible for locking the members table in write
 722 mode, to avoid database corruption.
 723
 724 =cut
 725
 726 use vars qw( @weightings );
 727 my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
 728
 729 sub fixup_cardnumber {
 730     my ($cardnumber) = @_;
 731     my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0;
 732
 733     # Find out whether member numbers should be generated
 734     # automatically. Should be either "1" or something else.
 735     # Defaults to "0", which is interpreted as "no".
 736
 737     #     if ($cardnumber !~ /\S/ && $autonumber_members) {
 738     ($autonumber_members) or return $cardnumber;
 739     my $checkdigit = C4::Context->preference('checkdigit');
 740     my $dbh = C4::Context->dbh;
 741     if ( $checkdigit and $checkdigit eq 'katipo' ) {
 742
 743         # if checkdigit is selected, calculate katipo-style cardnumber.
 744         # otherwise, just use the max()
 745         # purpose: generate checksum'd member numbers.
 746         # We'll assume we just got the max value of digits 2-8 of member #'s
 747         # from the database and our job is to increment that by one,
 748         # determine the 1st and 9th digits and return the full string.
 749         my $sth = $dbh->prepare(
 750             "select max(substring(borrowers.cardnumber,2,7)) as new_num from borrowers"
 751         );
 752         $sth->execute;
 753         my $data = $sth->fetchrow_hashref;
 754         $cardnumber = $data->{new_num};
 755         if ( !$cardnumber ) {    # If DB has no values,
 756             $cardnumber = 1000000;    # start at 1000000
 757         } else {
 758             $cardnumber += 1;
 759         }
 760
 761         my $sum = 0;
 762         for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
 763             # read weightings, left to right, 1 char at a time
 764             my $temp1 = $weightings[$i];
 765
 766             # sequence left to right, 1 char at a time
 767             my $temp2 = substr( $cardnumber, $i, 1 );
 768
 769             # mult each char 1-7 by its corresponding weighting
 770             $sum += $temp1 * $temp2;
 771         }
 772
 773         my $rem = ( $sum % 11 );
 774         $rem = 'X' if $rem == 10;
 775
 776         return "V$cardnumber$rem";
 777      } else {
 778
 779         my $sth = $dbh->prepare(
 780             'SELECT MAX( CAST( cardnumber AS SIGNED ) ) FROM borrowers WHERE cardnumber REGEXP "^-?[0-9]+$"'
 781         );
 782         $sth->execute;
 783         my ($result) = $sth->fetchrow;
 784         return $result + 1;
 785     }
 786     return $cardnumber;     # just here as a fallback/reminder
 787 }
 788
 789 =head2 GetPendingIssues
 790
 791   my $issues = &GetPendingIssues(@borrowernumber);
 792
 793 Looks up what the patron with the given borrowernumber has borrowed.
 794
 795 C<&GetPendingIssues> returns a
 796 reference-to-array where each element is a reference-to-hash; the
 797 keys are the fields from the C<issues>, C<biblio>, and C<items> tables.
 798 The keys include C<biblioitems> fields except marc and marcxml.
 799
 800 =cut
 801
 802 sub GetPendingIssues {
 803     my @borrowernumbers = @_;
 804
 805     unless (@borrowernumbers ) { # return a ref_to_array
 806         return \@borrowernumbers; # to not cause surprise to caller
 807     }
 808
 809     # Borrowers part of the query
 810     my $bquery = '';
 811     for (my $i = 0; $i < @borrowernumbers; $i++) {
 812         $bquery .= ' issues.borrowernumber = ?';
 813         if ($i < $#borrowernumbers ) {
 814             $bquery .= ' OR';
 815         }
 816     }
 817
 818     # must avoid biblioitems.* to prevent large marc and marcxml fields from killing performance
 819     # FIXME: namespace collision: each table has "timestamp" fields.  Which one is "timestamp" ?
 820     # FIXME: circ/ciculation.pl tries to sort by timestamp!
 821     # FIXME: namespace collision: other collisions possible.
 822     # FIXME: most of this data isn't really being used by callers.
 823     my $query =
 824    "SELECT issues.*,
 825             items.*,
 826            biblio.*,
 827            biblioitems.volume,
 828            biblioitems.number,
 829            biblioitems.itemtype,
 830            biblioitems.isbn,
 831            biblioitems.issn,
 832            biblioitems.publicationyear,
 833            biblioitems.publishercode,
 834            biblioitems.volumedate,
 835            biblioitems.volumedesc,
 836            biblioitems.lccn,
 837            biblioitems.url,
 838            borrowers.firstname,
 839            borrowers.surname,
 840            borrowers.cardnumber,
 841            issues.timestamp AS timestamp,
 842            issues.renewals  AS renewals,
 843            issues.borrowernumber AS borrowernumber,
 844             items.renewals  AS totalrenewals
 845     FROM   issues
 846     LEFT JOIN items       ON items.itemnumber       =      issues.itemnumber
 847     LEFT JOIN biblio      ON items.biblionumber     =      biblio.biblionumber
 848     LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
 849     LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
 850     WHERE
 851       $bquery
 852     ORDER BY issues.issuedate"
 853     ;
 854
 855     my $sth = C4::Context->dbh->prepare($query);
 856     $sth->execute(@borrowernumbers);
 857     my $data = $sth->fetchall_arrayref({});
 858     my $today = dt_from_string;
 859     foreach (@{$data}) {
 860         if ($_->{issuedate}) {
 861             $_->{issuedate} = dt_from_string($_->{issuedate}, 'sql');
 862         }
 863         $_->{date_due_sql} = $_->{date_due};
 864         # FIXME no need to have this value
 865         $_->{date_due} or next;
 866         $_->{date_due_sql} = $_->{date_due};
 867         # FIXME no need to have this value
 868         $_->{date_due} = dt_from_string($_->{date_due}, 'sql');
 869         if ( DateTime->compare($_->{date_due}, $today) == -1 ) {
 870             $_->{overdue} = 1;
 871         }
 872     }
 873     return $data;
 874 }
 875
 876 =head2 GetAllIssues
 877
 878   $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
 879
 880 Looks up what the patron with the given borrowernumber has borrowed,
 881 and sorts the results.
 882
 883 C<$sortkey> is the name of a field on which to sort the results. This
 884 should be the name of a field in the C<issues>, C<biblio>,
 885 C<biblioitems>, or C<items> table in the Koha database.
 886
 887 C<$limit> is the maximum number of results to return.
 888
 889 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
 890 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
 891 C<items> tables of the Koha database.
 892
 893 =cut
 894
 895 #'
 896 sub GetAllIssues {
 897     my ( $borrowernumber, $order, $limit ) = @_;
 898
 899     return unless $borrowernumber;
 900     $order = 'date_due desc' unless $order;
 901
 902     my $dbh = C4::Context->dbh;
 903     my $query =
 904 'SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
 905   FROM issues
 906   LEFT JOIN items on items.itemnumber=issues.itemnumber
 907   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
 908   LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
 909   WHERE borrowernumber=?
 910   UNION ALL
 911   SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
 912   FROM old_issues
 913   LEFT JOIN items on items.itemnumber=old_issues.itemnumber
 914   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
 915   LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
 916   WHERE borrowernumber=? AND old_issues.itemnumber IS NOT NULL
 917   order by ' . $order;
 918     if ($limit) {
 919         $query .= " limit $limit";
 920     }
 921
 922     my $sth = $dbh->prepare($query);
 923     $sth->execute( $borrowernumber, $borrowernumber );
 924     return $sth->fetchall_arrayref( {} );
 925 }
 926
 927
 928 =head2 GetMemberAccountRecords
 929
 930   ($total, $acctlines, $count) = &GetMemberAccountRecords($borrowernumber);
 931
 932 Looks up accounting data for the patron with the given borrowernumber.
 933
 934 C<&GetMemberAccountRecords> returns a three-element array. C<$acctlines> is a
 935 reference-to-array, where each element is a reference-to-hash; the
 936 keys are the fields of the C<accountlines> table in the Koha database.
 937 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
 938 total amount outstanding for all of the account lines.
 939
 940 =cut
 941
 942 sub GetMemberAccountRecords {
 943     my ($borrowernumber) = @_;
 944     my $dbh = C4::Context->dbh;
 945     my @acctlines;
 946     my $numlines = 0;
 947     my $strsth      = qq(
 948                         SELECT *
 949                         FROM accountlines
 950                         WHERE borrowernumber=?);
 951     $strsth.=" ORDER BY accountlines_id desc";
 952     my $sth= $dbh->prepare( $strsth );
 953     $sth->execute( $borrowernumber );
 954
 955     my $total = 0;
 956     while ( my $data = $sth->fetchrow_hashref ) {
 957         if ( $data->{itemnumber} ) {
 958             my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
 959             $data->{biblionumber} = $biblio->{biblionumber};
 960             $data->{title}        = $biblio->{title};
 961         }
 962         $acctlines[$numlines] = $data;
 963         $numlines++;
 964         $total += sprintf "%.0f", 1000*$data->{amountoutstanding}; # convert float to integer to avoid round-off errors
 965     }
 966     $total /= 1000;
 967     return ( $total, \@acctlines,$numlines);
 968 }
 969
 970 =head2 GetMemberAccountBalance
 971
 972   ($total_balance, $non_issue_balance, $other_charges) = &GetMemberAccountBalance($borrowernumber);
 973
 974 Calculates amount immediately owing by the patron - non-issue charges.
 975 Based on GetMemberAccountRecords.
 976 Charges exempt from non-issue are:
 977 * Res (reserves)
 978 * Rent (rental) if RentalsInNoissuesCharge syspref is set to false
 979 * Manual invoices if ManInvInNoissuesCharge syspref is set to false
 980
 981 =cut
 982
 983 sub GetMemberAccountBalance {
 984     my ($borrowernumber) = @_;
 985
 986     my $ACCOUNT_TYPE_LENGTH = 5; # this is plain ridiculous...
 987
 988     my @not_fines;
 989     push @not_fines, 'Res' unless C4::Context->preference('HoldsInNoissuesCharge');
 990     push @not_fines, 'Rent' unless C4::Context->preference('RentalsInNoissuesCharge');
 991     unless ( C4::Context->preference('ManInvInNoissuesCharge') ) {
 992         my $dbh = C4::Context->dbh;
 993         my $man_inv_types = $dbh->selectcol_arrayref(qq{SELECT authorised_value FROM authorised_values WHERE category = 'MANUAL_INV'});
 994         push @not_fines, map substr($_, 0, $ACCOUNT_TYPE_LENGTH), @$man_inv_types;
 995     }
 996     my %not_fine = map {$_ => 1} @not_fines;
 997
 998     my ($total, $acctlines) = GetMemberAccountRecords($borrowernumber);
 999     my $other_charges = 0;
1000     foreach (@$acctlines) {
1001         $other_charges += $_->{amountoutstanding} if $not_fine{ substr($_->{accounttype}, 0, $ACCOUNT_TYPE_LENGTH) };
1002     }
1003
1004     return ( $total, $total - $other_charges, $other_charges);
1005 }
1006
1007 =head2 GetBorNotifyAcctRecord
1008
1009   ($total, $acctlines, $count) = &GetBorNotifyAcctRecord($params,$notifyid);
1010
1011 Looks up accounting data for the patron with the given borrowernumber per file number.
1012
1013 C<&GetBorNotifyAcctRecord> returns a three-element array. C<$acctlines> is a
1014 reference-to-array, where each element is a reference-to-hash; the
1015 keys are the fields of the C<accountlines> table in the Koha database.
1016 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1017 total amount outstanding for all of the account lines.
1018
1019 =cut
1020
1021 sub GetBorNotifyAcctRecord {
1022     my ( $borrowernumber, $notifyid ) = @_;
1023     my $dbh = C4::Context->dbh;
1024     my @acctlines;
1025     my $numlines = 0;
1026     my $sth = $dbh->prepare(
1027             "SELECT *
1028                 FROM accountlines
1029                 WHERE borrowernumber=?
1030                     AND notify_id=?
1031                     AND amountoutstanding != '0'
1032                 ORDER BY notify_id,accounttype
1033                 ");
1034
1035     $sth->execute( $borrowernumber, $notifyid );
1036     my $total = 0;
1037     while ( my $data = $sth->fetchrow_hashref ) {
1038         if ( $data->{itemnumber} ) {
1039             my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
1040             $data->{biblionumber} = $biblio->{biblionumber};
1041             $data->{title}        = $biblio->{title};
1042         }
1043         $acctlines[$numlines] = $data;
1044         $numlines++;
1045         $total += int(100 * $data->{'amountoutstanding'});
1046     }
1047     $total /= 100;
1048     return ( $total, \@acctlines, $numlines );
1049 }
1050
1051 sub checkcardnumber {
1052     my ( $cardnumber, $borrowernumber ) = @_;
1053
1054     # If cardnumber is null, we assume they're allowed.
1055     return 0 unless defined $cardnumber;
1056
1057     my $dbh = C4::Context->dbh;
1058     my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
1059     $query .= " AND borrowernumber <> ?" if ($borrowernumber);
1060     my $sth = $dbh->prepare($query);
1061     $sth->execute(
1062         $cardnumber,
1063         ( $borrowernumber ? $borrowernumber : () )
1064     );
1065
1066     return 1 if $sth->fetchrow_hashref;
1067
1068     my ( $min_length, $max_length ) = get_cardnumber_length();
1069     return 2
1070         if length $cardnumber > $max_length
1071         or length $cardnumber < $min_length;
1072
1073     return 0;
1074 }
1075
1076 =head2 get_cardnumber_length
1077
1078     my ($min, $max) = C4::Members::get_cardnumber_length()
1079
1080 Returns the minimum and maximum length for patron cardnumbers as
1081 determined by the CardnumberLength system preference, the
1082 BorrowerMandatoryField system preference, and the width of the
1083 database column.
1084
1085 =cut
1086
1087 sub get_cardnumber_length {
1088     my ( $min, $max ) = ( 0, 16 ); # borrowers.cardnumber is a nullable varchar(16)
1089     $min = 1 if C4::Context->preference('BorrowerMandatoryField') =~ /cardnumber/;
1090     if ( my $cardnumber_length = C4::Context->preference('CardnumberLength') ) {
1091         # Is integer and length match
1092         if ( $cardnumber_length =~ m|^\d+$| ) {
1093             $min = $max = $cardnumber_length
1094                 if $cardnumber_length >= $min
1095                     and $cardnumber_length <= $max;
1096         }
1097         # Else assuming it is a range
1098         elsif ( $cardnumber_length =~ m|(\d*),(\d*)| ) {
1099             $min = $1 if $1 and $min < $1;
1100             $max = $2 if $2 and $max > $2;
1101         }
1102
1103     }
1104     my $borrower = Koha::Schema->resultset('Borrower');
1105     my $field_size = $borrower->result_source->column_info('cardnumber')->{size};
1106     $min = $field_size if $min > $field_size;
1107     return ( $min, $max );
1108 }
1109
1110 =head2 GetFirstValidEmailAddress
1111
1112   $email = GetFirstValidEmailAddress($borrowernumber);
1113
1114 Return the first valid email address for a borrower, given the borrowernumber.  For now, the order
1115 is defined as email, emailpro, B_email.  Returns the empty string if the borrower has no email
1116 addresses.
1117
1118 =cut
1119
1120 sub GetFirstValidEmailAddress {
1121     my $borrowernumber = shift;
1122     my $dbh = C4::Context->dbh;
1123     my $sth = $dbh->prepare( "SELECT email, emailpro, B_email FROM borrowers where borrowernumber = ? ");
1124     $sth->execute( $borrowernumber );
1125     my $data = $sth->fetchrow_hashref;
1126
1127     if ($data->{'email'}) {
1128        return $data->{'email'};
1129     } elsif ($data->{'emailpro'}) {
1130        return $data->{'emailpro'};
1131     } elsif ($data->{'B_email'}) {
1132        return $data->{'B_email'};
1133     } else {
1134        return '';
1135     }
1136 }
1137
1138 =head2 GetNoticeEmailAddress
1139
1140   $email = GetNoticeEmailAddress($borrowernumber);
1141
1142 Return the email address of borrower used for notices, given the borrowernumber.
1143 Returns the empty string if no email address.
1144
1145 =cut
1146
1147 sub GetNoticeEmailAddress {
1148     my $borrowernumber = shift;
1149
1150     my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
1151     # if syspref is set to 'first valid' (value == OFF), look up email address
1152     if ( $which_address eq 'OFF' ) {
1153         return GetFirstValidEmailAddress($borrowernumber);
1154     }
1155     # specified email address field
1156     my $dbh = C4::Context->dbh;
1157     my $sth = $dbh->prepare( qq{
1158         SELECT $which_address AS primaryemail
1159         FROM borrowers
1160         WHERE borrowernumber=?
1161     } );
1162     $sth->execute($borrowernumber);
1163     my $data = $sth->fetchrow_hashref;
1164     return $data->{'primaryemail'} || '';
1165 }
1166
1167 =head2 GetUpcomingMembershipExpires
1168
1169     my $expires = GetUpcomingMembershipExpires({
1170         branch => $branch, before => $before, after => $after,
1171     });
1172
1173     $branch is an optional branch code.
1174     $before/$after is an optional number of days before/after the date that
1175     is set by the preference MembershipExpiryDaysNotice.
1176     If the pref would be 14, before 2 and after 3, you will get all expires
1177     from 12 to 17 days.
1178
1179 =cut
1180
1181 sub GetUpcomingMembershipExpires {
1182     my ( $params ) = @_;
1183     my $before = $params->{before} || 0;
1184     my $after  = $params->{after} || 0;
1185     my $branch = $params->{branch};
1186
1187     my $dbh = C4::Context->dbh;
1188     my $days = C4::Context->preference("MembershipExpiryDaysNotice") || 0;
1189     my $date1 = dt_from_string->add( days => $days - $before );
1190     my $date2 = dt_from_string->add( days => $days + $after );
1191     $date1= output_pref({ dt => $date1, dateformat => 'iso', dateonly => 1 });
1192     $date2= output_pref({ dt => $date2, dateformat => 'iso', dateonly => 1 });
1193
1194     my $query = q|
1195         SELECT borrowers.*, categories.description,
1196         branches.branchname, branches.branchemail FROM borrowers
1197         LEFT JOIN branches USING (branchcode)
1198         LEFT JOIN categories USING (categorycode)
1199     |;
1200     if( $branch ) {
1201         $query.= 'WHERE branchcode=? AND dateexpiry BETWEEN ? AND ?';
1202     } else {
1203         $query.= 'WHERE dateexpiry BETWEEN ? AND ?';
1204     }
1205
1206     my $sth = $dbh->prepare( $query );
1207     my @pars = $branch? ( $branch ): ();
1208     push @pars, $date1, $date2;
1209     $sth->execute( @pars );
1210     my $results = $sth->fetchall_arrayref( {} );
1211     return $results;
1212 }
1213
1214 =head2 GetAge
1215
1216   $dateofbirth,$date = &GetAge($date);
1217
1218 this function return the borrowers age with the value of dateofbirth
1219
1220 =cut
1221
1222 #'
1223 sub GetAge{
1224     my ( $date, $date_ref ) = @_;
1225
1226     if ( not defined $date_ref ) {
1227         $date_ref = sprintf( '%04d-%02d-%02d', Today() );
1228     }
1229
1230     my ( $year1, $month1, $day1 ) = split /-/, $date;
1231     my ( $year2, $month2, $day2 ) = split /-/, $date_ref;
1232
1233     my $age = $year2 - $year1;
1234     if ( $month1 . $day1 > $month2 . $day2 ) {
1235         $age--;
1236     }
1237
1238     return $age;
1239 }    # sub get_age
1240
1241 =head2 SetAge
1242
1243   $borrower = C4::Members::SetAge($borrower, $datetimeduration);
1244   $borrower = C4::Members::SetAge($borrower, '0015-12-10');
1245   $borrower = C4::Members::SetAge($borrower, $datetimeduration, $datetime_reference);
1246
1247   eval { $borrower = C4::Members::SetAge($borrower, '015-1-10'); };
1248   if ($@) {print $@;} #Catch a bad ISO Date or kill your script!
1249
1250 This function sets the borrower's dateofbirth to match the given age.
1251 Optionally relative to the given $datetime_reference.
1252
1253 @PARAM1 koha.borrowers-object
1254 @PARAM2 DateTime::Duration-object as the desired age
1255         OR a ISO 8601 Date. (To make the API more pleasant)
1256 @PARAM3 DateTime-object as the relative date, defaults to now().
1257 RETURNS The given borrower reference @PARAM1.
1258 DIES    If there was an error with the ISO Date handling.
1259
1260 =cut
1261
1262 #'
1263 sub SetAge{
1264     my ( $borrower, $datetimeduration, $datetime_ref ) = @_;
1265     $datetime_ref = DateTime->now() unless $datetime_ref;
1266
1267     if ($datetimeduration && ref $datetimeduration ne 'DateTime::Duration') {
1268         if ($datetimeduration =~ /^(\d{4})-(\d{2})-(\d{2})/) {
1269             $datetimeduration = DateTime::Duration->new(years => $1, months => $2, days => $3);
1270         }
1271         else {
1272             die "C4::Members::SetAge($borrower, $datetimeduration), datetimeduration not a valid ISO 8601 Date!\n";
1273         }
1274     }
1275
1276     my $new_datetime_ref = $datetime_ref->clone();
1277     $new_datetime_ref->subtract_duration( $datetimeduration );
1278
1279     $borrower->{dateofbirth} = $new_datetime_ref->ymd();
1280
1281     return $borrower;
1282 }    # sub SetAge
1283
1284 =head2 GetBorrowersToExpunge
1285
1286   $borrowers = &GetBorrowersToExpunge(
1287       not_borrowed_since => $not_borrowed_since,
1288       expired_before       => $expired_before,
1289       category_code        => $category_code,
1290       patron_list_id       => $patron_list_id,
1291       branchcode           => $branchcode
1292   );
1293
1294   This function get all borrowers based on the given criteria.
1295
1296 =cut
1297
1298 sub GetBorrowersToExpunge {
1299
1300     my $params = shift;
1301     my $filterdate       = $params->{'not_borrowed_since'};
1302     my $filterexpiry     = $params->{'expired_before'};
1303     my $filterlastseen   = $params->{'last_seen'};
1304     my $filtercategory   = $params->{'category_code'};
1305     my $filterbranch     = $params->{'branchcode'} ||
1306                         ((C4::Context->preference('IndependentBranches')
1307                              && C4::Context->userenv
1308                              && !C4::Context->IsSuperLibrarian()
1309                              && C4::Context->userenv->{branch})
1310                          ? C4::Context->userenv->{branch}
1311                          : "");
1312     my $filterpatronlist = $params->{'patron_list_id'};
1313
1314     my $dbh   = C4::Context->dbh;
1315     my $query = q|
1316         SELECT borrowers.borrowernumber,
1317                MAX(old_issues.timestamp) AS latestissue,
1318                MAX(issues.timestamp) AS currentissue
1319         FROM   borrowers
1320         JOIN   categories USING (categorycode)
1321         LEFT JOIN (
1322             SELECT guarantorid
1323             FROM borrowers
1324             WHERE guarantorid IS NOT NULL
1325                 AND guarantorid <> 0
1326         ) as tmp ON borrowers.borrowernumber=tmp.guarantorid
1327         LEFT JOIN old_issues USING (borrowernumber)
1328         LEFT JOIN issues USING (borrowernumber)|;
1329     if ( $filterpatronlist  ){
1330         $query .= q| LEFT JOIN patron_list_patrons USING (borrowernumber)|;
1331     }
1332     $query .= q| WHERE  category_type <> 'S'
1333         AND tmp.guarantorid IS NULL
1334    |;
1335     my @query_params;
1336     if ( $filterbranch && $filterbranch ne "" ) {
1337         $query.= " AND borrowers.branchcode = ? ";
1338         push( @query_params, $filterbranch );
1339     }
1340     if ( $filterexpiry ) {
1341         $query .= " AND dateexpiry < ? ";
1342         push( @query_params, $filterexpiry );
1343     }
1344     if ( $filterlastseen ) {
1345         $query .= ' AND lastseen < ? ';
1346         push @query_params, $filterlastseen;
1347     }
1348     if ( $filtercategory ) {
1349         $query .= " AND categorycode = ? ";
1350         push( @query_params, $filtercategory );
1351     }
1352     if ( $filterpatronlist ){
1353         $query.=" AND patron_list_id = ? ";
1354         push( @query_params, $filterpatronlist );
1355     }
1356     $query.=" GROUP BY borrowers.borrowernumber HAVING currentissue IS NULL ";
1357     if ( $filterdate ) {
1358         $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
1359         push @query_params,$filterdate;
1360     }
1361     warn $query if $debug;
1362
1363     my $sth = $dbh->prepare($query);
1364     if (scalar(@query_params)>0){
1365         $sth->execute(@query_params);
1366     }
1367     else {
1368         $sth->execute;
1369     }
1370
1371     my @results;
1372     while ( my $data = $sth->fetchrow_hashref ) {
1373         push @results, $data;
1374     }
1375     return \@results;
1376 }
1377
1378 =head2 GetBorrowersWhoHaveNeverBorrowed
1379
1380   $results = &GetBorrowersWhoHaveNeverBorrowed
1381
1382 This function get all borrowers who have never borrowed.
1383
1384 I<$result> is a ref to an array which all elements are a hasref.
1385
1386 =cut
1387
1388 sub GetBorrowersWhoHaveNeverBorrowed {
1389     my $filterbranch = shift ||
1390                         ((C4::Context->preference('IndependentBranches')
1391                              && C4::Context->userenv
1392                              && !C4::Context->IsSuperLibrarian()
1393                              && C4::Context->userenv->{branch})
1394                          ? C4::Context->userenv->{branch}
1395                          : "");
1396     my $dbh   = C4::Context->dbh;
1397     my $query = "
1398         SELECT borrowers.borrowernumber,max(timestamp) as latestissue
1399         FROM   borrowers
1400           LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
1401         WHERE issues.borrowernumber IS NULL
1402    ";
1403     my @query_params;
1404     if ($filterbranch && $filterbranch ne ""){
1405         $query.=" AND borrowers.branchcode= ?";
1406         push @query_params,$filterbranch;
1407     }
1408     warn $query if $debug;
1409
1410     my $sth = $dbh->prepare($query);
1411     if (scalar(@query_params)>0){
1412         $sth->execute(@query_params);
1413     }
1414     else {
1415         $sth->execute;
1416     }
1417
1418     my @results;
1419     while ( my $data = $sth->fetchrow_hashref ) {
1420         push @results, $data;
1421     }
1422     return \@results;
1423 }
1424
1425 =head2 GetBorrowersWithIssuesHistoryOlderThan
1426
1427   $results = &GetBorrowersWithIssuesHistoryOlderThan($date)
1428
1429 this function get all borrowers who has an issue history older than I<$date> given on input arg.
1430
1431 I<$result> is a ref to an array which all elements are a hashref.
1432 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
1433
1434 =cut
1435
1436 sub GetBorrowersWithIssuesHistoryOlderThan {
1437     my $dbh  = C4::Context->dbh;
1438     my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime());
1439     my $filterbranch = shift ||
1440                         ((C4::Context->preference('IndependentBranches')
1441                              && C4::Context->userenv
1442                              && !C4::Context->IsSuperLibrarian()
1443                              && C4::Context->userenv->{branch})
1444                          ? C4::Context->userenv->{branch}
1445                          : "");
1446     my $query = "
1447        SELECT count(borrowernumber) as n,borrowernumber
1448        FROM old_issues
1449        WHERE returndate < ?
1450          AND borrowernumber IS NOT NULL
1451     ";
1452     my @query_params;
1453     push @query_params, $date;
1454     if ($filterbranch){
1455         $query.="   AND branchcode = ?";
1456         push @query_params, $filterbranch;
1457     }
1458     $query.=" GROUP BY borrowernumber ";
1459     warn $query if $debug;
1460     my $sth = $dbh->prepare($query);
1461     $sth->execute(@query_params);
1462     my @results;
1463
1464     while ( my $data = $sth->fetchrow_hashref ) {
1465         push @results, $data;
1466     }
1467     return \@results;
1468 }
1469
1470 =head2 IssueSlip
1471
1472   IssueSlip($branchcode, $borrowernumber, $quickslip)
1473
1474   Returns letter hash ( see C4::Letters::GetPreparedLetter )
1475
1476   $quickslip is boolean, to indicate whether we want a quick slip
1477
1478   IssueSlip populates ISSUESLIP and ISSUEQSLIP, and will make the following expansions:
1479
1480   Both slips:
1481
1482       <<branches.*>>
1483       <<borrowers.*>>
1484
1485   ISSUESLIP:
1486
1487       <checkedout>
1488          <<biblio.*>>
1489          <<items.*>>
1490          <<biblioitems.*>>
1491          <<issues.*>>
1492       </checkedout>
1493
1494       <overdue>
1495          <<biblio.*>>
1496          <<items.*>>
1497          <<biblioitems.*>>
1498          <<issues.*>>
1499       </overdue>
1500
1501       <news>
1502          <<opac_news.*>>
1503       </news>
1504
1505   ISSUEQSLIP:
1506
1507       <checkedout>
1508          <<biblio.*>>
1509          <<items.*>>
1510          <<biblioitems.*>>
1511          <<issues.*>>
1512       </checkedout>
1513
1514   NOTE: Not all table fields are available, pleasee see GetPendingIssues for a list of available fields.
1515
1516 =cut
1517
1518 sub IssueSlip {
1519     my ($branch, $borrowernumber, $quickslip) = @_;
1520
1521     # FIXME Check callers before removing this statement
1522     #return unless $borrowernumber;
1523
1524     my @issues = @{ GetPendingIssues($borrowernumber) };
1525
1526     for my $issue (@issues) {
1527         $issue->{date_due} = $issue->{date_due_sql};
1528         if ($quickslip) {
1529             my $today = output_pref({ dt => dt_from_string, dateformat => 'iso', dateonly => 1 });
1530             if ( substr( $issue->{issuedate}, 0, 10 ) eq $today
1531                 or substr( $issue->{lastreneweddate}, 0, 10 ) eq $today ) {
1532                   $issue->{now} = 1;
1533             };
1534         }
1535     }
1536
1537     # Sort on timestamp then on issuedate (useful for tests and could be if modified in a batch
1538     @issues = sort {
1539         my $s = $b->{timestamp} <=> $a->{timestamp};
1540         $s == 0 ?
1541              $b->{issuedate} <=> $a->{issuedate} : $s;
1542     } @issues;
1543
1544     my ($letter_code, %repeat);
1545     if ( $quickslip ) {
1546         $letter_code = 'ISSUEQSLIP';
1547         %repeat =  (
1548             'checkedout' => [ map {
1549                 'biblio'       => $_,
1550                 'items'        => $_,
1551                 'biblioitems'  => $_,
1552                 'issues'       => $_,
1553             }, grep { $_->{'now'} } @issues ],
1554         );
1555     }
1556     else {
1557         $letter_code = 'ISSUESLIP';
1558         %repeat =  (
1559             'checkedout' => [ map {
1560                 'biblio'       => $_,
1561                 'items'        => $_,
1562                 'biblioitems'  => $_,
1563                 'issues'       => $_,
1564             }, grep { !$_->{'overdue'} } @issues ],
1565
1566             'overdue' => [ map {
1567                 'biblio'       => $_,
1568                 'items'        => $_,
1569                 'biblioitems'  => $_,
1570                 'issues'       => $_,
1571             }, grep { $_->{'overdue'} } @issues ],
1572
1573             'news' => [ map {
1574                 $_->{'timestamp'} = $_->{'newdate'};
1575                 { opac_news => $_ }
1576             } @{ GetNewsToDisplay("slip",$branch) } ],
1577         );
1578     }
1579
1580     return  C4::Letters::GetPreparedLetter (
1581         module => 'circulation',
1582         letter_code => $letter_code,
1583         branchcode => $branch,
1584         tables => {
1585             'branches'    => $branch,
1586             'borrowers'   => $borrowernumber,
1587         },
1588         repeat => \%repeat,
1589     );
1590 }
1591
1592 =head2 GetBorrowersWithEmail
1593
1594     ([$borrnum,$userid], ...) = GetBorrowersWithEmail('me@example.com');
1595
1596 This gets a list of users and their basic details from their email address.
1597 As it's possible for multiple user to have the same email address, it provides
1598 you with all of them. If there is no userid for the user, there will be an
1599 C<undef> there. An empty list will be returned if there are no matches.
1600
1601 =cut
1602
1603 sub GetBorrowersWithEmail {
1604     my $email = shift;
1605
1606     my $dbh = C4::Context->dbh;
1607
1608     my $query = "SELECT borrowernumber, userid FROM borrowers WHERE email=?";
1609     my $sth=$dbh->prepare($query);
1610     $sth->execute($email);
1611     my @result = ();
1612     while (my $ref = $sth->fetch) {
1613         push @result, $ref;
1614     }
1615     die "Failure searching for borrowers by email address: $sth->errstr" if $sth->err;
1616     return @result;
1617 }
1618
1619 =head2 AddMember_Opac
1620
1621 =cut
1622
1623 sub AddMember_Opac {
1624     my ( %borrower ) = @_;
1625
1626     $borrower{'categorycode'} //= C4::Context->preference('PatronSelfRegistrationDefaultCategory');
1627     if (not defined $borrower{'password'}){
1628         my $sr = new String::Random;
1629         $sr->{'A'} = [ 'A'..'Z', 'a'..'z' ];
1630         my $password = $sr->randpattern("AAAAAAAAAA");
1631         $borrower{'password'} = $password;
1632     }
1633
1634     $borrower{'cardnumber'} = fixup_cardnumber( $borrower{'cardnumber'} );
1635
1636     my $borrowernumber = AddMember(%borrower);
1637
1638     return ( $borrowernumber, $borrower{'password'} );
1639 }
1640
1641 =head2 DeleteExpiredOpacRegistrations
1642
1643     Delete accounts that haven't been upgraded from the 'temporary' category
1644     Returns the number of removed patrons
1645
1646 =cut
1647
1648 sub DeleteExpiredOpacRegistrations {
1649
1650     my $delay = C4::Context->preference('PatronSelfRegistrationExpireTemporaryAccountsDelay');
1651     my $category_code = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
1652
1653     return 0 if not $category_code or not defined $delay or $delay eq q||;
1654
1655     my $query = qq|
1656 SELECT borrowernumber
1657 FROM borrowers
1658 WHERE categorycode = ? AND DATEDIFF( NOW(), dateenrolled ) > ? |;
1659
1660     my $dbh = C4::Context->dbh;
1661     my $sth = $dbh->prepare($query);
1662     $sth->execute( $category_code, $delay );
1663     my $cnt=0;
1664     while ( my ($borrowernumber) = $sth->fetchrow_array() ) {
1665         Koha::Patrons->find($borrowernumber)->delete;
1666         $cnt++;
1667     }
1668     return $cnt;
1669 }
1670
1671 =head2 DeleteUnverifiedOpacRegistrations
1672
1673     Delete all unverified self registrations in borrower_modifications,
1674     older than the specified number of days.
1675
1676 =cut
1677
1678 sub DeleteUnverifiedOpacRegistrations {
1679     my ( $days ) = @_;
1680     my $dbh = C4::Context->dbh;
1681     my $sql=qq|
1682 DELETE FROM borrower_modifications
1683 WHERE borrowernumber = 0 AND DATEDIFF( NOW(), timestamp ) > ?|;
1684     my $cnt=$dbh->do($sql, undef, ($days) );
1685     return $cnt eq '0E0'? 0: $cnt;
1686 }
1687
1688 sub GetOverduesForPatron {
1689     my ( $borrowernumber ) = @_;
1690
1691     my $sql = "
1692         SELECT *
1693         FROM issues, items, biblio, biblioitems
1694         WHERE items.itemnumber=issues.itemnumber
1695           AND biblio.biblionumber   = items.biblionumber
1696           AND biblio.biblionumber   = biblioitems.biblionumber
1697           AND issues.borrowernumber = ?
1698           AND date_due < NOW()
1699     ";
1700
1701     my $sth = C4::Context->dbh->prepare( $sql );
1702     $sth->execute( $borrowernumber );
1703
1704     return $sth->fetchall_arrayref({});
1705 }
1706
1707 END { }    # module clean-up code here (global destructor)
1708
1709 1;
1710
1711 __END__
1712
1713 =head1 AUTHOR
1714
1715 Koha Team
1716
1717 =cut