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