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