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