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