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