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