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     );
  75
  76     #Insert data
  77     push @EXPORT, qw(
  78         &AddMember
  79     &AddMember_Auto
  80         &AddMember_Opac
  81     );
  82
  83     #Check data
  84     push @EXPORT, qw(
  85         &checkuserpassword
  86         &fixup_cardnumber
  87         &checkcardnumber
  88     );
  89 }
  90
  91 =head1 NAME
  92
  93 C4::Members - Perl Module containing convenience functions for member handling
  94
  95 =head1 SYNOPSIS
  96
  97 use C4::Members;
  98
  99 =head1 DESCRIPTION
 100
 101 This module contains routines for adding, modifying and deleting members/patrons/borrowers
 102
 103 =head1 FUNCTIONS
 104
 105 =head2 patronflags
 106
 107  $flags = &patronflags($patron);
 108
 109 This function is not exported.
 110
 111 The following will be set where applicable:
 112  $flags->{CHARGES}->{amount}        Amount of debt
 113  $flags->{CHARGES}->{noissues}      Set if debt amount >$5.00 (or syspref noissuescharge)
 114  $flags->{CHARGES}->{message}       Message -- deprecated
 115
 116  $flags->{CREDITS}->{amount}        Amount of credit
 117  $flags->{CREDITS}->{message}       Message -- deprecated
 118
 119  $flags->{  GNA  }                  Patron has no valid address
 120  $flags->{  GNA  }->{noissues}      Set for each GNA
 121  $flags->{  GNA  }->{message}       "Borrower has no valid address" -- deprecated
 122
 123  $flags->{ LOST  }                  Patron's card reported lost
 124  $flags->{ LOST  }->{noissues}      Set for each LOST
 125  $flags->{ LOST  }->{message}       Message -- deprecated
 126
 127  $flags->{DBARRED}                  Set if patron debarred, no access
 128  $flags->{DBARRED}->{noissues}      Set for each DBARRED
 129  $flags->{DBARRED}->{message}       Message -- deprecated
 130
 131  $flags->{ NOTES }
 132  $flags->{ NOTES }->{message}       The note itself.  NOT deprecated
 133
 134  $flags->{ ODUES }                  Set if patron has overdue books.
 135  $flags->{ ODUES }->{message}       "Yes"  -- deprecated
 136  $flags->{ ODUES }->{itemlist}      ref-to-array: list of overdue books
 137  $flags->{ ODUES }->{itemlisttext}  Text list of overdue items -- deprecated
 138
 139  $flags->{WAITING}                  Set if any of patron's reserves are available
 140  $flags->{WAITING}->{message}       Message -- deprecated
 141  $flags->{WAITING}->{itemlist}      ref-to-array: list of available items
 142
 143 =over
 144
 145 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the
 146 overdue items. Its elements are references-to-hash, each describing an
 147 overdue item. The keys are selected fields from the issues, biblio,
 148 biblioitems, and items tables of the Koha database.
 149
 150 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlisttext}> is a string giving a text listing of
 151 the overdue items, one per line.  Deprecated.
 152
 153 =item C<$flags-E<gt>{WAITING}-E<gt>{itemlist}> is a reference-to-array listing the
 154 available items. Each element is a reference-to-hash whose keys are
 155 fields from the reserves table of the Koha database.
 156
 157 =back
 158
 159 All the "message" fields that include language generated in this function are deprecated,
 160 because such strings belong properly in the display layer.
 161
 162 The "message" field that comes from the DB is OK.
 163
 164 =cut
 165
 166 # TODO: use {anonymous => hashes} instead of a dozen %flaginfo
 167 # FIXME rename this function.
 168 # DEPRECATED Do not use this subroutine!
 169 sub patronflags {
 170     my %flags;
 171     my ( $patroninformation) = @_;
 172     my $dbh=C4::Context->dbh;
 173     my $patron = Koha::Patrons->find( $patroninformation->{borrowernumber} );
 174     my $account = $patron->account;
 175     my $owing = $account->non_issues_charges;
 176     if ( $owing > 0 ) {
 177         my %flaginfo;
 178         my $noissuescharge = C4::Context->preference("noissuescharge") || 5;
 179         $flaginfo{'message'} = sprintf 'Patron owes %.02f', $owing;
 180         $flaginfo{'amount'}  = sprintf "%.02f", $owing;
 181         if ( $owing > $noissuescharge && !C4::Context->preference("AllowFineOverride") ) {
 182             $flaginfo{'noissues'} = 1;
 183         }
 184         $flags{'CHARGES'} = \%flaginfo;
 185     }
 186     elsif ( ( my $balance = $account->balance ) < 0 ) {
 187         my %flaginfo;
 188         $flaginfo{'message'} = sprintf 'Patron has credit of %.02f', -$balance;
 189         $flaginfo{'amount'}  = sprintf "%.02f", $balance;
 190         $flags{'CREDITS'} = \%flaginfo;
 191     }
 192
 193     # Check the debt of the guarntees of this patron
 194     my $no_issues_charge_guarantees = C4::Context->preference("NoIssuesChargeGuarantees");
 195     $no_issues_charge_guarantees = undef unless looks_like_number( $no_issues_charge_guarantees );
 196     if ( defined $no_issues_charge_guarantees ) {
 197         my $p = Koha::Patrons->find( $patroninformation->{borrowernumber} );
 198         my @guarantees = $p->guarantees();
 199         my $guarantees_non_issues_charges;
 200         foreach my $g ( @guarantees ) {
 201             $guarantees_non_issues_charges += $g->account->non_issues_charges;
 202         }
 203
 204         if ( $guarantees_non_issues_charges > $no_issues_charge_guarantees ) {
 205             my %flaginfo;
 206             $flaginfo{'message'} = sprintf 'patron guarantees owe %.02f', $guarantees_non_issues_charges;
 207             $flaginfo{'amount'}  = $guarantees_non_issues_charges;
 208             $flaginfo{'noissues'} = 1 unless C4::Context->preference("allowfineoverride");
 209             $flags{'CHARGES_GUARANTEES'} = \%flaginfo;
 210         }
 211     }
 212
 213     if (   $patroninformation->{'gonenoaddress'}
 214         && $patroninformation->{'gonenoaddress'} == 1 )
 215     {
 216         my %flaginfo;
 217         $flaginfo{'message'}  = 'Borrower has no valid address.';
 218         $flaginfo{'noissues'} = 1;
 219         $flags{'GNA'}         = \%flaginfo;
 220     }
 221     if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
 222         my %flaginfo;
 223         $flaginfo{'message'}  = 'Borrower\'s card reported lost.';
 224         $flaginfo{'noissues'} = 1;
 225         $flags{'LOST'}        = \%flaginfo;
 226     }
 227     if ( $patroninformation->{'debarred'} && check_date( split( /-/, $patroninformation->{'debarred'} ) ) ) {
 228         if ( Date_to_Days(Date::Calc::Today) < Date_to_Days( split( /-/, $patroninformation->{'debarred'} ) ) ) {
 229             my %flaginfo;
 230             $flaginfo{'debarredcomment'} = $patroninformation->{'debarredcomment'};
 231             $flaginfo{'message'}         = $patroninformation->{'debarredcomment'};
 232             $flaginfo{'noissues'}        = 1;
 233             $flaginfo{'dateend'}         = $patroninformation->{'debarred'};
 234             $flags{'DBARRED'}           = \%flaginfo;
 235         }
 236     }
 237     if (   $patroninformation->{'borrowernotes'}
 238         && $patroninformation->{'borrowernotes'} )
 239     {
 240         my %flaginfo;
 241         $flaginfo{'message'} = $patroninformation->{'borrowernotes'};
 242         $flags{'NOTES'}      = \%flaginfo;
 243     }
 244     my ( $odues, $itemsoverdue ) = C4::Overdues::checkoverdues($patroninformation->{'borrowernumber'});
 245     if ( $odues && $odues > 0 ) {
 246         my %flaginfo;
 247         $flaginfo{'message'}  = "Yes";
 248         $flaginfo{'itemlist'} = $itemsoverdue;
 249         foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
 250             @$itemsoverdue )
 251         {
 252             $flaginfo{'itemlisttext'} .=
 253               "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n";  # newline is display layer
 254         }
 255         $flags{'ODUES'} = \%flaginfo;
 256     }
 257
 258     my $waiting_holds = $patron->holds->search({ found => 'W' });
 259     my $nowaiting = $waiting_holds->count;
 260     if ( $nowaiting > 0 ) {
 261         my %flaginfo;
 262         $flaginfo{'message'}  = "Reserved items available";
 263         $flaginfo{'itemlist'} = $waiting_holds->unblessed;
 264         $flags{'WAITING'}     = \%flaginfo;
 265     }
 266     return ( \%flags );
 267 }
 268
 269
 270 =head2 ModMember
 271
 272   my $success = ModMember(borrowernumber => $borrowernumber,
 273                                             [ field => value ]... );
 274
 275 Modify borrower's data.  All date fields should ALREADY be in ISO format.
 276
 277 return :
 278 true on success, or false on failure
 279
 280 =cut
 281
 282 sub ModMember {
 283     my (%data) = @_;
 284
 285     # trim whitespace from data which has some non-whitespace in it.
 286     foreach my $field_name (keys(%data)) {
 287         if ( defined $data{$field_name} && $data{$field_name} =~ /\S/ ) {
 288             $data{$field_name} =~ s/^\s*|\s*$//g;
 289         }
 290     }
 291
 292     # test to know if you must update or not the borrower password
 293     if (exists $data{password}) {
 294         if ($data{password} eq '****' or $data{password} eq '') {
 295             delete $data{password};
 296         } else {
 297             if ( C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
 298                 warn "C4::Members::ModMember - NorwegianPatronDB hooks will be deprecated as of 18.11.0\n";
 299                 # Update the hashed PIN in borrower_sync.hashed_pin, before Koha hashes it
 300                 Koha::NorwegianPatronDB::NLUpdateHashedPIN( $data{'borrowernumber'}, $data{password} );
 301             }
 302             $data{password} = hash_password($data{password});
 303         }
 304     }
 305
 306     my $old_categorycode = Koha::Patrons->find( $data{borrowernumber} )->categorycode;
 307
 308     # get only the columns of a borrower
 309     my $schema = Koha::Database->new()->schema;
 310     my @columns = $schema->source('Borrower')->columns;
 311     my $new_borrower = { map { join(' ', @columns) =~ /$_/ ? ( $_ => $data{$_} ) : () } keys(%data) };
 312
 313     $new_borrower->{dateofbirth}     ||= undef if exists $new_borrower->{dateofbirth};
 314     $new_borrower->{dateenrolled}    ||= undef if exists $new_borrower->{dateenrolled};
 315     $new_borrower->{dateexpiry}      ||= undef if exists $new_borrower->{dateexpiry};
 316     $new_borrower->{debarred}        ||= undef if exists $new_borrower->{debarred};
 317     $new_borrower->{sms_provider_id} ||= undef if exists $new_borrower->{sms_provider_id};
 318     $new_borrower->{guarantorid}     ||= undef if exists $new_borrower->{guarantorid};
 319
 320     my $patron = Koha::Patrons->find( $new_borrower->{borrowernumber} );
 321
 322     my $borrowers_log = C4::Context->preference("BorrowersLog");
 323     if ( $borrowers_log && $patron->cardnumber ne $new_borrower->{cardnumber} )
 324     {
 325         logaction(
 326             "MEMBERS",
 327             "MODIFY",
 328             $data{'borrowernumber'},
 329             to_json(
 330                 {
 331                     cardnumber_replaced => {
 332                         previous_cardnumber => $patron->cardnumber,
 333                         new_cardnumber      => $new_borrower->{cardnumber},
 334                     }
 335                 },
 336                 { utf8 => 1, pretty => 1 }
 337             )
 338         );
 339     }
 340
 341     delete $new_borrower->{userid} if exists $new_borrower->{userid} and not $new_borrower->{userid};
 342
 343     my $execute_success = $patron->store if $patron->set($new_borrower);
 344
 345     if ($execute_success) { # only proceed if the update was a success
 346         # If the patron changes to a category with enrollment fee, we add a fee
 347         if ( $data{categorycode} and $data{categorycode} ne $old_categorycode ) {
 348             if ( C4::Context->preference('FeeOnChangePatronCategory') ) {
 349                 $patron->add_enrolment_fee_if_needed;
 350             }
 351         }
 352
 353         # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
 354         # cronjob will use for syncing with NL
 355         if ( C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
 356             warn "C4::Members::ModMember - NorwegianPatronDB hooks will be deprecated as of 18.11.0\n";
 357             my $borrowersync = Koha::Database->new->schema->resultset('BorrowerSync')->find({
 358                 'synctype'       => 'norwegianpatrondb',
 359                 'borrowernumber' => $data{'borrowernumber'}
 360             });
 361             # Do not set to "edited" if syncstatus is "new". We need to sync as new before
 362             # we can sync as changed. And the "new sync" will pick up all changes since
 363             # the patron was created anyway.
 364             if ( $borrowersync->syncstatus ne 'new' && $borrowersync->syncstatus ne 'delete' ) {
 365                 $borrowersync->update( { 'syncstatus' => 'edited' } );
 366             }
 367             # Set the value of 'sync'
 368             $borrowersync->update( { 'sync' => $data{'sync'} } );
 369             # Try to do the live sync
 370             Koha::NorwegianPatronDB::NLSync({ 'borrowernumber' => $data{'borrowernumber'} });
 371         }
 372
 373         logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "UPDATE (executed w/ arg: $data{'borrowernumber'})") if $borrowers_log;
 374     }
 375     return $execute_success;
 376 }
 377
 378 =head2 AddMember
 379
 380   $borrowernumber = &AddMember(%borrower);
 381
 382 insert new borrower into table
 383
 384 (%borrower keys are database columns. Database columns could be
 385 different in different versions. Please look into database for correct
 386 column names.)
 387
 388 Returns the borrowernumber upon success
 389
 390 Returns as undef upon any db error without further processing
 391
 392 =cut
 393
 394 #'
 395 sub AddMember {
 396     my (%data) = @_;
 397     my $dbh = C4::Context->dbh;
 398     my $schema = Koha::Database->new()->schema;
 399
 400     my $category = Koha::Patron::Categories->find( $data{categorycode} );
 401     unless ($category) {
 402         Koha::Exceptions::Object::FKConstraint->throw(
 403             broken_fk => 'categorycode',
 404             value     => $data{categorycode},
 405         );
 406     }
 407
 408     # trim whitespace from data which has some non-whitespace in it.
 409     foreach my $field_name (keys(%data)) {
 410         if ( defined $data{$field_name} && $data{$field_name} =~ /\S/ ) {
 411             $data{$field_name} =~ s/^\s*|\s*$//g;
 412         }
 413     }
 414
 415     my $p = Koha::Patron->new( { userid => $data{userid}, firstname => $data{firstname}, surname => $data{surname} } );
 416     # generate a proper login if none provided
 417     $data{'userid'} = $p->generate_userid
 418       if ( $data{'userid'} eq '' || ! $p->has_valid_userid );
 419
 420     # add expiration date if it isn't already there
 421     $data{dateexpiry} ||= $category->get_expiry_date;
 422
 423     # add enrollment date if it isn't already there
 424     unless ( $data{'dateenrolled'} ) {
 425         $data{'dateenrolled'} = output_pref( { dt => dt_from_string, dateonly => 1, dateformat => 'iso' } );
 426     }
 427
 428     if ( C4::Context->preference("autoMemberNum") ) {
 429         if ( not exists $data{cardnumber} or not defined $data{cardnumber} or $data{cardnumber} eq '' ) {
 430             $data{cardnumber} = fixup_cardnumber( $data{cardnumber} );
 431         }
 432     }
 433
 434     $data{'privacy'} =
 435         $category->default_privacy() eq 'default' ? 1
 436       : $category->default_privacy() eq 'never'   ? 2
 437       : $category->default_privacy() eq 'forever' ? 0
 438       :                                             undef;
 439
 440     $data{'privacy_guarantor_checkouts'} = 0 unless defined( $data{'privacy_guarantor_checkouts'} );
 441
 442     # Make a copy of the plain text password for later use
 443     my $plain_text_password = $data{'password'};
 444
 445     # create a disabled account if no password provided
 446     $data{'password'} = ($data{'password'})? hash_password($data{'password'}) : '!';
 447
 448     # we don't want invalid dates in the db (mysql has a bad habit of inserting 0000-00-00
 449     $data{'dateofbirth'}     = undef if ( not $data{'dateofbirth'} );
 450     $data{'debarred'}        = undef if ( not $data{'debarred'} );
 451     $data{'sms_provider_id'} = undef if ( not $data{'sms_provider_id'} );
 452     $data{'guarantorid'}     = undef if ( not $data{'guarantorid'} );
 453
 454     # get only the columns of Borrower
 455     # FIXME Do we really need this check?
 456     my @columns = $schema->source('Borrower')->columns;
 457     my $new_member = { map { join(' ',@columns) =~ /$_/ ? ( $_ => $data{$_} )  : () } keys(%data) } ;
 458
 459     delete $new_member->{borrowernumber};
 460
 461     my $patron = Koha::Patron->new( $new_member )->store;
 462     $data{borrowernumber} = $patron->borrowernumber;
 463
 464     # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
 465     # cronjob will use for syncing with NL
 466     if ( exists $data{'borrowernumber'} && C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
 467         warn "C4::Members::AddMember - NorwegianPatronDB hooks will be deprecated as of 18.11.0\n";
 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::Database->new->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     my $date_enrolled = dt_from_string();
 923     $date_enrolled->subtract( days => $delay );
 924
 925     my $registrations_to_del = Koha::Patrons->search({
 926         dateenrolled => {'<=' => $date_enrolled->ymd},
 927         categorycode => $category_code,
 928     });
 929
 930     my $cnt=0;
 931     while ( my $registration = $registrations_to_del->next() ) {
 932         next if $registration->checkouts->count || $registration->account->balance;
 933         $registration->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