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