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