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
 498     # get only the columns of Borrower
 499     # FIXME Do we really need this check?
 500     my @columns = $schema->source('Borrower')->columns;
 501     my $new_member = { map { join(' ',@columns) =~ /$_/ ? ( $_ => $data{$_} )  : () } keys(%data) } ;
 502
 503     delete $new_member->{borrowernumber};
 504
 505     my $patron = Koha::Patron->new( $new_member )->store;
 506     $data{borrowernumber} = $patron->borrowernumber;
 507
 508     # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
 509     # cronjob will use for syncing with NL
 510     if ( exists $data{'borrowernumber'} && C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
 511         Koha::Database->new->schema->resultset('BorrowerSync')->create({
 512             'borrowernumber' => $data{'borrowernumber'},
 513             'synctype'       => 'norwegianpatrondb',
 514             'sync'           => 1,
 515             'syncstatus'     => 'new',
 516             'hashed_pin'     => Koha::NorwegianPatronDB::NLEncryptPIN( $plain_text_password ),
 517         });
 518     }
 519
 520     logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");
 521
 522     $patron->add_enrolment_fee_if_needed;
 523
 524     return $data{borrowernumber};
 525 }
 526
 527 =head2 Check_Userid
 528
 529     my $uniqueness = Check_Userid($userid,$borrowernumber);
 530
 531     $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 != '').
 532
 533     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.
 534
 535     return :
 536         0 for not unique (i.e. this $userid already exists)
 537         1 for unique (i.e. this $userid does not exist, or this $userid/$borrowernumber combination already exists)
 538
 539 =cut
 540
 541 sub Check_Userid {
 542     my ( $uid, $borrowernumber ) = @_;
 543
 544     return 0 unless ($uid); # userid is a unique column, we should assume NULL is not unique
 545
 546     return 0 if ( $uid eq C4::Context->config('user') );
 547
 548     my $rs = Koha::Database->new()->schema()->resultset('Borrower');
 549
 550     my $params;
 551     $params->{userid} = $uid;
 552     $params->{borrowernumber} = { '!=' => $borrowernumber } if ($borrowernumber);
 553
 554     my $count = $rs->count( $params );
 555
 556     return $count ? 0 : 1;
 557 }
 558
 559 =head2 Generate_Userid
 560
 561     my $newuid = Generate_Userid($borrowernumber, $firstname, $surname);
 562
 563     Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
 564
 565     $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.
 566
 567     return :
 568         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).
 569
 570 =cut
 571
 572 sub Generate_Userid {
 573   my ($borrowernumber, $firstname, $surname) = @_;
 574   my $newuid;
 575   my $offset = 0;
 576   #The script will "do" the following code and increment the $offset until Check_Userid = 1 (i.e. until $newuid comes back as unique)
 577   do {
 578     $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
 579     $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
 580     $newuid = lc(($firstname)? "$firstname.$surname" : $surname);
 581     $newuid = unac_string('utf-8',$newuid);
 582     $newuid .= $offset unless $offset == 0;
 583     $offset++;
 584
 585    } while (!Check_Userid($newuid,$borrowernumber));
 586
 587    return $newuid;
 588 }
 589
 590 =head2 fixup_cardnumber
 591
 592 Warning: The caller is responsible for locking the members table in write
 593 mode, to avoid database corruption.
 594
 595 =cut
 596
 597 use vars qw( @weightings );
 598 my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
 599
 600 sub fixup_cardnumber {
 601     my ($cardnumber) = @_;
 602     my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0;
 603
 604     # Find out whether member numbers should be generated
 605     # automatically. Should be either "1" or something else.
 606     # Defaults to "0", which is interpreted as "no".
 607
 608     #     if ($cardnumber !~ /\S/ && $autonumber_members) {
 609     ($autonumber_members) or return $cardnumber;
 610     my $checkdigit = C4::Context->preference('checkdigit');
 611     my $dbh = C4::Context->dbh;
 612     if ( $checkdigit and $checkdigit eq 'katipo' ) {
 613
 614         # if checkdigit is selected, calculate katipo-style cardnumber.
 615         # otherwise, just use the max()
 616         # purpose: generate checksum'd member numbers.
 617         # We'll assume we just got the max value of digits 2-8 of member #'s
 618         # from the database and our job is to increment that by one,
 619         # determine the 1st and 9th digits and return the full string.
 620         my $sth = $dbh->prepare(
 621             "select max(substring(borrowers.cardnumber,2,7)) as new_num from borrowers"
 622         );
 623         $sth->execute;
 624         my $data = $sth->fetchrow_hashref;
 625         $cardnumber = $data->{new_num};
 626         if ( !$cardnumber ) {    # If DB has no values,
 627             $cardnumber = 1000000;    # start at 1000000
 628         } else {
 629             $cardnumber += 1;
 630         }
 631
 632         my $sum = 0;
 633         for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
 634             # read weightings, left to right, 1 char at a time
 635             my $temp1 = $weightings[$i];
 636
 637             # sequence left to right, 1 char at a time
 638             my $temp2 = substr( $cardnumber, $i, 1 );
 639
 640             # mult each char 1-7 by its corresponding weighting
 641             $sum += $temp1 * $temp2;
 642         }
 643
 644         my $rem = ( $sum % 11 );
 645         $rem = 'X' if $rem == 10;
 646
 647         return "V$cardnumber$rem";
 648      } else {
 649
 650         my $sth = $dbh->prepare(
 651             'SELECT MAX( CAST( cardnumber AS SIGNED ) ) FROM borrowers WHERE cardnumber REGEXP "^-?[0-9]+$"'
 652         );
 653         $sth->execute;
 654         my ($result) = $sth->fetchrow;
 655         return $result + 1;
 656     }
 657     return $cardnumber;     # just here as a fallback/reminder
 658 }
 659
 660 =head2 GetPendingIssues
 661
 662   my $issues = &GetPendingIssues(@borrowernumber);
 663
 664 Looks up what the patron with the given borrowernumber has borrowed.
 665
 666 C<&GetPendingIssues> returns a
 667 reference-to-array where each element is a reference-to-hash; the
 668 keys are the fields from the C<issues>, C<biblio>, and C<items> tables.
 669 The keys include C<biblioitems> fields.
 670
 671 =cut
 672
 673 sub GetPendingIssues {
 674     my @borrowernumbers = @_;
 675
 676     unless (@borrowernumbers ) { # return a ref_to_array
 677         return \@borrowernumbers; # to not cause surprise to caller
 678     }
 679
 680     # Borrowers part of the query
 681     my $bquery = '';
 682     for (my $i = 0; $i < @borrowernumbers; $i++) {
 683         $bquery .= ' issues.borrowernumber = ?';
 684         if ($i < $#borrowernumbers ) {
 685             $bquery .= ' OR';
 686         }
 687     }
 688
 689     # FIXME: namespace collision: each table has "timestamp" fields.  Which one is "timestamp" ?
 690     # FIXME: circ/ciculation.pl tries to sort by timestamp!
 691     # FIXME: namespace collision: other collisions possible.
 692     # FIXME: most of this data isn't really being used by callers.
 693     my $query =
 694    "SELECT issues.*,
 695             items.*,
 696            biblio.*,
 697            biblioitems.volume,
 698            biblioitems.number,
 699            biblioitems.itemtype,
 700            biblioitems.isbn,
 701            biblioitems.issn,
 702            biblioitems.publicationyear,
 703            biblioitems.publishercode,
 704            biblioitems.volumedate,
 705            biblioitems.volumedesc,
 706            biblioitems.lccn,
 707            biblioitems.url,
 708            borrowers.firstname,
 709            borrowers.surname,
 710            borrowers.cardnumber,
 711            issues.timestamp AS timestamp,
 712            issues.renewals  AS renewals,
 713            issues.borrowernumber AS borrowernumber,
 714             items.renewals  AS totalrenewals
 715     FROM   issues
 716     LEFT JOIN items       ON items.itemnumber       =      issues.itemnumber
 717     LEFT JOIN biblio      ON items.biblionumber     =      biblio.biblionumber
 718     LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
 719     LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
 720     WHERE
 721       $bquery
 722     ORDER BY issues.issuedate"
 723     ;
 724
 725     my $sth = C4::Context->dbh->prepare($query);
 726     $sth->execute(@borrowernumbers);
 727     my $data = $sth->fetchall_arrayref({});
 728     my $today = dt_from_string;
 729     foreach (@{$data}) {
 730         if ($_->{issuedate}) {
 731             $_->{issuedate} = dt_from_string($_->{issuedate}, 'sql');
 732         }
 733         $_->{date_due_sql} = $_->{date_due};
 734         # FIXME no need to have this value
 735         $_->{date_due} or next;
 736         $_->{date_due_sql} = $_->{date_due};
 737         # FIXME no need to have this value
 738         $_->{date_due} = dt_from_string($_->{date_due}, 'sql');
 739         if ( DateTime->compare($_->{date_due}, $today) == -1 ) {
 740             $_->{overdue} = 1;
 741         }
 742     }
 743     return $data;
 744 }
 745
 746 =head2 GetAllIssues
 747
 748   $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
 749
 750 Looks up what the patron with the given borrowernumber has borrowed,
 751 and sorts the results.
 752
 753 C<$sortkey> is the name of a field on which to sort the results. This
 754 should be the name of a field in the C<issues>, C<biblio>,
 755 C<biblioitems>, or C<items> table in the Koha database.
 756
 757 C<$limit> is the maximum number of results to return.
 758
 759 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
 760 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
 761 C<items> tables of the Koha database.
 762
 763 =cut
 764
 765 #'
 766 sub GetAllIssues {
 767     my ( $borrowernumber, $order, $limit ) = @_;
 768
 769     return unless $borrowernumber;
 770     $order = 'date_due desc' unless $order;
 771
 772     my $dbh = C4::Context->dbh;
 773     my $query =
 774 'SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
 775   FROM issues
 776   LEFT JOIN items on items.itemnumber=issues.itemnumber
 777   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
 778   LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
 779   WHERE borrowernumber=?
 780   UNION ALL
 781   SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
 782   FROM old_issues
 783   LEFT JOIN items on items.itemnumber=old_issues.itemnumber
 784   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
 785   LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
 786   WHERE borrowernumber=? AND old_issues.itemnumber IS NOT NULL
 787   order by ' . $order;
 788     if ($limit) {
 789         $query .= " limit $limit";
 790     }
 791
 792     my $sth = $dbh->prepare($query);
 793     $sth->execute( $borrowernumber, $borrowernumber );
 794     return $sth->fetchall_arrayref( {} );
 795 }
 796
 797
 798 =head2 GetMemberAccountRecords
 799
 800   ($total, $acctlines, $count) = &GetMemberAccountRecords($borrowernumber);
 801
 802 Looks up accounting data for the patron with the given borrowernumber.
 803
 804 C<&GetMemberAccountRecords> returns a three-element array. C<$acctlines> is a
 805 reference-to-array, where each element is a reference-to-hash; the
 806 keys are the fields of the C<accountlines> table in the Koha database.
 807 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
 808 total amount outstanding for all of the account lines.
 809
 810 =cut
 811
 812 sub GetMemberAccountRecords {
 813     my ($borrowernumber) = @_;
 814     my $dbh = C4::Context->dbh;
 815     my @acctlines;
 816     my $numlines = 0;
 817     my $strsth      = qq(
 818                         SELECT *
 819                         FROM accountlines
 820                         WHERE borrowernumber=?);
 821     $strsth.=" ORDER BY accountlines_id desc";
 822     my $sth= $dbh->prepare( $strsth );
 823     $sth->execute( $borrowernumber );
 824
 825     my $total = 0;
 826     while ( my $data = $sth->fetchrow_hashref ) {
 827         if ( $data->{itemnumber} ) {
 828             my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
 829             $data->{biblionumber} = $biblio->{biblionumber};
 830             $data->{title}        = $biblio->{title};
 831         }
 832         $acctlines[$numlines] = $data;
 833         $numlines++;
 834         $total += sprintf "%.0f", 1000*$data->{amountoutstanding}; # convert float to integer to avoid round-off errors
 835     }
 836     $total /= 1000;
 837     return ( $total, \@acctlines,$numlines);
 838 }
 839
 840 =head2 GetMemberAccountBalance
 841
 842   ($total_balance, $non_issue_balance, $other_charges) = &GetMemberAccountBalance($borrowernumber);
 843
 844 Calculates amount immediately owing by the patron - non-issue charges.
 845 Based on GetMemberAccountRecords.
 846 Charges exempt from non-issue are:
 847 * Res (reserves)
 848 * Rent (rental) if RentalsInNoissuesCharge syspref is set to false
 849 * Manual invoices if ManInvInNoissuesCharge syspref is set to false
 850
 851 =cut
 852
 853 sub GetMemberAccountBalance {
 854     my ($borrowernumber) = @_;
 855
 856     my $ACCOUNT_TYPE_LENGTH = 5; # this is plain ridiculous...
 857
 858     my @not_fines;
 859     push @not_fines, 'Res' unless C4::Context->preference('HoldsInNoissuesCharge');
 860     push @not_fines, 'Rent' unless C4::Context->preference('RentalsInNoissuesCharge');
 861     unless ( C4::Context->preference('ManInvInNoissuesCharge') ) {
 862         my $dbh = C4::Context->dbh;
 863         my $man_inv_types = $dbh->selectcol_arrayref(qq{SELECT authorised_value FROM authorised_values WHERE category = 'MANUAL_INV'});
 864         push @not_fines, map substr($_, 0, $ACCOUNT_TYPE_LENGTH), @$man_inv_types;
 865     }
 866     my %not_fine = map {$_ => 1} @not_fines;
 867
 868     my ($total, $acctlines) = GetMemberAccountRecords($borrowernumber);
 869     my $other_charges = 0;
 870     foreach (@$acctlines) {
 871         $other_charges += $_->{amountoutstanding} if $not_fine{ substr($_->{accounttype}, 0, $ACCOUNT_TYPE_LENGTH) };
 872     }
 873
 874     return ( $total, $total - $other_charges, $other_charges);
 875 }
 876
 877 =head2 GetBorNotifyAcctRecord
 878
 879   ($total, $acctlines, $count) = &GetBorNotifyAcctRecord($params,$notifyid);
 880
 881 Looks up accounting data for the patron with the given borrowernumber per file number.
 882
 883 C<&GetBorNotifyAcctRecord> returns a three-element array. C<$acctlines> is a
 884 reference-to-array, where each element is a reference-to-hash; the
 885 keys are the fields of the C<accountlines> table in the Koha database.
 886 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
 887 total amount outstanding for all of the account lines.
 888
 889 =cut
 890
 891 sub GetBorNotifyAcctRecord {
 892     my ( $borrowernumber, $notifyid ) = @_;
 893     my $dbh = C4::Context->dbh;
 894     my @acctlines;
 895     my $numlines = 0;
 896     my $sth = $dbh->prepare(
 897             "SELECT *
 898                 FROM accountlines
 899                 WHERE borrowernumber=?
 900                     AND notify_id=?
 901                     AND amountoutstanding != '0'
 902                 ORDER BY notify_id,accounttype
 903                 ");
 904
 905     $sth->execute( $borrowernumber, $notifyid );
 906     my $total = 0;
 907     while ( my $data = $sth->fetchrow_hashref ) {
 908         if ( $data->{itemnumber} ) {
 909             my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
 910             $data->{biblionumber} = $biblio->{biblionumber};
 911             $data->{title}        = $biblio->{title};
 912         }
 913         $acctlines[$numlines] = $data;
 914         $numlines++;
 915         $total += int(100 * $data->{'amountoutstanding'});
 916     }
 917     $total /= 100;
 918     return ( $total, \@acctlines, $numlines );
 919 }
 920
 921 sub checkcardnumber {
 922     my ( $cardnumber, $borrowernumber ) = @_;
 923
 924     # If cardnumber is null, we assume they're allowed.
 925     return 0 unless defined $cardnumber;
 926
 927     my $dbh = C4::Context->dbh;
 928     my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
 929     $query .= " AND borrowernumber <> ?" if ($borrowernumber);
 930     my $sth = $dbh->prepare($query);
 931     $sth->execute(
 932         $cardnumber,
 933         ( $borrowernumber ? $borrowernumber : () )
 934     );
 935
 936     return 1 if $sth->fetchrow_hashref;
 937
 938     my ( $min_length, $max_length ) = get_cardnumber_length();
 939     return 2
 940         if length $cardnumber > $max_length
 941         or length $cardnumber < $min_length;
 942
 943     return 0;
 944 }
 945
 946 =head2 get_cardnumber_length
 947
 948     my ($min, $max) = C4::Members::get_cardnumber_length()
 949
 950 Returns the minimum and maximum length for patron cardnumbers as
 951 determined by the CardnumberLength system preference, the
 952 BorrowerMandatoryField system preference, and the width of the
 953 database column.
 954
 955 =cut
 956
 957 sub get_cardnumber_length {
 958     my ( $min, $max ) = ( 0, 16 ); # borrowers.cardnumber is a nullable varchar(16)
 959     $min = 1 if C4::Context->preference('BorrowerMandatoryField') =~ /cardnumber/;
 960     if ( my $cardnumber_length = C4::Context->preference('CardnumberLength') ) {
 961         # Is integer and length match
 962         if ( $cardnumber_length =~ m|^\d+$| ) {
 963             $min = $max = $cardnumber_length
 964                 if $cardnumber_length >= $min
 965                     and $cardnumber_length <= $max;
 966         }
 967         # Else assuming it is a range
 968         elsif ( $cardnumber_length =~ m|(\d*),(\d*)| ) {
 969             $min = $1 if $1 and $min < $1;
 970             $max = $2 if $2 and $max > $2;
 971         }
 972
 973     }
 974     my $borrower = Koha::Schema->resultset('Borrower');
 975     my $field_size = $borrower->result_source->column_info('cardnumber')->{size};
 976     $min = $field_size if $min > $field_size;
 977     return ( $min, $max );
 978 }
 979
 980 =head2 GetFirstValidEmailAddress
 981
 982   $email = GetFirstValidEmailAddress($borrowernumber);
 983
 984 Return the first valid email address for a borrower, given the borrowernumber.  For now, the order
 985 is defined as email, emailpro, B_email.  Returns the empty string if the borrower has no email
 986 addresses.
 987
 988 =cut
 989
 990 sub GetFirstValidEmailAddress {
 991     my $borrowernumber = shift;
 992     my $dbh = C4::Context->dbh;
 993     my $sth = $dbh->prepare( "SELECT email, emailpro, B_email FROM borrowers where borrowernumber = ? ");
 994     $sth->execute( $borrowernumber );
 995     my $data = $sth->fetchrow_hashref;
 996
 997     if ($data->{'email'}) {
 998        return $data->{'email'};
 999     } elsif ($data->{'emailpro'}) {
1000        return $data->{'emailpro'};
1001     } elsif ($data->{'B_email'}) {
1002        return $data->{'B_email'};
1003     } else {
1004        return '';
1005     }
1006 }
1007
1008 =head2 GetNoticeEmailAddress
1009
1010   $email = GetNoticeEmailAddress($borrowernumber);
1011
1012 Return the email address of borrower used for notices, given the borrowernumber.
1013 Returns the empty string if no email address.
1014
1015 =cut
1016
1017 sub GetNoticeEmailAddress {
1018     my $borrowernumber = shift;
1019
1020     my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
1021     # if syspref is set to 'first valid' (value == OFF), look up email address
1022     if ( $which_address eq 'OFF' ) {
1023         return GetFirstValidEmailAddress($borrowernumber);
1024     }
1025     # specified email address field
1026     my $dbh = C4::Context->dbh;
1027     my $sth = $dbh->prepare( qq{
1028         SELECT $which_address AS primaryemail
1029         FROM borrowers
1030         WHERE borrowernumber=?
1031     } );
1032     $sth->execute($borrowernumber);
1033     my $data = $sth->fetchrow_hashref;
1034     return $data->{'primaryemail'} || '';
1035 }
1036
1037 =head2 GetBorrowersToExpunge
1038
1039   $borrowers = &GetBorrowersToExpunge(
1040       not_borrowed_since => $not_borrowed_since,
1041       expired_before       => $expired_before,
1042       category_code        => $category_code,
1043       patron_list_id       => $patron_list_id,
1044       branchcode           => $branchcode
1045   );
1046
1047   This function get all borrowers based on the given criteria.
1048
1049 =cut
1050
1051 sub GetBorrowersToExpunge {
1052
1053     my $params = shift;
1054     my $filterdate       = $params->{'not_borrowed_since'};
1055     my $filterexpiry     = $params->{'expired_before'};
1056     my $filterlastseen   = $params->{'last_seen'};
1057     my $filtercategory   = $params->{'category_code'};
1058     my $filterbranch     = $params->{'branchcode'} ||
1059                         ((C4::Context->preference('IndependentBranches')
1060                              && C4::Context->userenv
1061                              && !C4::Context->IsSuperLibrarian()
1062                              && C4::Context->userenv->{branch})
1063                          ? C4::Context->userenv->{branch}
1064                          : "");
1065     my $filterpatronlist = $params->{'patron_list_id'};
1066
1067     my $dbh   = C4::Context->dbh;
1068     my $query = q|
1069         SELECT borrowers.borrowernumber,
1070                MAX(old_issues.timestamp) AS latestissue,
1071                MAX(issues.timestamp) AS currentissue
1072         FROM   borrowers
1073         JOIN   categories USING (categorycode)
1074         LEFT JOIN (
1075             SELECT guarantorid
1076             FROM borrowers
1077             WHERE guarantorid IS NOT NULL
1078                 AND guarantorid <> 0
1079         ) as tmp ON borrowers.borrowernumber=tmp.guarantorid
1080         LEFT JOIN old_issues USING (borrowernumber)
1081         LEFT JOIN issues USING (borrowernumber)|;
1082     if ( $filterpatronlist  ){
1083         $query .= q| LEFT JOIN patron_list_patrons USING (borrowernumber)|;
1084     }
1085     $query .= q| WHERE  category_type <> 'S'
1086         AND tmp.guarantorid IS NULL
1087    |;
1088     my @query_params;
1089     if ( $filterbranch && $filterbranch ne "" ) {
1090         $query.= " AND borrowers.branchcode = ? ";
1091         push( @query_params, $filterbranch );
1092     }
1093     if ( $filterexpiry ) {
1094         $query .= " AND dateexpiry < ? ";
1095         push( @query_params, $filterexpiry );
1096     }
1097     if ( $filterlastseen ) {
1098         $query .= ' AND lastseen < ? ';
1099         push @query_params, $filterlastseen;
1100     }
1101     if ( $filtercategory ) {
1102         $query .= " AND categorycode = ? ";
1103         push( @query_params, $filtercategory );
1104     }
1105     if ( $filterpatronlist ){
1106         $query.=" AND patron_list_id = ? ";
1107         push( @query_params, $filterpatronlist );
1108     }
1109     $query.=" GROUP BY borrowers.borrowernumber HAVING currentissue IS NULL ";
1110     if ( $filterdate ) {
1111         $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
1112         push @query_params,$filterdate;
1113     }
1114     warn $query if $debug;
1115
1116     my $sth = $dbh->prepare($query);
1117     if (scalar(@query_params)>0){
1118         $sth->execute(@query_params);
1119     }
1120     else {
1121         $sth->execute;
1122     }
1123
1124     my @results;
1125     while ( my $data = $sth->fetchrow_hashref ) {
1126         push @results, $data;
1127     }
1128     return \@results;
1129 }
1130
1131 =head2 IssueSlip
1132
1133   IssueSlip($branchcode, $borrowernumber, $quickslip)
1134
1135   Returns letter hash ( see C4::Letters::GetPreparedLetter )
1136
1137   $quickslip is boolean, to indicate whether we want a quick slip
1138
1139   IssueSlip populates ISSUESLIP and ISSUEQSLIP, and will make the following expansions:
1140
1141   Both slips:
1142
1143       <<branches.*>>
1144       <<borrowers.*>>
1145
1146   ISSUESLIP:
1147
1148       <checkedout>
1149          <<biblio.*>>
1150          <<items.*>>
1151          <<biblioitems.*>>
1152          <<issues.*>>
1153       </checkedout>
1154
1155       <overdue>
1156          <<biblio.*>>
1157          <<items.*>>
1158          <<biblioitems.*>>
1159          <<issues.*>>
1160       </overdue>
1161
1162       <news>
1163          <<opac_news.*>>
1164       </news>
1165
1166   ISSUEQSLIP:
1167
1168       <checkedout>
1169          <<biblio.*>>
1170          <<items.*>>
1171          <<biblioitems.*>>
1172          <<issues.*>>
1173       </checkedout>
1174
1175   NOTE: Not all table fields are available, pleasee see GetPendingIssues for a list of available fields.
1176
1177 =cut
1178
1179 sub IssueSlip {
1180     my ($branch, $borrowernumber, $quickslip) = @_;
1181
1182     # FIXME Check callers before removing this statement
1183     #return unless $borrowernumber;
1184
1185     my @issues = @{ GetPendingIssues($borrowernumber) };
1186
1187     for my $issue (@issues) {
1188         $issue->{date_due} = $issue->{date_due_sql};
1189         if ($quickslip) {
1190             my $today = output_pref({ dt => dt_from_string, dateformat => 'iso', dateonly => 1 });
1191             if ( substr( $issue->{issuedate}, 0, 10 ) eq $today
1192                 or substr( $issue->{lastreneweddate}, 0, 10 ) eq $today ) {
1193                   $issue->{now} = 1;
1194             };
1195         }
1196     }
1197
1198     # Sort on timestamp then on issuedate (useful for tests and could be if modified in a batch
1199     @issues = sort {
1200         my $s = $b->{timestamp} <=> $a->{timestamp};
1201         $s == 0 ?
1202              $b->{issuedate} <=> $a->{issuedate} : $s;
1203     } @issues;
1204
1205     my ($letter_code, %repeat);
1206     if ( $quickslip ) {
1207         $letter_code = 'ISSUEQSLIP';
1208         %repeat =  (
1209             'checkedout' => [ map {
1210                 'biblio'       => $_,
1211                 'items'        => $_,
1212                 'biblioitems'  => $_,
1213                 'issues'       => $_,
1214             }, grep { $_->{'now'} } @issues ],
1215         );
1216     }
1217     else {
1218         $letter_code = 'ISSUESLIP';
1219         %repeat =  (
1220             'checkedout' => [ map {
1221                 'biblio'       => $_,
1222                 'items'        => $_,
1223                 'biblioitems'  => $_,
1224                 'issues'       => $_,
1225             }, grep { !$_->{'overdue'} } @issues ],
1226
1227             'overdue' => [ map {
1228                 'biblio'       => $_,
1229                 'items'        => $_,
1230                 'biblioitems'  => $_,
1231                 'issues'       => $_,
1232             }, grep { $_->{'overdue'} } @issues ],
1233
1234             'news' => [ map {
1235                 $_->{'timestamp'} = $_->{'newdate'};
1236                 { opac_news => $_ }
1237             } @{ GetNewsToDisplay("slip",$branch) } ],
1238         );
1239     }
1240
1241     return  C4::Letters::GetPreparedLetter (
1242         module => 'circulation',
1243         letter_code => $letter_code,
1244         branchcode => $branch,
1245         tables => {
1246             'branches'    => $branch,
1247             'borrowers'   => $borrowernumber,
1248         },
1249         repeat => \%repeat,
1250     );
1251 }
1252
1253 =head2 GetBorrowersWithEmail
1254
1255     ([$borrnum,$userid], ...) = GetBorrowersWithEmail('me@example.com');
1256
1257 This gets a list of users and their basic details from their email address.
1258 As it's possible for multiple user to have the same email address, it provides
1259 you with all of them. If there is no userid for the user, there will be an
1260 C<undef> there. An empty list will be returned if there are no matches.
1261
1262 =cut
1263
1264 sub GetBorrowersWithEmail {
1265     my $email = shift;
1266
1267     my $dbh = C4::Context->dbh;
1268
1269     my $query = "SELECT borrowernumber, userid FROM borrowers WHERE email=?";
1270     my $sth=$dbh->prepare($query);
1271     $sth->execute($email);
1272     my @result = ();
1273     while (my $ref = $sth->fetch) {
1274         push @result, $ref;
1275     }
1276     die "Failure searching for borrowers by email address: $sth->errstr" if $sth->err;
1277     return @result;
1278 }
1279
1280 =head2 AddMember_Auto
1281
1282 =cut
1283
1284 sub AddMember_Auto {
1285     my ( %borrower ) = @_;
1286
1287     $borrower{'cardnumber'} ||= fixup_cardnumber();
1288
1289     $borrower{'borrowernumber'} = AddMember(%borrower);
1290
1291     return ( %borrower );
1292 }
1293
1294 =head2 AddMember_Opac
1295
1296 =cut
1297
1298 sub AddMember_Opac {
1299     my ( %borrower ) = @_;
1300
1301     $borrower{'categorycode'} //= C4::Context->preference('PatronSelfRegistrationDefaultCategory');
1302     if (not defined $borrower{'password'}){
1303         my $sr = new String::Random;
1304         $sr->{'A'} = [ 'A'..'Z', 'a'..'z' ];
1305         my $password = $sr->randpattern("AAAAAAAAAA");
1306         $borrower{'password'} = $password;
1307     }
1308
1309     %borrower = AddMember_Auto(%borrower);
1310
1311     return ( $borrower{'borrowernumber'}, $borrower{'password'} );
1312 }
1313
1314 =head2 DeleteExpiredOpacRegistrations
1315
1316     Delete accounts that haven't been upgraded from the 'temporary' category
1317     Returns the number of removed patrons
1318
1319 =cut
1320
1321 sub DeleteExpiredOpacRegistrations {
1322
1323     my $delay = C4::Context->preference('PatronSelfRegistrationExpireTemporaryAccountsDelay');
1324     my $category_code = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
1325
1326     return 0 if not $category_code or not defined $delay or $delay eq q||;
1327
1328     my $query = qq|
1329 SELECT borrowernumber
1330 FROM borrowers
1331 WHERE categorycode = ? AND DATEDIFF( NOW(), dateenrolled ) > ? |;
1332
1333     my $dbh = C4::Context->dbh;
1334     my $sth = $dbh->prepare($query);
1335     $sth->execute( $category_code, $delay );
1336     my $cnt=0;
1337     while ( my ($borrowernumber) = $sth->fetchrow_array() ) {
1338         Koha::Patrons->find($borrowernumber)->delete;
1339         $cnt++;
1340     }
1341     return $cnt;
1342 }
1343
1344 =head2 DeleteUnverifiedOpacRegistrations
1345
1346     Delete all unverified self registrations in borrower_modifications,
1347     older than the specified number of days.
1348
1349 =cut
1350
1351 sub DeleteUnverifiedOpacRegistrations {
1352     my ( $days ) = @_;
1353     my $dbh = C4::Context->dbh;
1354     my $sql=qq|
1355 DELETE FROM borrower_modifications
1356 WHERE borrowernumber = 0 AND DATEDIFF( NOW(), timestamp ) > ?|;
1357     my $cnt=$dbh->do($sql, undef, ($days) );
1358     return $cnt eq '0E0'? 0: $cnt;
1359 }
1360
1361 sub GetOverduesForPatron {
1362     my ( $borrowernumber ) = @_;
1363
1364     my $sql = "
1365         SELECT *
1366         FROM issues, items, biblio, biblioitems
1367         WHERE items.itemnumber=issues.itemnumber
1368           AND biblio.biblionumber   = items.biblionumber
1369           AND biblio.biblionumber   = biblioitems.biblionumber
1370           AND issues.borrowernumber = ?
1371           AND date_due < NOW()
1372     ";
1373
1374     my $sth = C4::Context->dbh->prepare( $sql );
1375     $sth->execute( $borrowernumber );
1376
1377     return $sth->fetchall_arrayref({});
1378 }
1379
1380 END { }    # module clean-up code here (global destructor)
1381
1382 1;
1383
1384 __END__
1385
1386 =head1 AUTHOR
1387
1388 Koha Team
1389
1390 =cut