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