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
  78         GetOverduesForPatron
  79     );
  80
  81     #Modify data
  82     push @EXPORT, qw(
  83         &ModMember
  84         &changepassword
  85     );
  86
  87     #Insert data
  88     push @EXPORT, qw(
  89         &AddMember
  90     &AddMember_Auto
  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
 270     my $patron = Koha::Patrons->find( $patroninformation->{borrowernumber} );
 271     my $waiting_holds = $patron->holds->search({ found => 'W' });
 272     my $nowaiting = $waiting_holds->count;
 273     if ( $nowaiting > 0 ) {
 274         my %flaginfo;
 275         $flaginfo{'message'}  = "Reserved items available";
 276         $flaginfo{'itemlist'} = $waiting_holds->unblessed;
 277         $flags{'WAITING'}     = \%flaginfo;
 278     }
 279     return ( \%flags );
 280 }
 281
 282
 283 =head2 GetMember
 284
 285   $borrower = &GetMember(%information);
 286
 287 Retrieve the first patron record meeting on criteria listed in the
 288 C<%information> hash, which should contain one or more
 289 pairs of borrowers column names and values, e.g.,
 290
 291    $borrower = GetMember(borrowernumber => id);
 292
 293 C<&GetBorrower> returns a reference-to-hash whose keys are the fields of
 294 the C<borrowers> table in the Koha database.
 295
 296 FIXME: GetMember() is used throughout the code as a lookup
 297 on a unique key such as the borrowernumber, but this meaning is not
 298 enforced in the routine itself.
 299
 300 =cut
 301
 302 #'
 303 sub GetMember {
 304     my ( %information ) = @_;
 305     if (exists $information{borrowernumber} && !defined $information{borrowernumber}) {
 306         #passing mysql's kohaadmin?? Makes no sense as a query
 307         return;
 308     }
 309     my $dbh = C4::Context->dbh;
 310     my $select =
 311     q{SELECT borrowers.*, categories.category_type, categories.description
 312     FROM borrowers
 313     LEFT JOIN categories on borrowers.categorycode=categories.categorycode WHERE };
 314     my $more_p = 0;
 315     my @values = ();
 316     for (keys %information ) {
 317         if ($more_p) {
 318             $select .= ' AND ';
 319         }
 320         else {
 321             $more_p++;
 322         }
 323
 324         if (defined $information{$_}) {
 325             $select .= "$_ = ?";
 326             push @values, $information{$_};
 327         }
 328         else {
 329             $select .= "$_ IS NULL";
 330         }
 331     }
 332     $debug && warn $select, " ",values %information;
 333     my $sth = $dbh->prepare("$select");
 334     $sth->execute(@values);
 335     my $data = $sth->fetchall_arrayref({});
 336     #FIXME interface to this routine now allows generation of a result set
 337     #so whole array should be returned but bowhere in the current code expects this
 338     if (@{$data} ) {
 339         return $data->[0];
 340     }
 341
 342     return;
 343 }
 344
 345 =head2 ModMember
 346
 347   my $success = ModMember(borrowernumber => $borrowernumber,
 348                                             [ field => value ]... );
 349
 350 Modify borrower's data.  All date fields should ALREADY be in ISO format.
 351
 352 return :
 353 true on success, or false on failure
 354
 355 =cut
 356
 357 sub ModMember {
 358     my (%data) = @_;
 359
 360     # trim whitespace from data which has some non-whitespace in it.
 361     foreach my $field_name (keys(%data)) {
 362         if ( defined $data{$field_name} && $data{$field_name} =~ /\S/ ) {
 363             $data{$field_name} =~ s/^\s*|\s*$//g;
 364         }
 365     }
 366
 367     # test to know if you must update or not the borrower password
 368     if (exists $data{password}) {
 369         if ($data{password} eq '****' or $data{password} eq '') {
 370             delete $data{password};
 371         } else {
 372             if ( C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
 373                 # Update the hashed PIN in borrower_sync.hashed_pin, before Koha hashes it
 374                 Koha::NorwegianPatronDB::NLUpdateHashedPIN( $data{'borrowernumber'}, $data{password} );
 375             }
 376             $data{password} = hash_password($data{password});
 377         }
 378     }
 379
 380     my $old_categorycode = Koha::Patrons->find( $data{borrowernumber} )->categorycode;
 381
 382     # get only the columns of a borrower
 383     my $schema = Koha::Database->new()->schema;
 384     my @columns = $schema->source('Borrower')->columns;
 385     my $new_borrower = { map { join(' ', @columns) =~ /$_/ ? ( $_ => $data{$_} ) : () } keys(%data) };
 386
 387     $new_borrower->{dateofbirth}     ||= undef if exists $new_borrower->{dateofbirth};
 388     $new_borrower->{dateenrolled}    ||= undef if exists $new_borrower->{dateenrolled};
 389     $new_borrower->{dateexpiry}      ||= undef if exists $new_borrower->{dateexpiry};
 390     $new_borrower->{debarred}        ||= undef if exists $new_borrower->{debarred};
 391     $new_borrower->{sms_provider_id} ||= undef if exists $new_borrower->{sms_provider_id};
 392     $new_borrower->{guarantorid}     ||= undef if exists $new_borrower->{guarantorid};
 393
 394     my $patron = Koha::Patrons->find( $new_borrower->{borrowernumber} );
 395
 396     delete $new_borrower->{userid} if exists $new_borrower->{userid} and not $new_borrower->{userid};
 397
 398     my $execute_success = $patron->store if $patron->set($new_borrower);
 399
 400     if ($execute_success) { # only proceed if the update was a success
 401         # If the patron changes to a category with enrollment fee, we add a fee
 402         if ( $data{categorycode} and $data{categorycode} ne $old_categorycode ) {
 403             if ( C4::Context->preference('FeeOnChangePatronCategory') ) {
 404                 $patron->add_enrolment_fee_if_needed;
 405             }
 406         }
 407
 408         # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
 409         # cronjob will use for syncing with NL
 410         if ( C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
 411             my $borrowersync = Koha::Database->new->schema->resultset('BorrowerSync')->find({
 412                 'synctype'       => 'norwegianpatrondb',
 413                 'borrowernumber' => $data{'borrowernumber'}
 414             });
 415             # Do not set to "edited" if syncstatus is "new". We need to sync as new before
 416             # we can sync as changed. And the "new sync" will pick up all changes since
 417             # the patron was created anyway.
 418             if ( $borrowersync->syncstatus ne 'new' && $borrowersync->syncstatus ne 'delete' ) {
 419                 $borrowersync->update( { 'syncstatus' => 'edited' } );
 420             }
 421             # Set the value of 'sync'
 422             $borrowersync->update( { 'sync' => $data{'sync'} } );
 423             # Try to do the live sync
 424             Koha::NorwegianPatronDB::NLSync({ 'borrowernumber' => $data{'borrowernumber'} });
 425         }
 426
 427         logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "UPDATE (executed w/ arg: $data{'borrowernumber'})") if C4::Context->preference("BorrowersLog");
 428     }
 429     return $execute_success;
 430 }
 431
 432 =head2 AddMember
 433
 434   $borrowernumber = &AddMember(%borrower);
 435
 436 insert new borrower into table
 437
 438 (%borrower keys are database columns. Database columns could be
 439 different in different versions. Please look into database for correct
 440 column names.)
 441
 442 Returns the borrowernumber upon success
 443
 444 Returns as undef upon any db error without further processing
 445
 446 =cut
 447
 448 #'
 449 sub AddMember {
 450     my (%data) = @_;
 451     my $dbh = C4::Context->dbh;
 452     my $schema = Koha::Database->new()->schema;
 453
 454     # trim whitespace from data which has some non-whitespace in it.
 455     foreach my $field_name (keys(%data)) {
 456         if ( defined $data{$field_name} && $data{$field_name} =~ /\S/ ) {
 457             $data{$field_name} =~ s/^\s*|\s*$//g;
 458         }
 459     }
 460
 461     # generate a proper login if none provided
 462     $data{'userid'} = Generate_Userid( $data{'borrowernumber'}, $data{'firstname'}, $data{'surname'} )
 463       if ( $data{'userid'} eq '' || !Check_Userid( $data{'userid'} ) );
 464
 465     # add expiration date if it isn't already there
 466     $data{dateexpiry} ||= Koha::Patron::Categories->find( $data{categorycode} )->get_expiry_date;
 467
 468     # add enrollment date if it isn't already there
 469     unless ( $data{'dateenrolled'} ) {
 470         $data{'dateenrolled'} = output_pref( { dt => dt_from_string, dateonly => 1, dateformat => 'iso' } );
 471     }
 472
 473     if ( C4::Context->preference("autoMemberNum") ) {
 474         if ( not exists $data{cardnumber} or not defined $data{cardnumber} or $data{cardnumber} eq '' ) {
 475             $data{cardnumber} = fixup_cardnumber( $data{cardnumber} );
 476         }
 477     }
 478
 479     my $patron_category = $schema->resultset('Category')->find( $data{'categorycode'} );
 480     $data{'privacy'} =
 481         $patron_category->default_privacy() eq 'default' ? 1
 482       : $patron_category->default_privacy() eq 'never'   ? 2
 483       : $patron_category->default_privacy() eq 'forever' ? 0
 484       :                                                    undef;
 485
 486     $data{'privacy_guarantor_checkouts'} = 0 unless defined( $data{'privacy_guarantor_checkouts'} );
 487
 488     # Make a copy of the plain text password for later use
 489     my $plain_text_password = $data{'password'};
 490
 491     # create a disabled account if no password provided
 492     $data{'password'} = ($data{'password'})? hash_password($data{'password'}) : '!';
 493
 494     # we don't want invalid dates in the db (mysql has a bad habit of inserting 0000-00-00
 495     $data{'dateofbirth'}     = undef if ( not $data{'dateofbirth'} );
 496     $data{'debarred'}        = undef if ( not $data{'debarred'} );
 497     $data{'sms_provider_id'} = undef if ( not $data{'sms_provider_id'} );
 498     $data{'guarantorid'}     = undef if ( not $data{'guarantorid'} );
 499
 500     # get only the columns of Borrower
 501     # FIXME Do we really need this check?
 502     my @columns = $schema->source('Borrower')->columns;
 503     my $new_member = { map { join(' ',@columns) =~ /$_/ ? ( $_ => $data{$_} )  : () } keys(%data) } ;
 504
 505     delete $new_member->{borrowernumber};
 506
 507     my $patron = Koha::Patron->new( $new_member )->store;
 508     $data{borrowernumber} = $patron->borrowernumber;
 509
 510     # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
 511     # cronjob will use for syncing with NL
 512     if ( exists $data{'borrowernumber'} && C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
 513         Koha::Database->new->schema->resultset('BorrowerSync')->create({
 514             'borrowernumber' => $data{'borrowernumber'},
 515             'synctype'       => 'norwegianpatrondb',
 516             'sync'           => 1,
 517             'syncstatus'     => 'new',
 518             'hashed_pin'     => Koha::NorwegianPatronDB::NLEncryptPIN( $plain_text_password ),
 519         });
 520     }
 521
 522     logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");
 523
 524     $patron->add_enrolment_fee_if_needed;
 525
 526     return $data{borrowernumber};
 527 }
 528
 529 =head2 Check_Userid
 530
 531     my $uniqueness = Check_Userid($userid,$borrowernumber);
 532
 533     $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 != '').
 534
 535     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.
 536
 537     return :
 538         0 for not unique (i.e. this $userid already exists)
 539         1 for unique (i.e. this $userid does not exist, or this $userid/$borrowernumber combination already exists)
 540
 541 =cut
 542
 543 sub Check_Userid {
 544     my ( $uid, $borrowernumber ) = @_;
 545
 546     return 0 unless ($uid); # userid is a unique column, we should assume NULL is not unique
 547
 548     return 0 if ( $uid eq C4::Context->config('user') );
 549
 550     my $rs = Koha::Database->new()->schema()->resultset('Borrower');
 551
 552     my $params;
 553     $params->{userid} = $uid;
 554     $params->{borrowernumber} = { '!=' => $borrowernumber } if ($borrowernumber);
 555
 556     my $count = $rs->count( $params );
 557
 558     return $count ? 0 : 1;
 559 }
 560
 561 =head2 Generate_Userid
 562
 563     my $newuid = Generate_Userid($borrowernumber, $firstname, $surname);
 564
 565     Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
 566
 567     $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.
 568
 569     return :
 570         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).
 571
 572 =cut
 573
 574 sub Generate_Userid {
 575   my ($borrowernumber, $firstname, $surname) = @_;
 576   my $newuid;
 577   my $offset = 0;
 578   #The script will "do" the following code and increment the $offset until Check_Userid = 1 (i.e. until $newuid comes back as unique)
 579   do {
 580     $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
 581     $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
 582     $newuid = lc(($firstname)? "$firstname.$surname" : $surname);
 583     $newuid = unac_string('utf-8',$newuid);
 584     $newuid .= $offset unless $offset == 0;
 585     $offset++;
 586
 587    } while (!Check_Userid($newuid,$borrowernumber));
 588
 589    return $newuid;
 590 }
 591
 592 =head2 fixup_cardnumber
 593
 594 Warning: The caller is responsible for locking the members table in write
 595 mode, to avoid database corruption.
 596
 597 =cut
 598
 599 use vars qw( @weightings );
 600 my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
 601
 602 sub fixup_cardnumber {
 603     my ($cardnumber) = @_;
 604     my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0;
 605
 606     # Find out whether member numbers should be generated
 607     # automatically. Should be either "1" or something else.
 608     # Defaults to "0", which is interpreted as "no".
 609
 610     #     if ($cardnumber !~ /\S/ && $autonumber_members) {
 611     ($autonumber_members) or return $cardnumber;
 612     my $checkdigit = C4::Context->preference('checkdigit');
 613     my $dbh = C4::Context->dbh;
 614     if ( $checkdigit and $checkdigit eq 'katipo' ) {
 615
 616         # if checkdigit is selected, calculate katipo-style cardnumber.
 617         # otherwise, just use the max()
 618         # purpose: generate checksum'd member numbers.
 619         # We'll assume we just got the max value of digits 2-8 of member #'s
 620         # from the database and our job is to increment that by one,
 621         # determine the 1st and 9th digits and return the full string.
 622         my $sth = $dbh->prepare(
 623             "select max(substring(borrowers.cardnumber,2,7)) as new_num from borrowers"
 624         );
 625         $sth->execute;
 626         my $data = $sth->fetchrow_hashref;
 627         $cardnumber = $data->{new_num};
 628         if ( !$cardnumber ) {    # If DB has no values,
 629             $cardnumber = 1000000;    # start at 1000000
 630         } else {
 631             $cardnumber += 1;
 632         }
 633
 634         my $sum = 0;
 635         for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
 636             # read weightings, left to right, 1 char at a time
 637             my $temp1 = $weightings[$i];
 638
 639             # sequence left to right, 1 char at a time
 640             my $temp2 = substr( $cardnumber, $i, 1 );
 641
 642             # mult each char 1-7 by its corresponding weighting
 643             $sum += $temp1 * $temp2;
 644         }
 645
 646         my $rem = ( $sum % 11 );
 647         $rem = 'X' if $rem == 10;
 648
 649         return "V$cardnumber$rem";
 650      } else {
 651
 652         my $sth = $dbh->prepare(
 653             'SELECT MAX( CAST( cardnumber AS SIGNED ) ) FROM borrowers WHERE cardnumber REGEXP "^-?[0-9]+$"'
 654         );
 655         $sth->execute;
 656         my ($result) = $sth->fetchrow;
 657         return $result + 1;
 658     }
 659     return $cardnumber;     # just here as a fallback/reminder
 660 }
 661
 662 =head2 GetPendingIssues
 663
 664   my $issues = &GetPendingIssues(@borrowernumber);
 665
 666 Looks up what the patron with the given borrowernumber has borrowed.
 667
 668 C<&GetPendingIssues> returns a
 669 reference-to-array where each element is a reference-to-hash; the
 670 keys are the fields from the C<issues>, C<biblio>, and C<items> tables.
 671 The keys include C<biblioitems> fields.
 672
 673 =cut
 674
 675 sub GetPendingIssues {
 676     my @borrowernumbers = @_;
 677
 678     unless (@borrowernumbers ) { # return a ref_to_array
 679         return \@borrowernumbers; # to not cause surprise to caller
 680     }
 681
 682     # Borrowers part of the query
 683     my $bquery = '';
 684     for (my $i = 0; $i < @borrowernumbers; $i++) {
 685         $bquery .= ' issues.borrowernumber = ?';
 686         if ($i < $#borrowernumbers ) {
 687             $bquery .= ' OR';
 688         }
 689     }
 690
 691     # FIXME: namespace collision: each table has "timestamp" fields.  Which one is "timestamp" ?
 692     # FIXME: circ/ciculation.pl tries to sort by timestamp!
 693     # FIXME: namespace collision: other collisions possible.
 694     # FIXME: most of this data isn't really being used by callers.
 695     my $query =
 696    "SELECT issues.*,
 697             items.*,
 698            biblio.*,
 699            biblioitems.volume,
 700            biblioitems.number,
 701            biblioitems.itemtype,
 702            biblioitems.isbn,
 703            biblioitems.issn,
 704            biblioitems.publicationyear,
 705            biblioitems.publishercode,
 706            biblioitems.volumedate,
 707            biblioitems.volumedesc,
 708            biblioitems.lccn,
 709            biblioitems.url,
 710            borrowers.firstname,
 711            borrowers.surname,
 712            borrowers.cardnumber,
 713            issues.timestamp AS timestamp,
 714            issues.renewals  AS renewals,
 715            issues.borrowernumber AS borrowernumber,
 716             items.renewals  AS totalrenewals
 717     FROM   issues
 718     LEFT JOIN items       ON items.itemnumber       =      issues.itemnumber
 719     LEFT JOIN biblio      ON items.biblionumber     =      biblio.biblionumber
 720     LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
 721     LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
 722     WHERE
 723       $bquery
 724     ORDER BY issues.issuedate"
 725     ;
 726
 727     my $sth = C4::Context->dbh->prepare($query);
 728     $sth->execute(@borrowernumbers);
 729     my $data = $sth->fetchall_arrayref({});
 730     my $today = dt_from_string;
 731     foreach (@{$data}) {
 732         if ($_->{issuedate}) {
 733             $_->{issuedate} = dt_from_string($_->{issuedate}, 'sql');
 734         }
 735         $_->{date_due_sql} = $_->{date_due};
 736         # FIXME no need to have this value
 737         $_->{date_due} or next;
 738         $_->{date_due_sql} = $_->{date_due};
 739         # FIXME no need to have this value
 740         $_->{date_due} = dt_from_string($_->{date_due}, 'sql');
 741         if ( DateTime->compare($_->{date_due}, $today) == -1 ) {
 742             $_->{overdue} = 1;
 743         }
 744     }
 745     return $data;
 746 }
 747
 748 =head2 GetAllIssues
 749
 750   $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
 751
 752 Looks up what the patron with the given borrowernumber has borrowed,
 753 and sorts the results.
 754
 755 C<$sortkey> is the name of a field on which to sort the results. This
 756 should be the name of a field in the C<issues>, C<biblio>,
 757 C<biblioitems>, or C<items> table in the Koha database.
 758
 759 C<$limit> is the maximum number of results to return.
 760
 761 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
 762 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
 763 C<items> tables of the Koha database.
 764
 765 =cut
 766
 767 #'
 768 sub GetAllIssues {
 769     my ( $borrowernumber, $order, $limit ) = @_;
 770
 771     return unless $borrowernumber;
 772     $order = 'date_due desc' unless $order;
 773
 774     my $dbh = C4::Context->dbh;
 775     my $query =
 776 'SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
 777   FROM issues
 778   LEFT JOIN items on items.itemnumber=issues.itemnumber
 779   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
 780   LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
 781   WHERE borrowernumber=?
 782   UNION ALL
 783   SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
 784   FROM old_issues
 785   LEFT JOIN items on items.itemnumber=old_issues.itemnumber
 786   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
 787   LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
 788   WHERE borrowernumber=? AND old_issues.itemnumber IS NOT NULL
 789   order by ' . $order;
 790     if ($limit) {
 791         $query .= " limit $limit";
 792     }
 793
 794     my $sth = $dbh->prepare($query);
 795     $sth->execute( $borrowernumber, $borrowernumber );
 796     return $sth->fetchall_arrayref( {} );
 797 }
 798
 799
 800 =head2 GetMemberAccountRecords
 801
 802   ($total, $acctlines, $count) = &GetMemberAccountRecords($borrowernumber);
 803
 804 Looks up accounting data for the patron with the given borrowernumber.
 805
 806 C<&GetMemberAccountRecords> returns a three-element array. C<$acctlines> is a
 807 reference-to-array, where each element is a reference-to-hash; the
 808 keys are the fields of the C<accountlines> table in the Koha database.
 809 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
 810 total amount outstanding for all of the account lines.
 811
 812 =cut
 813
 814 sub GetMemberAccountRecords {
 815     my ($borrowernumber) = @_;
 816     my $dbh = C4::Context->dbh;
 817     my @acctlines;
 818     my $numlines = 0;
 819     my $strsth      = qq(
 820                         SELECT *
 821                         FROM accountlines
 822                         WHERE borrowernumber=?);
 823     $strsth.=" ORDER BY accountlines_id desc";
 824     my $sth= $dbh->prepare( $strsth );
 825     $sth->execute( $borrowernumber );
 826
 827     my $total = 0;
 828     while ( my $data = $sth->fetchrow_hashref ) {
 829         if ( $data->{itemnumber} ) {
 830             my $item = Koha::Items->find( $data->{itemnumber} );
 831             my $biblio = $item->biblio;
 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 $item = Koha::Items->find( $data->{itemnumber} );
 913             my $biblio = $item->biblio;
 914             $data->{biblionumber} = $biblio->biblionumber;
 915             $data->{title}        = $biblio->title;
 916         }
 917         $acctlines[$numlines] = $data;
 918         $numlines++;
 919         $total += int(100 * $data->{'amountoutstanding'});
 920     }
 921     $total /= 100;
 922     return ( $total, \@acctlines, $numlines );
 923 }
 924
 925 sub checkcardnumber {
 926     my ( $cardnumber, $borrowernumber ) = @_;
 927
 928     # If cardnumber is null, we assume they're allowed.
 929     return 0 unless defined $cardnumber;
 930
 931     my $dbh = C4::Context->dbh;
 932     my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
 933     $query .= " AND borrowernumber <> ?" if ($borrowernumber);
 934     my $sth = $dbh->prepare($query);
 935     $sth->execute(
 936         $cardnumber,
 937         ( $borrowernumber ? $borrowernumber : () )
 938     );
 939
 940     return 1 if $sth->fetchrow_hashref;
 941
 942     my ( $min_length, $max_length ) = get_cardnumber_length();
 943     return 2
 944         if length $cardnumber > $max_length
 945         or length $cardnumber < $min_length;
 946
 947     return 0;
 948 }
 949
 950 =head2 get_cardnumber_length
 951
 952     my ($min, $max) = C4::Members::get_cardnumber_length()
 953
 954 Returns the minimum and maximum length for patron cardnumbers as
 955 determined by the CardnumberLength system preference, the
 956 BorrowerMandatoryField system preference, and the width of the
 957 database column.
 958
 959 =cut
 960
 961 sub get_cardnumber_length {
 962     my ( $min, $max ) = ( 0, 16 ); # borrowers.cardnumber is a nullable varchar(16)
 963     $min = 1 if C4::Context->preference('BorrowerMandatoryField') =~ /cardnumber/;
 964     if ( my $cardnumber_length = C4::Context->preference('CardnumberLength') ) {
 965         # Is integer and length match
 966         if ( $cardnumber_length =~ m|^\d+$| ) {
 967             $min = $max = $cardnumber_length
 968                 if $cardnumber_length >= $min
 969                     and $cardnumber_length <= $max;
 970         }
 971         # Else assuming it is a range
 972         elsif ( $cardnumber_length =~ m|(\d*),(\d*)| ) {
 973             $min = $1 if $1 and $min < $1;
 974             $max = $2 if $2 and $max > $2;
 975         }
 976
 977     }
 978     my $borrower = Koha::Schema->resultset('Borrower');
 979     my $field_size = $borrower->result_source->column_info('cardnumber')->{size};
 980     $min = $field_size if $min > $field_size;
 981     return ( $min, $max );
 982 }
 983
 984 =head2 GetFirstValidEmailAddress
 985
 986   $email = GetFirstValidEmailAddress($borrowernumber);
 987
 988 Return the first valid email address for a borrower, given the borrowernumber.  For now, the order
 989 is defined as email, emailpro, B_email.  Returns the empty string if the borrower has no email
 990 addresses.
 991
 992 =cut
 993
 994 sub GetFirstValidEmailAddress {
 995     my $borrowernumber = shift;
 996
 997     my $borrower = Koha::Patrons->find( $borrowernumber );
 998
 999     return $borrower->first_valid_email_address();
1000 }
1001
1002 =head2 GetNoticeEmailAddress
1003
1004   $email = GetNoticeEmailAddress($borrowernumber);
1005
1006 Return the email address of borrower used for notices, given the borrowernumber.
1007 Returns the empty string if no email address.
1008
1009 =cut
1010
1011 sub GetNoticeEmailAddress {
1012     my $borrowernumber = shift;
1013
1014     my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
1015     # if syspref is set to 'first valid' (value == OFF), look up email address
1016     if ( $which_address eq 'OFF' ) {
1017         return GetFirstValidEmailAddress($borrowernumber);
1018     }
1019     # specified email address field
1020     my $dbh = C4::Context->dbh;
1021     my $sth = $dbh->prepare( qq{
1022         SELECT $which_address AS primaryemail
1023         FROM borrowers
1024         WHERE borrowernumber=?
1025     } );
1026     $sth->execute($borrowernumber);
1027     my $data = $sth->fetchrow_hashref;
1028     return $data->{'primaryemail'} || '';
1029 }
1030
1031 =head2 GetBorrowersToExpunge
1032
1033   $borrowers = &GetBorrowersToExpunge(
1034       not_borrowed_since => $not_borrowed_since,
1035       expired_before       => $expired_before,
1036       category_code        => $category_code,
1037       patron_list_id       => $patron_list_id,
1038       branchcode           => $branchcode
1039   );
1040
1041   This function get all borrowers based on the given criteria.
1042
1043 =cut
1044
1045 sub GetBorrowersToExpunge {
1046
1047     my $params = shift;
1048     my $filterdate       = $params->{'not_borrowed_since'};
1049     my $filterexpiry     = $params->{'expired_before'};
1050     my $filterlastseen   = $params->{'last_seen'};
1051     my $filtercategory   = $params->{'category_code'};
1052     my $filterbranch     = $params->{'branchcode'} ||
1053                         ((C4::Context->preference('IndependentBranches')
1054                              && C4::Context->userenv
1055                              && !C4::Context->IsSuperLibrarian()
1056                              && C4::Context->userenv->{branch})
1057                          ? C4::Context->userenv->{branch}
1058                          : "");
1059     my $filterpatronlist = $params->{'patron_list_id'};
1060
1061     my $dbh   = C4::Context->dbh;
1062     my $query = q|
1063         SELECT borrowers.borrowernumber,
1064                MAX(old_issues.timestamp) AS latestissue,
1065                MAX(issues.timestamp) AS currentissue
1066         FROM   borrowers
1067         JOIN   categories USING (categorycode)
1068         LEFT JOIN (
1069             SELECT guarantorid
1070             FROM borrowers
1071             WHERE guarantorid IS NOT NULL
1072                 AND guarantorid <> 0
1073         ) as tmp ON borrowers.borrowernumber=tmp.guarantorid
1074         LEFT JOIN old_issues USING (borrowernumber)
1075         LEFT JOIN issues USING (borrowernumber)|;
1076     if ( $filterpatronlist  ){
1077         $query .= q| LEFT JOIN patron_list_patrons USING (borrowernumber)|;
1078     }
1079     $query .= q| WHERE  category_type <> 'S'
1080         AND tmp.guarantorid IS NULL
1081    |;
1082     my @query_params;
1083     if ( $filterbranch && $filterbranch ne "" ) {
1084         $query.= " AND borrowers.branchcode = ? ";
1085         push( @query_params, $filterbranch );
1086     }
1087     if ( $filterexpiry ) {
1088         $query .= " AND dateexpiry < ? ";
1089         push( @query_params, $filterexpiry );
1090     }
1091     if ( $filterlastseen ) {
1092         $query .= ' AND lastseen < ? ';
1093         push @query_params, $filterlastseen;
1094     }
1095     if ( $filtercategory ) {
1096         $query .= " AND categorycode = ? ";
1097         push( @query_params, $filtercategory );
1098     }
1099     if ( $filterpatronlist ){
1100         $query.=" AND patron_list_id = ? ";
1101         push( @query_params, $filterpatronlist );
1102     }
1103     $query.=" GROUP BY borrowers.borrowernumber HAVING currentissue IS NULL ";
1104     if ( $filterdate ) {
1105         $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
1106         push @query_params,$filterdate;
1107     }
1108     warn $query if $debug;
1109
1110     my $sth = $dbh->prepare($query);
1111     if (scalar(@query_params)>0){
1112         $sth->execute(@query_params);
1113     }
1114     else {
1115         $sth->execute;
1116     }
1117
1118     my @results;
1119     while ( my $data = $sth->fetchrow_hashref ) {
1120         push @results, $data;
1121     }
1122     return \@results;
1123 }
1124
1125 =head2 IssueSlip
1126
1127   IssueSlip($branchcode, $borrowernumber, $quickslip)
1128
1129   Returns letter hash ( see C4::Letters::GetPreparedLetter )
1130
1131   $quickslip is boolean, to indicate whether we want a quick slip
1132
1133   IssueSlip populates ISSUESLIP and ISSUEQSLIP, and will make the following expansions:
1134
1135   Both slips:
1136
1137       <<branches.*>>
1138       <<borrowers.*>>
1139
1140   ISSUESLIP:
1141
1142       <checkedout>
1143          <<biblio.*>>
1144          <<items.*>>
1145          <<biblioitems.*>>
1146          <<issues.*>>
1147       </checkedout>
1148
1149       <overdue>
1150          <<biblio.*>>
1151          <<items.*>>
1152          <<biblioitems.*>>
1153          <<issues.*>>
1154       </overdue>
1155
1156       <news>
1157          <<opac_news.*>>
1158       </news>
1159
1160   ISSUEQSLIP:
1161
1162       <checkedout>
1163          <<biblio.*>>
1164          <<items.*>>
1165          <<biblioitems.*>>
1166          <<issues.*>>
1167       </checkedout>
1168
1169   NOTE: Not all table fields are available, pleasee see GetPendingIssues for a list of available fields.
1170
1171 =cut
1172
1173 sub IssueSlip {
1174     my ($branch, $borrowernumber, $quickslip) = @_;
1175
1176     # FIXME Check callers before removing this statement
1177     #return unless $borrowernumber;
1178
1179     my $patron = Koha::Patrons->find( $borrowernumber );
1180     return unless $patron;
1181
1182     my @issues = @{ GetPendingIssues($borrowernumber) };
1183
1184     for my $issue (@issues) {
1185         $issue->{date_due} = $issue->{date_due_sql};
1186         if ($quickslip) {
1187             my $today = output_pref({ dt => dt_from_string, dateformat => 'iso', dateonly => 1 });
1188             if ( substr( $issue->{issuedate}, 0, 10 ) eq $today
1189                 or substr( $issue->{lastreneweddate}, 0, 10 ) eq $today ) {
1190                   $issue->{now} = 1;
1191             };
1192         }
1193     }
1194
1195     # Sort on timestamp then on issuedate (useful for tests and could be if modified in a batch
1196     @issues = sort {
1197         my $s = $b->{timestamp} <=> $a->{timestamp};
1198         $s == 0 ?
1199              $b->{issuedate} <=> $a->{issuedate} : $s;
1200     } @issues;
1201
1202     my ($letter_code, %repeat);
1203     if ( $quickslip ) {
1204         $letter_code = 'ISSUEQSLIP';
1205         %repeat =  (
1206             'checkedout' => [ map {
1207                 'biblio'       => $_,
1208                 'items'        => $_,
1209                 'biblioitems'  => $_,
1210                 'issues'       => $_,
1211             }, grep { $_->{'now'} } @issues ],
1212         );
1213     }
1214     else {
1215         $letter_code = 'ISSUESLIP';
1216         %repeat =  (
1217             'checkedout' => [ map {
1218                 'biblio'       => $_,
1219                 'items'        => $_,
1220                 'biblioitems'  => $_,
1221                 'issues'       => $_,
1222             }, grep { !$_->{'overdue'} } @issues ],
1223
1224             'overdue' => [ map {
1225                 'biblio'       => $_,
1226                 'items'        => $_,
1227                 'biblioitems'  => $_,
1228                 'issues'       => $_,
1229             }, grep { $_->{'overdue'} } @issues ],
1230
1231             'news' => [ map {
1232                 $_->{'timestamp'} = $_->{'newdate'};
1233                 { opac_news => $_ }
1234             } @{ GetNewsToDisplay("slip",$branch) } ],
1235         );
1236     }
1237
1238     return  C4::Letters::GetPreparedLetter (
1239         module => 'circulation',
1240         letter_code => $letter_code,
1241         branchcode => $branch,
1242         lang => $patron->lang,
1243         tables => {
1244             'branches'    => $branch,
1245             'borrowers'   => $borrowernumber,
1246         },
1247         repeat => \%repeat,
1248     );
1249 }
1250
1251 =head2 AddMember_Auto
1252
1253 =cut
1254
1255 sub AddMember_Auto {
1256     my ( %borrower ) = @_;
1257
1258     $borrower{'cardnumber'} ||= fixup_cardnumber();
1259
1260     $borrower{'borrowernumber'} = AddMember(%borrower);
1261
1262     return ( %borrower );
1263 }
1264
1265 =head2 AddMember_Opac
1266
1267 =cut
1268
1269 sub AddMember_Opac {
1270     my ( %borrower ) = @_;
1271
1272     $borrower{'categorycode'} //= C4::Context->preference('PatronSelfRegistrationDefaultCategory');
1273     if (not defined $borrower{'password'}){
1274         my $sr = new String::Random;
1275         $sr->{'A'} = [ 'A'..'Z', 'a'..'z' ];
1276         my $password = $sr->randpattern("AAAAAAAAAA");
1277         $borrower{'password'} = $password;
1278     }
1279
1280     %borrower = AddMember_Auto(%borrower);
1281
1282     return ( $borrower{'borrowernumber'}, $borrower{'password'} );
1283 }
1284
1285 =head2 DeleteExpiredOpacRegistrations
1286
1287     Delete accounts that haven't been upgraded from the 'temporary' category
1288     Returns the number of removed patrons
1289
1290 =cut
1291
1292 sub DeleteExpiredOpacRegistrations {
1293
1294     my $delay = C4::Context->preference('PatronSelfRegistrationExpireTemporaryAccountsDelay');
1295     my $category_code = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
1296
1297     return 0 if not $category_code or not defined $delay or $delay eq q||;
1298
1299     my $query = qq|
1300 SELECT borrowernumber
1301 FROM borrowers
1302 WHERE categorycode = ? AND DATEDIFF( NOW(), dateenrolled ) > ? |;
1303
1304     my $dbh = C4::Context->dbh;
1305     my $sth = $dbh->prepare($query);
1306     $sth->execute( $category_code, $delay );
1307     my $cnt=0;
1308     while ( my ($borrowernumber) = $sth->fetchrow_array() ) {
1309         Koha::Patrons->find($borrowernumber)->delete;
1310         $cnt++;
1311     }
1312     return $cnt;
1313 }
1314
1315 =head2 DeleteUnverifiedOpacRegistrations
1316
1317     Delete all unverified self registrations in borrower_modifications,
1318     older than the specified number of days.
1319
1320 =cut
1321
1322 sub DeleteUnverifiedOpacRegistrations {
1323     my ( $days ) = @_;
1324     my $dbh = C4::Context->dbh;
1325     my $sql=qq|
1326 DELETE FROM borrower_modifications
1327 WHERE borrowernumber = 0 AND DATEDIFF( NOW(), timestamp ) > ?|;
1328     my $cnt=$dbh->do($sql, undef, ($days) );
1329     return $cnt eq '0E0'? 0: $cnt;
1330 }
1331
1332 sub GetOverduesForPatron {
1333     my ( $borrowernumber ) = @_;
1334
1335     my $sql = "
1336         SELECT *
1337         FROM issues, items, biblio, biblioitems
1338         WHERE items.itemnumber=issues.itemnumber
1339           AND biblio.biblionumber   = items.biblionumber
1340           AND biblio.biblionumber   = biblioitems.biblionumber
1341           AND issues.borrowernumber = ?
1342           AND date_due < NOW()
1343     ";
1344
1345     my $sth = C4::Context->dbh->prepare( $sql );
1346     $sth->execute( $borrowernumber );
1347
1348     return $sth->fetchall_arrayref({});
1349 }
1350
1351 END { }    # module clean-up code here (global destructor)
1352
1353 1;
1354
1355 __END__
1356
1357 =head1 AUTHOR
1358
1359 Koha Team
1360
1361 =cut