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