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 List::MoreUtils qw( uniq );
  30 use JSON qw(to_json);
  31 use C4::Log; # logaction
  32 use C4::Overdues;
  33 use C4::Reserves;
  34 use C4::Accounts;
  35 use C4::Biblio;
  36 use C4::Letters;
  37 use C4::Members::Attributes qw(SearchIdMatchingAttribute UpdateBorrowerAttribute);
  38 use C4::NewsChannels; #get slip news
  39 use DateTime;
  40 use Koha::Database;
  41 use Koha::DateUtils;
  42 use Text::Unaccent qw( unac_string );
  43 use Koha::AuthUtils qw(hash_password);
  44 use Koha::Database;
  45 use Koha::Holds;
  46 use Koha::List::Patron;
  47 use Koha::Patrons;
  48 use Koha::Patron::Categories;
  49
  50 our (@ISA,@EXPORT,@EXPORT_OK,$debug);
  51
  52 use Module::Load::Conditional qw( can_load );
  53 if ( ! can_load( modules => { 'Koha::NorwegianPatronDB' => undef } ) ) {
  54    $debug && warn "Unable to load Koha::NorwegianPatronDB";
  55 }
  56
  57
  58 BEGIN {
  59     $debug = $ENV{DEBUG} || 0;
  60     require Exporter;
  61     @ISA = qw(Exporter);
  62     #Get data
  63     push @EXPORT, qw(
  64
  65         &GetAllIssues
  66
  67         &GetBorrowersToExpunge
  68
  69         &IssueSlip
  70     );
  71
  72     #Modify data
  73     push @EXPORT, qw(
  74         &ModMember
  75         &changepassword
  76     );
  77
  78     #Insert data
  79     push @EXPORT, qw(
  80         &AddMember
  81     &AddMember_Auto
  82         &AddMember_Opac
  83     );
  84
  85     #Check data
  86     push @EXPORT, qw(
  87         &checkuserpassword
  88         &fixup_cardnumber
  89         &checkcardnumber
  90     );
  91 }
  92
  93 =head1 NAME
  94
  95 C4::Members - Perl Module containing convenience functions for member handling
  96
  97 =head1 SYNOPSIS
  98
  99 use C4::Members;
 100
 101 =head1 DESCRIPTION
 102
 103 This module contains routines for adding, modifying and deleting members/patrons/borrowers
 104
 105 =head1 FUNCTIONS
 106
 107 =head2 patronflags
 108
 109  $flags = &patronflags($patron);
 110
 111 This function is not exported.
 112
 113 The following will be set where applicable:
 114  $flags->{CHARGES}->{amount}        Amount of debt
 115  $flags->{CHARGES}->{noissues}      Set if debt amount >$5.00 (or syspref noissuescharge)
 116  $flags->{CHARGES}->{message}       Message -- deprecated
 117
 118  $flags->{CREDITS}->{amount}        Amount of credit
 119  $flags->{CREDITS}->{message}       Message -- deprecated
 120
 121  $flags->{  GNA  }                  Patron has no valid address
 122  $flags->{  GNA  }->{noissues}      Set for each GNA
 123  $flags->{  GNA  }->{message}       "Borrower has no valid address" -- deprecated
 124
 125  $flags->{ LOST  }                  Patron's card reported lost
 126  $flags->{ LOST  }->{noissues}      Set for each LOST
 127  $flags->{ LOST  }->{message}       Message -- deprecated
 128
 129  $flags->{DBARRED}                  Set if patron debarred, no access
 130  $flags->{DBARRED}->{noissues}      Set for each DBARRED
 131  $flags->{DBARRED}->{message}       Message -- deprecated
 132
 133  $flags->{ NOTES }
 134  $flags->{ NOTES }->{message}       The note itself.  NOT deprecated
 135
 136  $flags->{ ODUES }                  Set if patron has overdue books.
 137  $flags->{ ODUES }->{message}       "Yes"  -- deprecated
 138  $flags->{ ODUES }->{itemlist}      ref-to-array: list of overdue books
 139  $flags->{ ODUES }->{itemlisttext}  Text list of overdue items -- deprecated
 140
 141  $flags->{WAITING}                  Set if any of patron's reserves are available
 142  $flags->{WAITING}->{message}       Message -- deprecated
 143  $flags->{WAITING}->{itemlist}      ref-to-array: list of available items
 144
 145 =over
 146
 147 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the
 148 overdue items. Its elements are references-to-hash, each describing an
 149 overdue item. The keys are selected fields from the issues, biblio,
 150 biblioitems, and items tables of the Koha database.
 151
 152 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlisttext}> is a string giving a text listing of
 153 the overdue items, one per line.  Deprecated.
 154
 155 =item C<$flags-E<gt>{WAITING}-E<gt>{itemlist}> is a reference-to-array listing the
 156 available items. Each element is a reference-to-hash whose keys are
 157 fields from the reserves table of the Koha database.
 158
 159 =back
 160
 161 All the "message" fields that include language generated in this function are deprecated,
 162 because such strings belong properly in the display layer.
 163
 164 The "message" field that comes from the DB is OK.
 165
 166 =cut
 167
 168 # TODO: use {anonymous => hashes} instead of a dozen %flaginfo
 169 # FIXME rename this function.
 170 # DEPRECATED Do not use this subroutine!
 171 sub patronflags {
 172     my %flags;
 173     my ( $patroninformation) = @_;
 174     my $dbh=C4::Context->dbh;
 175     my $patron = Koha::Patrons->find( $patroninformation->{borrowernumber} );
 176     my $account = $patron->account;
 177     my $owing = $account->non_issues_charges;
 178     if ( $owing > 0 ) {
 179         my %flaginfo;
 180         my $noissuescharge = C4::Context->preference("noissuescharge") || 5;
 181         $flaginfo{'message'} = sprintf 'Patron owes %.02f', $owing;
 182         $flaginfo{'amount'}  = sprintf "%.02f", $owing;
 183         if ( $owing > $noissuescharge && !C4::Context->preference("AllowFineOverride") ) {
 184             $flaginfo{'noissues'} = 1;
 185         }
 186         $flags{'CHARGES'} = \%flaginfo;
 187     }
 188     elsif ( ( my $balance = $account->balance ) < 0 ) {
 189         my %flaginfo;
 190         $flaginfo{'message'} = sprintf 'Patron has credit of %.02f', -$balance;
 191         $flaginfo{'amount'}  = sprintf "%.02f", $balance;
 192         $flags{'CREDITS'} = \%flaginfo;
 193     }
 194
 195     # Check the debt of the guarntees of this patron
 196     my $no_issues_charge_guarantees = C4::Context->preference("NoIssuesChargeGuarantees");
 197     $no_issues_charge_guarantees = undef unless looks_like_number( $no_issues_charge_guarantees );
 198     if ( defined $no_issues_charge_guarantees ) {
 199         my $p = Koha::Patrons->find( $patroninformation->{borrowernumber} );
 200         my @guarantees = $p->guarantees();
 201         my $guarantees_non_issues_charges;
 202         foreach my $g ( @guarantees ) {
 203             $guarantees_non_issues_charges += $g->account->non_issues_charges;
 204         }
 205
 206         if ( $guarantees_non_issues_charges > $no_issues_charge_guarantees ) {
 207             my %flaginfo;
 208             $flaginfo{'message'} = sprintf 'patron guarantees owe %.02f', $guarantees_non_issues_charges;
 209             $flaginfo{'amount'}  = $guarantees_non_issues_charges;
 210             $flaginfo{'noissues'} = 1 unless C4::Context->preference("allowfineoverride");
 211             $flags{'CHARGES_GUARANTEES'} = \%flaginfo;
 212         }
 213     }
 214
 215     if (   $patroninformation->{'gonenoaddress'}
 216         && $patroninformation->{'gonenoaddress'} == 1 )
 217     {
 218         my %flaginfo;
 219         $flaginfo{'message'}  = 'Borrower has no valid address.';
 220         $flaginfo{'noissues'} = 1;
 221         $flags{'GNA'}         = \%flaginfo;
 222     }
 223     if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
 224         my %flaginfo;
 225         $flaginfo{'message'}  = 'Borrower\'s card reported lost.';
 226         $flaginfo{'noissues'} = 1;
 227         $flags{'LOST'}        = \%flaginfo;
 228     }
 229     if ( $patroninformation->{'debarred'} && check_date( split( /-/, $patroninformation->{'debarred'} ) ) ) {
 230         if ( Date_to_Days(Date::Calc::Today) < Date_to_Days( split( /-/, $patroninformation->{'debarred'} ) ) ) {
 231             my %flaginfo;
 232             $flaginfo{'debarredcomment'} = $patroninformation->{'debarredcomment'};
 233             $flaginfo{'message'}         = $patroninformation->{'debarredcomment'};
 234             $flaginfo{'noissues'}        = 1;
 235             $flaginfo{'dateend'}         = $patroninformation->{'debarred'};
 236             $flags{'DBARRED'}           = \%flaginfo;
 237         }
 238     }
 239     if (   $patroninformation->{'borrowernotes'}
 240         && $patroninformation->{'borrowernotes'} )
 241     {
 242         my %flaginfo;
 243         $flaginfo{'message'} = $patroninformation->{'borrowernotes'};
 244         $flags{'NOTES'}      = \%flaginfo;
 245     }
 246     my ( $odues, $itemsoverdue ) = C4::Overdues::checkoverdues($patroninformation->{'borrowernumber'});
 247     if ( $odues && $odues > 0 ) {
 248         my %flaginfo;
 249         $flaginfo{'message'}  = "Yes";
 250         $flaginfo{'itemlist'} = $itemsoverdue;
 251         foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
 252             @$itemsoverdue )
 253         {
 254             $flaginfo{'itemlisttext'} .=
 255               "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n";  # newline is display layer
 256         }
 257         $flags{'ODUES'} = \%flaginfo;
 258     }
 259
 260     my $waiting_holds = $patron->holds->search({ found => 'W' });
 261     my $nowaiting = $waiting_holds->count;
 262     if ( $nowaiting > 0 ) {
 263         my %flaginfo;
 264         $flaginfo{'message'}  = "Reserved items available";
 265         $flaginfo{'itemlist'} = $waiting_holds->unblessed;
 266         $flags{'WAITING'}     = \%flaginfo;
 267     }
 268     return ( \%flags );
 269 }
 270
 271
 272 =head2 ModMember
 273
 274   my $success = ModMember(borrowernumber => $borrowernumber,
 275                                             [ field => value ]... );
 276
 277 Modify borrower's data.  All date fields should ALREADY be in ISO format.
 278
 279 return :
 280 true on success, or false on failure
 281
 282 =cut
 283
 284 sub ModMember {
 285     my (%data) = @_;
 286
 287     # trim whitespace from data which has some non-whitespace in it.
 288     foreach my $field_name (keys(%data)) {
 289         if ( defined $data{$field_name} && $data{$field_name} =~ /\S/ ) {
 290             $data{$field_name} =~ s/^\s*|\s*$//g;
 291         }
 292     }
 293
 294     # test to know if you must update or not the borrower password
 295     if (exists $data{password}) {
 296         if ($data{password} eq '****' or $data{password} eq '') {
 297             delete $data{password};
 298         } else {
 299             if ( C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
 300                 warn "C4::Members::ModMember - NorwegianPatronDB hooks will be deprecated as of 18.11.0\n";
 301                 # Update the hashed PIN in borrower_sync.hashed_pin, before Koha hashes it
 302                 Koha::NorwegianPatronDB::NLUpdateHashedPIN( $data{'borrowernumber'}, $data{password} );
 303             }
 304             $data{password} = hash_password($data{password});
 305         }
 306     }
 307
 308     my $old_categorycode = Koha::Patrons->find( $data{borrowernumber} )->categorycode;
 309
 310     # get only the columns of a borrower
 311     my $schema = Koha::Database->new()->schema;
 312     my @columns = $schema->source('Borrower')->columns;
 313     my $new_borrower = { map { join(' ', @columns) =~ /$_/ ? ( $_ => $data{$_} ) : () } keys(%data) };
 314
 315     $new_borrower->{dateofbirth}     ||= undef if exists $new_borrower->{dateofbirth};
 316     $new_borrower->{dateenrolled}    ||= undef if exists $new_borrower->{dateenrolled};
 317     $new_borrower->{dateexpiry}      ||= undef if exists $new_borrower->{dateexpiry};
 318     $new_borrower->{debarred}        ||= undef if exists $new_borrower->{debarred};
 319     $new_borrower->{sms_provider_id} ||= undef if exists $new_borrower->{sms_provider_id};
 320     $new_borrower->{guarantorid}     ||= undef if exists $new_borrower->{guarantorid};
 321
 322     my $patron = Koha::Patrons->find( $new_borrower->{borrowernumber} );
 323
 324     my $borrowers_log = C4::Context->preference("BorrowersLog");
 325     if ( $borrowers_log && $patron->cardnumber ne $new_borrower->{cardnumber} )
 326     {
 327         logaction(
 328             "MEMBERS",
 329             "MODIFY",
 330             $data{'borrowernumber'},
 331             to_json(
 332                 {
 333                     cardnumber_replaced => {
 334                         previous_cardnumber => $patron->cardnumber,
 335                         new_cardnumber      => $new_borrower->{cardnumber},
 336                     }
 337                 },
 338                 { utf8 => 1, pretty => 1 }
 339             )
 340         );
 341     }
 342
 343     delete $new_borrower->{userid} if exists $new_borrower->{userid} and not $new_borrower->{userid};
 344
 345     my $execute_success = $patron->store if $patron->set($new_borrower);
 346
 347     if ($execute_success) { # only proceed if the update was a success
 348         # If the patron changes to a category with enrollment fee, we add a fee
 349         if ( $data{categorycode} and $data{categorycode} ne $old_categorycode ) {
 350             if ( C4::Context->preference('FeeOnChangePatronCategory') ) {
 351                 $patron->add_enrolment_fee_if_needed;
 352             }
 353         }
 354
 355         # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
 356         # cronjob will use for syncing with NL
 357         if ( C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
 358             warn "C4::Members::ModMember - NorwegianPatronDB hooks will be deprecated as of 18.11.0\n";
 359             my $borrowersync = Koha::Database->new->schema->resultset('BorrowerSync')->find({
 360                 'synctype'       => 'norwegianpatrondb',
 361                 'borrowernumber' => $data{'borrowernumber'}
 362             });
 363             # Do not set to "edited" if syncstatus is "new". We need to sync as new before
 364             # we can sync as changed. And the "new sync" will pick up all changes since
 365             # the patron was created anyway.
 366             if ( $borrowersync->syncstatus ne 'new' && $borrowersync->syncstatus ne 'delete' ) {
 367                 $borrowersync->update( { 'syncstatus' => 'edited' } );
 368             }
 369             # Set the value of 'sync'
 370             $borrowersync->update( { 'sync' => $data{'sync'} } );
 371             # Try to do the live sync
 372             Koha::NorwegianPatronDB::NLSync({ 'borrowernumber' => $data{'borrowernumber'} });
 373         }
 374
 375         logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "UPDATE (executed w/ arg: $data{'borrowernumber'})") if $borrowers_log;
 376     }
 377     return $execute_success;
 378 }
 379
 380 =head2 AddMember
 381
 382   $borrowernumber = &AddMember(%borrower);
 383
 384 insert new borrower into table
 385
 386 (%borrower keys are database columns. Database columns could be
 387 different in different versions. Please look into database for correct
 388 column names.)
 389
 390 Returns the borrowernumber upon success
 391
 392 Returns as undef upon any db error without further processing
 393
 394 =cut
 395
 396 #'
 397 sub AddMember {
 398     my (%data) = @_;
 399     my $dbh = C4::Context->dbh;
 400     my $schema = Koha::Database->new()->schema;
 401
 402     my $category = Koha::Patron::Categories->find( $data{categorycode} );
 403     unless ($category) {
 404         Koha::Exceptions::Object::FKConstraint->throw(
 405             broken_fk => 'categorycode',
 406             value     => $data{categorycode},
 407         );
 408     }
 409
 410     # trim whitespace from data which has some non-whitespace in it.
 411     foreach my $field_name (keys(%data)) {
 412         if ( defined $data{$field_name} && $data{$field_name} =~ /\S/ ) {
 413             $data{$field_name} =~ s/^\s*|\s*$//g;
 414         }
 415     }
 416
 417     my $p = Koha::Patron->new( { userid => $data{userid}, firstname => $data{firstname}, surname => $data{surname} } );
 418     # generate a proper login if none provided
 419     $data{'userid'} = $p->generate_userid
 420       if ( $data{'userid'} eq '' || ! $p->has_valid_userid );
 421
 422     # add expiration date if it isn't already there
 423     $data{dateexpiry} ||= $category->get_expiry_date;
 424
 425     # add enrollment date if it isn't already there
 426     unless ( $data{'dateenrolled'} ) {
 427         $data{'dateenrolled'} = output_pref( { dt => dt_from_string, dateonly => 1, dateformat => 'iso' } );
 428     }
 429
 430     if ( C4::Context->preference("autoMemberNum") ) {
 431         if ( not exists $data{cardnumber} or not defined $data{cardnumber} or $data{cardnumber} eq '' ) {
 432             $data{cardnumber} = fixup_cardnumber( $data{cardnumber} );
 433         }
 434     }
 435
 436     $data{'privacy'} =
 437         $category->default_privacy() eq 'default' ? 1
 438       : $category->default_privacy() eq 'never'   ? 2
 439       : $category->default_privacy() eq 'forever' ? 0
 440       :                                             undef;
 441
 442     $data{'privacy_guarantor_checkouts'} = 0 unless defined( $data{'privacy_guarantor_checkouts'} );
 443
 444     # Make a copy of the plain text password for later use
 445     my $plain_text_password = $data{'password'};
 446
 447     # create a disabled account if no password provided
 448     $data{'password'} = ($data{'password'})? hash_password($data{'password'}) : '!';
 449
 450     # we don't want invalid dates in the db (mysql has a bad habit of inserting 0000-00-00
 451     $data{'dateofbirth'}     = undef if ( not $data{'dateofbirth'} );
 452     $data{'debarred'}        = undef if ( not $data{'debarred'} );
 453     $data{'sms_provider_id'} = undef if ( not $data{'sms_provider_id'} );
 454     $data{'guarantorid'}     = undef if ( not $data{'guarantorid'} );
 455
 456     # get only the columns of Borrower
 457     # FIXME Do we really need this check?
 458     my @columns = $schema->source('Borrower')->columns;
 459     my $new_member = { map { join(' ',@columns) =~ /$_/ ? ( $_ => $data{$_} )  : () } keys(%data) } ;
 460
 461     delete $new_member->{borrowernumber};
 462
 463     my $patron = Koha::Patron->new( $new_member )->store;
 464     $data{borrowernumber} = $patron->borrowernumber;
 465
 466     # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
 467     # cronjob will use for syncing with NL
 468     if ( exists $data{'borrowernumber'} && C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
 469         warn "C4::Members::AddMember - NorwegianPatronDB hooks will be deprecated as of 18.11.0\n";
 470         Koha::Database->new->schema->resultset('BorrowerSync')->create({
 471             'borrowernumber' => $data{'borrowernumber'},
 472             'synctype'       => 'norwegianpatrondb',
 473             'sync'           => 1,
 474             'syncstatus'     => 'new',
 475             'hashed_pin'     => Koha::NorwegianPatronDB::NLEncryptPIN( $plain_text_password ),
 476         });
 477     }
 478
 479     logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");
 480
 481     $patron->add_enrolment_fee_if_needed;
 482
 483     return $data{borrowernumber};
 484 }
 485
 486 =head2 fixup_cardnumber
 487
 488 Warning: The caller is responsible for locking the members table in write
 489 mode, to avoid database corruption.
 490
 491 =cut
 492
 493 sub fixup_cardnumber {
 494     my ($cardnumber) = @_;
 495     my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0;
 496
 497     # Find out whether member numbers should be generated
 498     # automatically. Should be either "1" or something else.
 499     # Defaults to "0", which is interpreted as "no".
 500
 501     ($autonumber_members) or return $cardnumber;
 502     my $dbh = C4::Context->dbh;
 503
 504     my $sth = $dbh->prepare(
 505         'SELECT MAX( CAST( cardnumber AS SIGNED ) ) FROM borrowers WHERE cardnumber REGEXP "^-?[0-9]+$"'
 506     );
 507     $sth->execute;
 508     my ($result) = $sth->fetchrow;
 509     return $result + 1;
 510 }
 511
 512 =head2 GetAllIssues
 513
 514   $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
 515
 516 Looks up what the patron with the given borrowernumber has borrowed,
 517 and sorts the results.
 518
 519 C<$sortkey> is the name of a field on which to sort the results. This
 520 should be the name of a field in the C<issues>, C<biblio>,
 521 C<biblioitems>, or C<items> table in the Koha database.
 522
 523 C<$limit> is the maximum number of results to return.
 524
 525 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
 526 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
 527 C<items> tables of the Koha database.
 528
 529 =cut
 530
 531 #'
 532 sub GetAllIssues {
 533     my ( $borrowernumber, $order, $limit ) = @_;
 534
 535     return unless $borrowernumber;
 536     $order = 'date_due desc' unless $order;
 537
 538     my $dbh = C4::Context->dbh;
 539     my $query =
 540 'SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
 541   FROM issues
 542   LEFT JOIN items on items.itemnumber=issues.itemnumber
 543   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
 544   LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
 545   WHERE borrowernumber=?
 546   UNION ALL
 547   SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
 548   FROM old_issues
 549   LEFT JOIN items on items.itemnumber=old_issues.itemnumber
 550   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
 551   LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
 552   WHERE borrowernumber=? AND old_issues.itemnumber IS NOT NULL
 553   order by ' . $order;
 554     if ($limit) {
 555         $query .= " limit $limit";
 556     }
 557
 558     my $sth = $dbh->prepare($query);
 559     $sth->execute( $borrowernumber, $borrowernumber );
 560     return $sth->fetchall_arrayref( {} );
 561 }
 562
 563 sub checkcardnumber {
 564     my ( $cardnumber, $borrowernumber ) = @_;
 565
 566     # If cardnumber is null, we assume they're allowed.
 567     return 0 unless defined $cardnumber;
 568
 569     my $dbh = C4::Context->dbh;
 570     my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
 571     $query .= " AND borrowernumber <> ?" if ($borrowernumber);
 572     my $sth = $dbh->prepare($query);
 573     $sth->execute(
 574         $cardnumber,
 575         ( $borrowernumber ? $borrowernumber : () )
 576     );
 577
 578     return 1 if $sth->fetchrow_hashref;
 579
 580     my ( $min_length, $max_length ) = get_cardnumber_length();
 581     return 2
 582         if length $cardnumber > $max_length
 583         or length $cardnumber < $min_length;
 584
 585     return 0;
 586 }
 587
 588 =head2 get_cardnumber_length
 589
 590     my ($min, $max) = C4::Members::get_cardnumber_length()
 591
 592 Returns the minimum and maximum length for patron cardnumbers as
 593 determined by the CardnumberLength system preference, the
 594 BorrowerMandatoryField system preference, and the width of the
 595 database column.
 596
 597 =cut
 598
 599 sub get_cardnumber_length {
 600     my $borrower = Koha::Database->new->schema->resultset('Borrower');
 601     my $field_size = $borrower->result_source->column_info('cardnumber')->{size};
 602     my ( $min, $max ) = ( 0, $field_size ); # borrowers.cardnumber is a nullable varchar(20)
 603     $min = 1 if C4::Context->preference('BorrowerMandatoryField') =~ /cardnumber/;
 604     if ( my $cardnumber_length = C4::Context->preference('CardnumberLength') ) {
 605         # Is integer and length match
 606         if ( $cardnumber_length =~ m|^\d+$| ) {
 607             $min = $max = $cardnumber_length
 608                 if $cardnumber_length >= $min
 609                     and $cardnumber_length <= $max;
 610         }
 611         # Else assuming it is a range
 612         elsif ( $cardnumber_length =~ m|(\d*),(\d*)| ) {
 613             $min = $1 if $1 and $min < $1;
 614             $max = $2 if $2 and $max > $2;
 615         }
 616
 617     }
 618     $min = $max if $min > $max;
 619     return ( $min, $max );
 620 }
 621
 622 =head2 GetBorrowersToExpunge
 623
 624   $borrowers = &GetBorrowersToExpunge(
 625       not_borrowed_since => $not_borrowed_since,
 626       expired_before       => $expired_before,
 627       category_code        => $category_code,
 628       patron_list_id       => $patron_list_id,
 629       branchcode           => $branchcode
 630   );
 631
 632   This function get all borrowers based on the given criteria.
 633
 634 =cut
 635
 636 sub GetBorrowersToExpunge {
 637
 638     my $params = shift;
 639     my $filterdate       = $params->{'not_borrowed_since'};
 640     my $filterexpiry     = $params->{'expired_before'};
 641     my $filterlastseen   = $params->{'last_seen'};
 642     my $filtercategory   = $params->{'category_code'};
 643     my $filterbranch     = $params->{'branchcode'} ||
 644                         ((C4::Context->preference('IndependentBranches')
 645                              && C4::Context->userenv
 646                              && !C4::Context->IsSuperLibrarian()
 647                              && C4::Context->userenv->{branch})
 648                          ? C4::Context->userenv->{branch}
 649                          : "");
 650     my $filterpatronlist = $params->{'patron_list_id'};
 651
 652     my $dbh   = C4::Context->dbh;
 653     my $query = q|
 654         SELECT *
 655         FROM (
 656             SELECT borrowers.borrowernumber,
 657                    MAX(old_issues.timestamp) AS latestissue,
 658                    MAX(issues.timestamp) AS currentissue
 659             FROM   borrowers
 660             JOIN   categories USING (categorycode)
 661             LEFT JOIN (
 662                 SELECT guarantorid
 663                 FROM borrowers
 664                 WHERE guarantorid IS NOT NULL
 665                     AND guarantorid <> 0
 666             ) as tmp ON borrowers.borrowernumber=tmp.guarantorid
 667             LEFT JOIN old_issues USING (borrowernumber)
 668             LEFT JOIN issues USING (borrowernumber)|;
 669     if ( $filterpatronlist  ){
 670         $query .= q| LEFT JOIN patron_list_patrons USING (borrowernumber)|;
 671     }
 672     $query .= q| WHERE  category_type <> 'S'
 673         AND tmp.guarantorid IS NULL
 674     |;
 675     my @query_params;
 676     if ( $filterbranch && $filterbranch ne "" ) {
 677         $query.= " AND borrowers.branchcode = ? ";
 678         push( @query_params, $filterbranch );
 679     }
 680     if ( $filterexpiry ) {
 681         $query .= " AND dateexpiry < ? ";
 682         push( @query_params, $filterexpiry );
 683     }
 684     if ( $filterlastseen ) {
 685         $query .= ' AND lastseen < ? ';
 686         push @query_params, $filterlastseen;
 687     }
 688     if ( $filtercategory ) {
 689         $query .= " AND categorycode = ? ";
 690         push( @query_params, $filtercategory );
 691     }
 692     if ( $filterpatronlist ){
 693         $query.=" AND patron_list_id = ? ";
 694         push( @query_params, $filterpatronlist );
 695     }
 696     $query .= " GROUP BY borrowers.borrowernumber";
 697     $query .= q|
 698         ) xxx WHERE currentissue IS NULL|;
 699     if ( $filterdate ) {
 700         $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
 701         push @query_params,$filterdate;
 702     }
 703
 704     warn $query if $debug;
 705
 706     my $sth = $dbh->prepare($query);
 707     if (scalar(@query_params)>0){
 708         $sth->execute(@query_params);
 709     }
 710     else {
 711         $sth->execute;
 712     }
 713
 714     my @results;
 715     while ( my $data = $sth->fetchrow_hashref ) {
 716         push @results, $data;
 717     }
 718     return \@results;
 719 }
 720
 721 =head2 IssueSlip
 722
 723   IssueSlip($branchcode, $borrowernumber, $quickslip)
 724
 725   Returns letter hash ( see C4::Letters::GetPreparedLetter )
 726
 727   $quickslip is boolean, to indicate whether we want a quick slip
 728
 729   IssueSlip populates ISSUESLIP and ISSUEQSLIP, and will make the following expansions:
 730
 731   Both slips:
 732
 733       <<branches.*>>
 734       <<borrowers.*>>
 735
 736   ISSUESLIP:
 737
 738       <checkedout>
 739          <<biblio.*>>
 740          <<items.*>>
 741          <<biblioitems.*>>
 742          <<issues.*>>
 743       </checkedout>
 744
 745       <overdue>
 746          <<biblio.*>>
 747          <<items.*>>
 748          <<biblioitems.*>>
 749          <<issues.*>>
 750       </overdue>
 751
 752       <news>
 753          <<opac_news.*>>
 754       </news>
 755
 756   ISSUEQSLIP:
 757
 758       <checkedout>
 759          <<biblio.*>>
 760          <<items.*>>
 761          <<biblioitems.*>>
 762          <<issues.*>>
 763       </checkedout>
 764
 765   NOTE: Fields from tables issues, items, biblio and biblioitems are available
 766
 767 =cut
 768
 769 sub IssueSlip {
 770     my ($branch, $borrowernumber, $quickslip) = @_;
 771
 772     # FIXME Check callers before removing this statement
 773     #return unless $borrowernumber;
 774
 775     my $patron = Koha::Patrons->find( $borrowernumber );
 776     return unless $patron;
 777
 778     my $pending_checkouts = $patron->pending_checkouts; # Should be $patron->checkouts->pending?
 779
 780     my ($letter_code, %repeat, %loops);
 781     if ( $quickslip ) {
 782         my $today_start = dt_from_string->set( hour => 0, minute => 0, second => 0 );
 783         my $today_end = dt_from_string->set( hour => 23, minute => 59, second => 0 );
 784         $today_start = Koha::Database->new->schema->storage->datetime_parser->format_datetime( $today_start );
 785         $today_end = Koha::Database->new->schema->storage->datetime_parser->format_datetime( $today_end );
 786         $letter_code = 'ISSUEQSLIP';
 787
 788         # issue date or lastreneweddate is today
 789         my $todays_checkouts = $pending_checkouts->search(
 790             {
 791                 -or => {
 792                     issuedate => {
 793                         '>=' => $today_start,
 794                         '<=' => $today_end,
 795                     },
 796                     lastreneweddate =>
 797                       { '>=' => $today_start, '<=' => $today_end, }
 798                 }
 799             }
 800         );
 801         my @checkouts;
 802         while ( my $c = $todays_checkouts->next ) {
 803             my $all = $c->unblessed_all_relateds;
 804             push @checkouts, {
 805                 biblio      => $all,
 806                 items       => $all,
 807                 biblioitems => $all,
 808                 issues      => $all,
 809             };
 810         }
 811
 812         %repeat =  (
 813             checkedout => \@checkouts, # Historical syntax
 814         );
 815         %loops = (
 816             issues => [ map { $_->{issues}{itemnumber} } @checkouts ], # TT syntax
 817         );
 818     }
 819     else {
 820         my $today = Koha::Database->new->schema->storage->datetime_parser->format_datetime( dt_from_string );
 821         # Checkouts due in the future
 822         my $checkouts = $pending_checkouts->search({ date_due => { '>' => $today } });
 823         my @checkouts; my @overdues;
 824         while ( my $c = $checkouts->next ) {
 825             my $all = $c->unblessed_all_relateds;
 826             push @checkouts, {
 827                 biblio      => $all,
 828                 items       => $all,
 829                 biblioitems => $all,
 830                 issues      => $all,
 831             };
 832         }
 833
 834         # Checkouts due in the past are overdues
 835         my $overdues = $pending_checkouts->search({ date_due => { '<=' => $today } });
 836         while ( my $o = $overdues->next ) {
 837             my $all = $o->unblessed_all_relateds;
 838             push @overdues, {
 839                 biblio      => $all,
 840                 items       => $all,
 841                 biblioitems => $all,
 842                 issues      => $all,
 843             };
 844         }
 845         my $news = GetNewsToDisplay( "slip", $branch );
 846         my @news = map {
 847             $_->{'timestamp'} = $_->{'newdate'};
 848             { opac_news => $_ }
 849         } @$news;
 850         $letter_code = 'ISSUESLIP';
 851         %repeat      = (
 852             checkedout => \@checkouts,
 853             overdue    => \@overdues,
 854             news       => \@news,
 855         );
 856         %loops = (
 857             issues => [ map { $_->{issues}{itemnumber} } @checkouts ],
 858             overdues   => [ map { $_->{issues}{itemnumber} } @overdues ],
 859             opac_news => [ map { $_->{opac_news}{idnew} } @news ],
 860         );
 861     }
 862
 863     return  C4::Letters::GetPreparedLetter (
 864         module => 'circulation',
 865         letter_code => $letter_code,
 866         branchcode => $branch,
 867         lang => $patron->lang,
 868         tables => {
 869             'branches'    => $branch,
 870             'borrowers'   => $borrowernumber,
 871         },
 872         repeat => \%repeat,
 873         loops => \%loops,
 874     );
 875 }
 876
 877 =head2 AddMember_Auto
 878
 879 =cut
 880
 881 sub AddMember_Auto {
 882     my ( %borrower ) = @_;
 883
 884     $borrower{'cardnumber'} ||= fixup_cardnumber();
 885
 886     $borrower{'borrowernumber'} = AddMember(%borrower);
 887
 888     return ( %borrower );
 889 }
 890
 891 =head2 AddMember_Opac
 892
 893 =cut
 894
 895 sub AddMember_Opac {
 896     my ( %borrower ) = @_;
 897
 898     $borrower{'categorycode'} //= C4::Context->preference('PatronSelfRegistrationDefaultCategory');
 899     if (not defined $borrower{'password'}){
 900         my $sr = new String::Random;
 901         $sr->{'A'} = [ 'A'..'Z', 'a'..'z' ];
 902         my $password = $sr->randpattern("AAAAAAAAAA");
 903         $borrower{'password'} = $password;
 904     }
 905
 906     %borrower = AddMember_Auto(%borrower);
 907
 908     return ( $borrower{'borrowernumber'}, $borrower{'password'} );
 909 }
 910
 911 =head2 DeleteExpiredOpacRegistrations
 912
 913     Delete accounts that haven't been upgraded from the 'temporary' category
 914     Returns the number of removed patrons
 915
 916 =cut
 917
 918 sub DeleteExpiredOpacRegistrations {
 919
 920     my $delay = C4::Context->preference('PatronSelfRegistrationExpireTemporaryAccountsDelay');
 921     my $category_code = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
 922
 923     return 0 if not $category_code or not defined $delay or $delay eq q||;
 924
 925     my $query = qq|
 926 SELECT borrowernumber
 927 FROM borrowers
 928 WHERE categorycode = ? AND DATEDIFF( NOW(), dateenrolled ) > ? |;
 929
 930     my $dbh = C4::Context->dbh;
 931     my $sth = $dbh->prepare($query);
 932     $sth->execute( $category_code, $delay );
 933     my $cnt=0;
 934     while ( my ($borrowernumber) = $sth->fetchrow_array() ) {
 935         Koha::Patrons->find($borrowernumber)->delete;
 936         $cnt++;
 937     }
 938     return $cnt;
 939 }
 940
 941 =head2 DeleteUnverifiedOpacRegistrations
 942
 943     Delete all unverified self registrations in borrower_modifications,
 944     older than the specified number of days.
 945
 946 =cut
 947
 948 sub DeleteUnverifiedOpacRegistrations {
 949     my ( $days ) = @_;
 950     my $dbh = C4::Context->dbh;
 951     my $sql=qq|
 952 DELETE FROM borrower_modifications
 953 WHERE borrowernumber = 0 AND DATEDIFF( NOW(), timestamp ) > ?|;
 954     my $cnt=$dbh->do($sql, undef, ($days) );
 955     return $cnt eq '0E0'? 0: $cnt;
 956 }
 957
 958 END { }    # module clean-up code here (global destructor)
 959
 960 1;
 961
 962 __END__
 963
 964 =head1 AUTHOR
 965
 966 Koha Team
 967
 968 =cut