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