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