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