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