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