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