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