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                 warn "C4::Members::ModMember - NorwegianPatronDB hooks will be deprecated as of 18.11.0\n";
 302                 # Update the hashed PIN in borrower_sync.hashed_pin, before Koha hashes it
 303                 Koha::NorwegianPatronDB::NLUpdateHashedPIN( $data{'borrowernumber'}, $data{password} );
 304             }
 305             $data{password} = hash_password($data{password});
 306         }
 307     }
 308
 309     my $old_categorycode = Koha::Patrons->find( $data{borrowernumber} )->categorycode;
 310
 311     # get only the columns of a borrower
 312     my $schema = Koha::Database->new()->schema;
 313     my @columns = $schema->source('Borrower')->columns;
 314     my $new_borrower = { map { join(' ', @columns) =~ /$_/ ? ( $_ => $data{$_} ) : () } keys(%data) };
 315
 316     $new_borrower->{dateofbirth}     ||= undef if exists $new_borrower->{dateofbirth};
 317     $new_borrower->{dateenrolled}    ||= undef if exists $new_borrower->{dateenrolled};
 318     $new_borrower->{dateexpiry}      ||= undef if exists $new_borrower->{dateexpiry};
 319     $new_borrower->{debarred}        ||= undef if exists $new_borrower->{debarred};
 320     $new_borrower->{sms_provider_id} ||= undef if exists $new_borrower->{sms_provider_id};
 321     $new_borrower->{guarantorid}     ||= undef if exists $new_borrower->{guarantorid};
 322
 323     my $patron = Koha::Patrons->find( $new_borrower->{borrowernumber} );
 324
 325     my $borrowers_log = C4::Context->preference("BorrowersLog");
 326     if ( $borrowers_log && $patron->cardnumber ne $new_borrower->{cardnumber} )
 327     {
 328         logaction(
 329             "MEMBERS",
 330             "MODIFY",
 331             $data{'borrowernumber'},
 332             to_json(
 333                 {
 334                     cardnumber_replaced => {
 335                         previous_cardnumber => $patron->cardnumber,
 336                         new_cardnumber      => $new_borrower->{cardnumber},
 337                     }
 338                 },
 339                 { utf8 => 1, pretty => 1 }
 340             )
 341         );
 342     }
 343
 344     delete $new_borrower->{userid} if exists $new_borrower->{userid} and not $new_borrower->{userid};
 345
 346     my $execute_success = $patron->store if $patron->set($new_borrower);
 347
 348     if ($execute_success) { # only proceed if the update was a success
 349         # If the patron changes to a category with enrollment fee, we add a fee
 350         if ( $data{categorycode} and $data{categorycode} ne $old_categorycode ) {
 351             if ( C4::Context->preference('FeeOnChangePatronCategory') ) {
 352                 $patron->add_enrolment_fee_if_needed;
 353             }
 354         }
 355
 356         # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
 357         # cronjob will use for syncing with NL
 358         if ( C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
 359             warn "C4::Members::ModMember - NorwegianPatronDB hooks will be deprecated as of 18.11.0\n";
 360             my $borrowersync = Koha::Database->new->schema->resultset('BorrowerSync')->find({
 361                 'synctype'       => 'norwegianpatrondb',
 362                 'borrowernumber' => $data{'borrowernumber'}
 363             });
 364             # Do not set to "edited" if syncstatus is "new". We need to sync as new before
 365             # we can sync as changed. And the "new sync" will pick up all changes since
 366             # the patron was created anyway.
 367             if ( $borrowersync->syncstatus ne 'new' && $borrowersync->syncstatus ne 'delete' ) {
 368                 $borrowersync->update( { 'syncstatus' => 'edited' } );
 369             }
 370             # Set the value of 'sync'
 371             $borrowersync->update( { 'sync' => $data{'sync'} } );
 372             # Try to do the live sync
 373             Koha::NorwegianPatronDB::NLSync({ 'borrowernumber' => $data{'borrowernumber'} });
 374         }
 375
 376         logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "UPDATE (executed w/ arg: $data{'borrowernumber'})") if $borrowers_log;
 377     }
 378     return $execute_success;
 379 }
 380
 381 =head2 AddMember
 382
 383   $borrowernumber = &AddMember(%borrower);
 384
 385 insert new borrower into table
 386
 387 (%borrower keys are database columns. Database columns could be
 388 different in different versions. Please look into database for correct
 389 column names.)
 390
 391 Returns the borrowernumber upon success
 392
 393 Returns as undef upon any db error without further processing
 394
 395 =cut
 396
 397 #'
 398 sub AddMember {
 399     my (%data) = @_;
 400     my $dbh = C4::Context->dbh;
 401     my $schema = Koha::Database->new()->schema;
 402
 403     my $category = Koha::Patron::Categories->find( $data{categorycode} );
 404     unless ($category) {
 405         Koha::Exceptions::Object::FKConstraint->throw(
 406             broken_fk => 'categorycode',
 407             value     => $data{categorycode},
 408         );
 409     }
 410
 411     # trim whitespace from data which has some non-whitespace in it.
 412     foreach my $field_name (keys(%data)) {
 413         if ( defined $data{$field_name} && $data{$field_name} =~ /\S/ ) {
 414             $data{$field_name} =~ s/^\s*|\s*$//g;
 415         }
 416     }
 417
 418     my $p = Koha::Patron->new( { userid => $data{userid}, firstname => $data{firstname}, surname => $data{surname} } );
 419     # generate a proper login if none provided
 420     $data{'userid'} = $p->generate_userid
 421       if ( $data{'userid'} eq '' || ! $p->has_valid_userid );
 422
 423     # add expiration date if it isn't already there
 424     $data{dateexpiry} ||= $category->get_expiry_date;
 425
 426     # add enrollment date if it isn't already there
 427     unless ( $data{'dateenrolled'} ) {
 428         $data{'dateenrolled'} = output_pref( { dt => dt_from_string, dateonly => 1, dateformat => 'iso' } );
 429     }
 430
 431     if ( C4::Context->preference("autoMemberNum") ) {
 432         if ( not exists $data{cardnumber} or not defined $data{cardnumber} or $data{cardnumber} eq '' ) {
 433             $data{cardnumber} = fixup_cardnumber( $data{cardnumber} );
 434         }
 435     }
 436
 437     $data{'privacy'} =
 438         $category->default_privacy() eq 'default' ? 1
 439       : $category->default_privacy() eq 'never'   ? 2
 440       : $category->default_privacy() eq 'forever' ? 0
 441       :                                             undef;
 442
 443     $data{'privacy_guarantor_checkouts'} = 0 unless defined( $data{'privacy_guarantor_checkouts'} );
 444
 445     # Make a copy of the plain text password for later use
 446     my $plain_text_password = $data{'password'};
 447
 448     # create a disabled account if no password provided
 449     $data{'password'} = ($data{'password'})? hash_password($data{'password'}) : '!';
 450
 451     # we don't want invalid dates in the db (mysql has a bad habit of inserting 0000-00-00
 452     $data{'dateofbirth'}     = undef if ( not $data{'dateofbirth'} );
 453     $data{'debarred'}        = undef if ( not $data{'debarred'} );
 454     $data{'sms_provider_id'} = undef if ( not $data{'sms_provider_id'} );
 455     $data{'guarantorid'}     = undef if ( not $data{'guarantorid'} );
 456
 457     # get only the columns of Borrower
 458     # FIXME Do we really need this check?
 459     my @columns = $schema->source('Borrower')->columns;
 460     my $new_member = { map { join(' ',@columns) =~ /$_/ ? ( $_ => $data{$_} )  : () } keys(%data) } ;
 461
 462     delete $new_member->{borrowernumber};
 463
 464     my $patron = Koha::Patron->new( $new_member )->store;
 465     $data{borrowernumber} = $patron->borrowernumber;
 466
 467     # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
 468     # cronjob will use for syncing with NL
 469     if ( exists $data{'borrowernumber'} && C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
 470         warn "C4::Members::AddMember - NorwegianPatronDB hooks will be deprecated as of 18.11.0\n";
 471         Koha::Database->new->schema->resultset('BorrowerSync')->create({
 472             'borrowernumber' => $data{'borrowernumber'},
 473             'synctype'       => 'norwegianpatrondb',
 474             'sync'           => 1,
 475             'syncstatus'     => 'new',
 476             'hashed_pin'     => Koha::NorwegianPatronDB::NLEncryptPIN( $plain_text_password ),
 477         });
 478     }
 479
 480     logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");
 481
 482     $patron->add_enrolment_fee_if_needed;
 483
 484     return $data{borrowernumber};
 485 }
 486
 487 =head2 fixup_cardnumber
 488
 489 Warning: The caller is responsible for locking the members table in write
 490 mode, to avoid database corruption.
 491
 492 =cut
 493
 494 sub fixup_cardnumber {
 495     my ($cardnumber) = @_;
 496     my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0;
 497
 498     # Find out whether member numbers should be generated
 499     # automatically. Should be either "1" or something else.
 500     # Defaults to "0", which is interpreted as "no".
 501
 502     ($autonumber_members) or return $cardnumber;
 503     my $dbh = C4::Context->dbh;
 504
 505     my $sth = $dbh->prepare(
 506         'SELECT MAX( CAST( cardnumber AS SIGNED ) ) FROM borrowers WHERE cardnumber REGEXP "^-?[0-9]+$"'
 507     );
 508     $sth->execute;
 509     my ($result) = $sth->fetchrow;
 510     return $result + 1;
 511 }
 512
 513 =head2 GetAllIssues
 514
 515   $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
 516
 517 Looks up what the patron with the given borrowernumber has borrowed,
 518 and sorts the results.
 519
 520 C<$sortkey> is the name of a field on which to sort the results. This
 521 should be the name of a field in the C<issues>, C<biblio>,
 522 C<biblioitems>, or C<items> table in the Koha database.
 523
 524 C<$limit> is the maximum number of results to return.
 525
 526 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
 527 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
 528 C<items> tables of the Koha database.
 529
 530 =cut
 531
 532 #'
 533 sub GetAllIssues {
 534     my ( $borrowernumber, $order, $limit ) = @_;
 535
 536     return unless $borrowernumber;
 537     $order = 'date_due desc' unless $order;
 538
 539     my $dbh = C4::Context->dbh;
 540     my $query =
 541 'SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
 542   FROM issues
 543   LEFT JOIN items on items.itemnumber=issues.itemnumber
 544   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
 545   LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
 546   WHERE borrowernumber=?
 547   UNION ALL
 548   SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
 549   FROM old_issues
 550   LEFT JOIN items on items.itemnumber=old_issues.itemnumber
 551   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
 552   LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
 553   WHERE borrowernumber=? AND old_issues.itemnumber IS NOT NULL
 554   order by ' . $order;
 555     if ($limit) {
 556         $query .= " limit $limit";
 557     }
 558
 559     my $sth = $dbh->prepare($query);
 560     $sth->execute( $borrowernumber, $borrowernumber );
 561     return $sth->fetchall_arrayref( {} );
 562 }
 563
 564 sub checkcardnumber {
 565     my ( $cardnumber, $borrowernumber ) = @_;
 566
 567     # If cardnumber is null, we assume they're allowed.
 568     return 0 unless defined $cardnumber;
 569
 570     my $dbh = C4::Context->dbh;
 571     my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
 572     $query .= " AND borrowernumber <> ?" if ($borrowernumber);
 573     my $sth = $dbh->prepare($query);
 574     $sth->execute(
 575         $cardnumber,
 576         ( $borrowernumber ? $borrowernumber : () )
 577     );
 578
 579     return 1 if $sth->fetchrow_hashref;
 580
 581     my ( $min_length, $max_length ) = get_cardnumber_length();
 582     return 2
 583         if length $cardnumber > $max_length
 584         or length $cardnumber < $min_length;
 585
 586     return 0;
 587 }
 588
 589 =head2 get_cardnumber_length
 590
 591     my ($min, $max) = C4::Members::get_cardnumber_length()
 592
 593 Returns the minimum and maximum length for patron cardnumbers as
 594 determined by the CardnumberLength system preference, the
 595 BorrowerMandatoryField system preference, and the width of the
 596 database column.
 597
 598 =cut
 599
 600 sub get_cardnumber_length {
 601     my $borrower = Koha::Schema->resultset('Borrower');
 602     my $field_size = $borrower->result_source->column_info('cardnumber')->{size};
 603     my ( $min, $max ) = ( 0, $field_size ); # borrowers.cardnumber is a nullable varchar(20)
 604     $min = 1 if C4::Context->preference('BorrowerMandatoryField') =~ /cardnumber/;
 605     if ( my $cardnumber_length = C4::Context->preference('CardnumberLength') ) {
 606         # Is integer and length match
 607         if ( $cardnumber_length =~ m|^\d+$| ) {
 608             $min = $max = $cardnumber_length
 609                 if $cardnumber_length >= $min
 610                     and $cardnumber_length <= $max;
 611         }
 612         # Else assuming it is a range
 613         elsif ( $cardnumber_length =~ m|(\d*),(\d*)| ) {
 614             $min = $1 if $1 and $min < $1;
 615             $max = $2 if $2 and $max > $2;
 616         }
 617
 618     }
 619     $min = $max if $min > $max;
 620     return ( $min, $max );
 621 }
 622
 623 =head2 GetBorrowersToExpunge
 624
 625   $borrowers = &GetBorrowersToExpunge(
 626       not_borrowed_since => $not_borrowed_since,
 627       expired_before       => $expired_before,
 628       category_code        => $category_code,
 629       patron_list_id       => $patron_list_id,
 630       branchcode           => $branchcode
 631   );
 632
 633   This function get all borrowers based on the given criteria.
 634
 635 =cut
 636
 637 sub GetBorrowersToExpunge {
 638
 639     my $params = shift;
 640     my $filterdate       = $params->{'not_borrowed_since'};
 641     my $filterexpiry     = $params->{'expired_before'};
 642     my $filterlastseen   = $params->{'last_seen'};
 643     my $filtercategory   = $params->{'category_code'};
 644     my $filterbranch     = $params->{'branchcode'} ||
 645                         ((C4::Context->preference('IndependentBranches')
 646                              && C4::Context->userenv
 647                              && !C4::Context->IsSuperLibrarian()
 648                              && C4::Context->userenv->{branch})
 649                          ? C4::Context->userenv->{branch}
 650                          : "");
 651     my $filterpatronlist = $params->{'patron_list_id'};
 652
 653     my $dbh   = C4::Context->dbh;
 654     my $query = q|
 655         SELECT *
 656         FROM (
 657             SELECT borrowers.borrowernumber,
 658                    MAX(old_issues.timestamp) AS latestissue,
 659                    MAX(issues.timestamp) AS currentissue
 660             FROM   borrowers
 661             JOIN   categories USING (categorycode)
 662             LEFT JOIN (
 663                 SELECT guarantorid
 664                 FROM borrowers
 665                 WHERE guarantorid IS NOT NULL
 666                     AND guarantorid <> 0
 667             ) as tmp ON borrowers.borrowernumber=tmp.guarantorid
 668             LEFT JOIN old_issues USING (borrowernumber)
 669             LEFT JOIN issues USING (borrowernumber)|;
 670     if ( $filterpatronlist  ){
 671         $query .= q| LEFT JOIN patron_list_patrons USING (borrowernumber)|;
 672     }
 673     $query .= q| WHERE  category_type <> 'S'
 674         AND tmp.guarantorid IS NULL
 675     |;
 676     my @query_params;
 677     if ( $filterbranch && $filterbranch ne "" ) {
 678         $query.= " AND borrowers.branchcode = ? ";
 679         push( @query_params, $filterbranch );
 680     }
 681     if ( $filterexpiry ) {
 682         $query .= " AND dateexpiry < ? ";
 683         push( @query_params, $filterexpiry );
 684     }
 685     if ( $filterlastseen ) {
 686         $query .= ' AND lastseen < ? ';
 687         push @query_params, $filterlastseen;
 688     }
 689     if ( $filtercategory ) {
 690         $query .= " AND categorycode = ? ";
 691         push( @query_params, $filtercategory );
 692     }
 693     if ( $filterpatronlist ){
 694         $query.=" AND patron_list_id = ? ";
 695         push( @query_params, $filterpatronlist );
 696     }
 697     $query .= " GROUP BY borrowers.borrowernumber";
 698     $query .= q|
 699         ) xxx WHERE currentissue IS NULL|;
 700     if ( $filterdate ) {
 701         $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
 702         push @query_params,$filterdate;
 703     }
 704
 705     warn $query if $debug;
 706
 707     my $sth = $dbh->prepare($query);
 708     if (scalar(@query_params)>0){
 709         $sth->execute(@query_params);
 710     }
 711     else {
 712         $sth->execute;
 713     }
 714
 715     my @results;
 716     while ( my $data = $sth->fetchrow_hashref ) {
 717         push @results, $data;
 718     }
 719     return \@results;
 720 }
 721
 722 =head2 IssueSlip
 723
 724   IssueSlip($branchcode, $borrowernumber, $quickslip)
 725
 726   Returns letter hash ( see C4::Letters::GetPreparedLetter )
 727
 728   $quickslip is boolean, to indicate whether we want a quick slip
 729
 730   IssueSlip populates ISSUESLIP and ISSUEQSLIP, and will make the following expansions:
 731
 732   Both slips:
 733
 734       <<branches.*>>
 735       <<borrowers.*>>
 736
 737   ISSUESLIP:
 738
 739       <checkedout>
 740          <<biblio.*>>
 741          <<items.*>>
 742          <<biblioitems.*>>
 743          <<issues.*>>
 744       </checkedout>
 745
 746       <overdue>
 747          <<biblio.*>>
 748          <<items.*>>
 749          <<biblioitems.*>>
 750          <<issues.*>>
 751       </overdue>
 752
 753       <news>
 754          <<opac_news.*>>
 755       </news>
 756
 757   ISSUEQSLIP:
 758
 759       <checkedout>
 760          <<biblio.*>>
 761          <<items.*>>
 762          <<biblioitems.*>>
 763          <<issues.*>>
 764       </checkedout>
 765
 766   NOTE: Fields from tables issues, items, biblio and biblioitems are available
 767
 768 =cut
 769
 770 sub IssueSlip {
 771     my ($branch, $borrowernumber, $quickslip) = @_;
 772
 773     # FIXME Check callers before removing this statement
 774     #return unless $borrowernumber;
 775
 776     my $patron = Koha::Patrons->find( $borrowernumber );
 777     return unless $patron;
 778
 779     my $pending_checkouts = $patron->pending_checkouts; # Should be $patron->checkouts->pending?
 780
 781     my ($letter_code, %repeat, %loops);
 782     if ( $quickslip ) {
 783         my $today_start = dt_from_string->set( hour => 0, minute => 0, second => 0 );
 784         my $today_end = dt_from_string->set( hour => 23, minute => 59, second => 0 );
 785         $today_start = Koha::Database->new->schema->storage->datetime_parser->format_datetime( $today_start );
 786         $today_end = Koha::Database->new->schema->storage->datetime_parser->format_datetime( $today_end );
 787         $letter_code = 'ISSUEQSLIP';
 788
 789         # issue date or lastreneweddate is today
 790         my $todays_checkouts = $pending_checkouts->search(
 791             {
 792                 -or => {
 793                     issuedate => {
 794                         '>=' => $today_start,
 795                         '<=' => $today_end,
 796                     },
 797                     lastreneweddate =>
 798                       { '>=' => $today_start, '<=' => $today_end, }
 799                 }
 800             }
 801         );
 802         my @checkouts;
 803         while ( my $c = $todays_checkouts->next ) {
 804             my $all = $c->unblessed_all_relateds;
 805             push @checkouts, {
 806                 biblio      => $all,
 807                 items       => $all,
 808                 biblioitems => $all,
 809                 issues      => $all,
 810             };
 811         }
 812
 813         %repeat =  (
 814             checkedout => \@checkouts, # Historical syntax
 815         );
 816         %loops = (
 817             issues => [ map { $_->{issues}{itemnumber} } @checkouts ], # TT syntax
 818         );
 819     }
 820     else {
 821         my $today = Koha::Database->new->schema->storage->datetime_parser->format_datetime( dt_from_string );
 822         # Checkouts due in the future
 823         my $checkouts = $pending_checkouts->search({ date_due => { '>' => $today } });
 824         my @checkouts; my @overdues;
 825         while ( my $c = $checkouts->next ) {
 826             my $all = $c->unblessed_all_relateds;
 827             push @checkouts, {
 828                 biblio      => $all,
 829                 items       => $all,
 830                 biblioitems => $all,
 831                 issues      => $all,
 832             };
 833         }
 834
 835         # Checkouts due in the past are overdues
 836         my $overdues = $pending_checkouts->search({ date_due => { '<=' => $today } });
 837         while ( my $o = $overdues->next ) {
 838             my $all = $o->unblessed_all_relateds;
 839             push @overdues, {
 840                 biblio      => $all,
 841                 items       => $all,
 842                 biblioitems => $all,
 843                 issues      => $all,
 844             };
 845         }
 846         my $news = GetNewsToDisplay( "slip", $branch );
 847         my @news = map {
 848             $_->{'timestamp'} = $_->{'newdate'};
 849             { opac_news => $_ }
 850         } @$news;
 851         $letter_code = 'ISSUESLIP';
 852         %repeat      = (
 853             checkedout => \@checkouts,
 854             overdue    => \@overdues,
 855             news       => \@news,
 856         );
 857         %loops = (
 858             issues => [ map { $_->{issues}{itemnumber} } @checkouts ],
 859             overdues   => [ map { $_->{issues}{itemnumber} } @overdues ],
 860             opac_news => [ map { $_->{opac_news}{idnew} } @news ],
 861         );
 862     }
 863
 864     return  C4::Letters::GetPreparedLetter (
 865         module => 'circulation',
 866         letter_code => $letter_code,
 867         branchcode => $branch,
 868         lang => $patron->lang,
 869         tables => {
 870             'branches'    => $branch,
 871             'borrowers'   => $borrowernumber,
 872         },
 873         repeat => \%repeat,
 874         loops => \%loops,
 875     );
 876 }
 877
 878 =head2 AddMember_Auto
 879
 880 =cut
 881
 882 sub AddMember_Auto {
 883     my ( %borrower ) = @_;
 884
 885     $borrower{'cardnumber'} ||= fixup_cardnumber();
 886
 887     $borrower{'borrowernumber'} = AddMember(%borrower);
 888
 889     return ( %borrower );
 890 }
 891
 892 =head2 AddMember_Opac
 893
 894 =cut
 895
 896 sub AddMember_Opac {
 897     my ( %borrower ) = @_;
 898
 899     $borrower{'categorycode'} //= C4::Context->preference('PatronSelfRegistrationDefaultCategory');
 900     if (not defined $borrower{'password'}){
 901         my $sr = new String::Random;
 902         $sr->{'A'} = [ 'A'..'Z', 'a'..'z' ];
 903         my $password = $sr->randpattern("AAAAAAAAAA");
 904         $borrower{'password'} = $password;
 905     }
 906
 907     %borrower = AddMember_Auto(%borrower);
 908
 909     return ( $borrower{'borrowernumber'}, $borrower{'password'} );
 910 }
 911
 912 =head2 DeleteExpiredOpacRegistrations
 913
 914     Delete accounts that haven't been upgraded from the 'temporary' category
 915     Returns the number of removed patrons
 916
 917 =cut
 918
 919 sub DeleteExpiredOpacRegistrations {
 920
 921     my $delay = C4::Context->preference('PatronSelfRegistrationExpireTemporaryAccountsDelay');
 922     my $category_code = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
 923
 924     return 0 if not $category_code or not defined $delay or $delay eq q||;
 925
 926     my $query = qq|
 927 SELECT borrowernumber
 928 FROM borrowers
 929 WHERE categorycode = ? AND DATEDIFF( NOW(), dateenrolled ) > ? |;
 930
 931     my $dbh = C4::Context->dbh;
 932     my $sth = $dbh->prepare($query);
 933     $sth->execute( $category_code, $delay );
 934     my $cnt=0;
 935     while ( my ($borrowernumber) = $sth->fetchrow_array() ) {
 936         Koha::Patrons->find($borrowernumber)->delete;
 937         $cnt++;
 938     }
 939     return $cnt;
 940 }
 941
 942 =head2 DeleteUnverifiedOpacRegistrations
 943
 944     Delete all unverified self registrations in borrower_modifications,
 945     older than the specified number of days.
 946
 947 =cut
 948
 949 sub DeleteUnverifiedOpacRegistrations {
 950     my ( $days ) = @_;
 951     my $dbh = C4::Context->dbh;
 952     my $sql=qq|
 953 DELETE FROM borrower_modifications
 954 WHERE borrowernumber = 0 AND DATEDIFF( NOW(), timestamp ) > ?|;
 955     my $cnt=$dbh->do($sql, undef, ($days) );
 956     return $cnt eq '0E0'? 0: $cnt;
 957 }
 958
 959 END { }    # module clean-up code here (global destructor)
 960
 961 1;
 962
 963 __END__
 964
 965 =head1 AUTHOR
 966
 967 Koha Team
 968
 969 =cut