C4/Members.pm

   1 package C4::Members;
   2
   3 # Copyright 2000-2003 Katipo Communications
   4 # Copyright 2010 BibLibre
   5 # Parts Copyright 2010 Catalyst IT
   6 #
   7 # This file is part of Koha.
   8 #
   9 # Koha is free software; you can redistribute it and/or modify it
  10 # under the terms of the GNU General Public License as published by
  11 # the Free Software Foundation; either version 3 of the License, or
  12 # (at your option) any later version.
  13 #
  14 # Koha is distributed in the hope that it will be useful, but
  15 # WITHOUT ANY WARRANTY; without even the implied warranty of
  16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  17 # GNU General Public License for more details.
  18 #
  19 # You should have received a copy of the GNU General Public License
  20 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  21
  22
  23 use strict;
  24 #use warnings; FIXME - Bug 2505
  25 use C4::Context;
  26 use String::Random qw( random_string );
  27 use Scalar::Util qw( looks_like_number );
  28 use Date::Calc qw/Today check_date Date_to_Days/;
  29 use List::MoreUtils qw( uniq );
  30 use JSON qw(to_json);
  31 use C4::Log; # logaction
  32 use C4::Overdues;
  33 use C4::Reserves;
  34 use C4::Accounts;
  35 use C4::Biblio;
  36 use C4::Letters;
  37 use C4::Members::Attributes qw(SearchIdMatchingAttribute UpdateBorrowerAttribute);
  38 use C4::NewsChannels; #get slip news
  39 use DateTime;
  40 use Koha::Database;
  41 use Koha::DateUtils;
  42 use Text::Unaccent qw( unac_string );
  43 use Koha::AuthUtils qw(hash_password);
  44 use Koha::Database;
  45 use Koha::Holds;
  46 use Koha::List::Patron;
  47 use Koha::Patrons;
  48 use Koha::Patron::Categories;
  49 use Koha::Schema;
  50
  51 our (@ISA,@EXPORT,@EXPORT_OK,$debug);
  52
  53 use Module::Load::Conditional qw( can_load );
  54 if ( ! can_load( modules => { 'Koha::NorwegianPatronDB' => undef } ) ) {
  55    $debug && warn "Unable to load Koha::NorwegianPatronDB";
  56 }
  57
  58
  59 BEGIN {
  60     $debug = $ENV{DEBUG} || 0;
  61     require Exporter;
  62     @ISA = qw(Exporter);
  63     #Get data
  64     push @EXPORT, qw(
  65
  66         &GetAllIssues
  67
  68         &GetBorrowersToExpunge
  69
  70         &IssueSlip
  71     );
  72
  73     #Modify data
  74     push @EXPORT, qw(
  75         &ModMember
  76         &changepassword
  77     );
  78
  79     #Insert data
  80     push @EXPORT, qw(
  81         &AddMember
  82     &AddMember_Auto
  83         &AddMember_Opac
  84     );
  85
  86     #Check data
  87     push @EXPORT, qw(
  88         &checkuserpassword
  89         &Check_Userid
  90         &Generate_Userid
  91         &fixup_cardnumber
  92         &checkcardnumber
  93     );
  94 }
  95
  96 =head1 NAME
  97
  98 C4::Members - Perl Module containing convenience functions for member handling
  99
 100 =head1 SYNOPSIS
 101
 102 use C4::Members;
 103
 104 =head1 DESCRIPTION
 105
 106 This module contains routines for adding, modifying and deleting members/patrons/borrowers
 107
 108 =head1 FUNCTIONS
 109
 110 =head2 patronflags
 111
 112  $flags = &patronflags($patron);
 113
 114 This function is not exported.
 115
 116 The following will be set where applicable:
 117  $flags->{CHARGES}->{amount}        Amount of debt
 118  $flags->{CHARGES}->{noissues}      Set if debt amount >$5.00 (or syspref noissuescharge)
 119  $flags->{CHARGES}->{message}       Message -- deprecated
 120
 121  $flags->{CREDITS}->{amount}        Amount of credit
 122  $flags->{CREDITS}->{message}       Message -- deprecated
 123
 124  $flags->{  GNA  }                  Patron has no valid address
 125  $flags->{  GNA  }->{noissues}      Set for each GNA
 126  $flags->{  GNA  }->{message}       "Borrower has no valid address" -- deprecated
 127
 128  $flags->{ LOST  }                  Patron's card reported lost
 129  $flags->{ LOST  }->{noissues}      Set for each LOST
 130  $flags->{ LOST  }->{message}       Message -- deprecated
 131
 132  $flags->{DBARRED}                  Set if patron debarred, no access
 133  $flags->{DBARRED}->{noissues}      Set for each DBARRED
 134  $flags->{DBARRED}->{message}       Message -- deprecated
 135
 136  $flags->{ NOTES }
 137  $flags->{ NOTES }->{message}       The note itself.  NOT deprecated
 138
 139  $flags->{ ODUES }                  Set if patron has overdue books.
 140  $flags->{ ODUES }->{message}       "Yes"  -- deprecated
 141  $flags->{ ODUES }->{itemlist}      ref-to-array: list of overdue books
 142  $flags->{ ODUES }->{itemlisttext}  Text list of overdue items -- deprecated
 143
 144  $flags->{WAITING}                  Set if any of patron's reserves are available
 145  $flags->{WAITING}->{message}       Message -- deprecated
 146  $flags->{WAITING}->{itemlist}      ref-to-array: list of available items
 147
 148 =over
 149
 150 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the
 151 overdue items. Its elements are references-to-hash, each describing an
 152 overdue item. The keys are selected fields from the issues, biblio,
 153 biblioitems, and items tables of the Koha database.
 154
 155 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlisttext}> is a string giving a text listing of
 156 the overdue items, one per line.  Deprecated.
 157
 158 =item C<$flags-E<gt>{WAITING}-E<gt>{itemlist}> is a reference-to-array listing the
 159 available items. Each element is a reference-to-hash whose keys are
 160 fields from the reserves table of the Koha database.
 161
 162 =back
 163
 164 All the "message" fields that include language generated in this function are deprecated,
 165 because such strings belong properly in the display layer.
 166
 167 The "message" field that comes from the DB is OK.
 168
 169 =cut
 170
 171 # TODO: use {anonymous => hashes} instead of a dozen %flaginfo
 172 # FIXME rename this function.
 173 # DEPRECATED Do not use this subroutine!
 174 sub patronflags {
 175     my %flags;
 176     my ( $patroninformation) = @_;
 177     my $dbh=C4::Context->dbh;
 178     my $patron = Koha::Patrons->find( $patroninformation->{borrowernumber} );
 179     my $account = $patron->account;
 180     my $owing = $account->non_issues_charges;
 181     if ( $owing > 0 ) {
 182         my %flaginfo;
 183         my $noissuescharge = C4::Context->preference("noissuescharge") || 5;
 184         $flaginfo{'message'} = sprintf 'Patron owes %.02f', $owing;
 185         $flaginfo{'amount'}  = sprintf "%.02f", $owing;
 186         if ( $owing > $noissuescharge && !C4::Context->preference("AllowFineOverride") ) {
 187             $flaginfo{'noissues'} = 1;
 188         }
 189         $flags{'CHARGES'} = \%flaginfo;
 190     }
 191     elsif ( ( my $balance = $account->balance ) < 0 ) {
 192         my %flaginfo;
 193         $flaginfo{'message'} = sprintf 'Patron has credit of %.02f', -$balance;
 194         $flaginfo{'amount'}  = sprintf "%.02f", $balance;
 195         $flags{'CREDITS'} = \%flaginfo;
 196     }
 197
 198     # Check the debt of the guarntees of this patron
 199     my $no_issues_charge_guarantees = C4::Context->preference("NoIssuesChargeGuarantees");
 200     $no_issues_charge_guarantees = undef unless looks_like_number( $no_issues_charge_guarantees );
 201     if ( defined $no_issues_charge_guarantees ) {
 202         my $p = Koha::Patrons->find( $patroninformation->{borrowernumber} );
 203         my @guarantees = $p->guarantees();
 204         my $guarantees_non_issues_charges;
 205         foreach my $g ( @guarantees ) {
 206             $guarantees_non_issues_charges += $g->account->non_issues_charges;
 207         }
 208
 209         if ( $guarantees_non_issues_charges > $no_issues_charge_guarantees ) {
 210             my %flaginfo;
 211             $flaginfo{'message'} = sprintf 'patron guarantees owe %.02f', $guarantees_non_issues_charges;
 212             $flaginfo{'amount'}  = $guarantees_non_issues_charges;
 213             $flaginfo{'noissues'} = 1 unless C4::Context->preference("allowfineoverride");
 214             $flags{'CHARGES_GUARANTEES'} = \%flaginfo;
 215         }
 216     }
 217
 218     if (   $patroninformation->{'gonenoaddress'}
 219         && $patroninformation->{'gonenoaddress'} == 1 )
 220     {
 221         my %flaginfo;
 222         $flaginfo{'message'}  = 'Borrower has no valid address.';
 223         $flaginfo{'noissues'} = 1;
 224         $flags{'GNA'}         = \%flaginfo;
 225     }
 226     if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
 227         my %flaginfo;
 228         $flaginfo{'message'}  = 'Borrower\'s card reported lost.';
 229         $flaginfo{'noissues'} = 1;
 230         $flags{'LOST'}        = \%flaginfo;
 231     }
 232     if ( $patroninformation->{'debarred'} && check_date( split( /-/, $patroninformation->{'debarred'} ) ) ) {
 233         if ( Date_to_Days(Date::Calc::Today) < Date_to_Days( split( /-/, $patroninformation->{'debarred'} ) ) ) {
 234             my %flaginfo;
 235             $flaginfo{'debarredcomment'} = $patroninformation->{'debarredcomment'};
 236             $flaginfo{'message'}         = $patroninformation->{'debarredcomment'};
 237             $flaginfo{'noissues'}        = 1;
 238             $flaginfo{'dateend'}         = $patroninformation->{'debarred'};
 239             $flags{'DBARRED'}           = \%flaginfo;
 240         }
 241     }
 242     if (   $patroninformation->{'borrowernotes'}
 243         && $patroninformation->{'borrowernotes'} )
 244     {
 245         my %flaginfo;
 246         $flaginfo{'message'} = $patroninformation->{'borrowernotes'};
 247         $flags{'NOTES'}      = \%flaginfo;
 248     }
 249     my ( $odues, $itemsoverdue ) = C4::Overdues::checkoverdues($patroninformation->{'borrowernumber'});
 250     if ( $odues && $odues > 0 ) {
 251         my %flaginfo;
 252         $flaginfo{'message'}  = "Yes";
 253         $flaginfo{'itemlist'} = $itemsoverdue;
 254         foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
 255             @$itemsoverdue )
 256         {
 257             $flaginfo{'itemlisttext'} .=
 258               "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n";  # newline is display layer
 259         }
 260         $flags{'ODUES'} = \%flaginfo;
 261     }
 262
 263     my $waiting_holds = $patron->holds->search({ found => 'W' });
 264     my $nowaiting = $waiting_holds->count;
 265     if ( $nowaiting > 0 ) {
 266         my %flaginfo;
 267         $flaginfo{'message'}  = "Reserved items available";
 268         $flaginfo{'itemlist'} = $waiting_holds->unblessed;
 269         $flags{'WAITING'}     = \%flaginfo;
 270     }
 271     return ( \%flags );
 272 }
 273
 274
 275 =head2 ModMember
 276
 277   my $success = ModMember(borrowernumber => $borrowernumber,
 278                                             [ field => value ]... );
 279
 280 Modify borrower's data.  All date fields should ALREADY be in ISO format.
 281
 282 return :
 283 true on success, or false on failure
 284
 285 =cut
 286
 287 sub ModMember {
 288     my (%data) = @_;
 289
 290     # trim whitespace from data which has some non-whitespace in it.
 291     foreach my $field_name (keys(%data)) {
 292         if ( defined $data{$field_name} && $data{$field_name} =~ /\S/ ) {
 293             $data{$field_name} =~ s/^\s*|\s*$//g;
 294         }
 295     }
 296
 297     # test to know if you must update or not the borrower password
 298     if (exists $data{password}) {
 299         if ($data{password} eq '****' or $data{password} eq '') {
 300             delete $data{password};
 301         } else {
 302             if ( C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
 303                 # Update the hashed PIN in borrower_sync.hashed_pin, before Koha hashes it
 304                 Koha::NorwegianPatronDB::NLUpdateHashedPIN( $data{'borrowernumber'}, $data{password} );
 305             }
 306             $data{password} = hash_password($data{password});
 307         }
 308     }
 309
 310     my $old_categorycode = Koha::Patrons->find( $data{borrowernumber} )->categorycode;
 311
 312     # get only the columns of a borrower
 313     my $schema = Koha::Database->new()->schema;
 314     my @columns = $schema->source('Borrower')->columns;
 315     my $new_borrower = { map { join(' ', @columns) =~ /$_/ ? ( $_ => $data{$_} ) : () } keys(%data) };
 316
 317     $new_borrower->{dateofbirth}     ||= undef if exists $new_borrower->{dateofbirth};
 318     $new_borrower->{dateenrolled}    ||= undef if exists $new_borrower->{dateenrolled};
 319     $new_borrower->{dateexpiry}      ||= undef if exists $new_borrower->{dateexpiry};
 320     $new_borrower->{debarred}        ||= undef if exists $new_borrower->{debarred};
 321     $new_borrower->{sms_provider_id} ||= undef if exists $new_borrower->{sms_provider_id};
 322     $new_borrower->{guarantorid}     ||= undef if exists $new_borrower->{guarantorid};
 323
 324     my $patron = Koha::Patrons->find( $new_borrower->{borrowernumber} );
 325
 326     my $borrowers_log = C4::Context->preference("BorrowersLog");
 327     if ( $borrowers_log && $patron->cardnumber ne $new_borrower->{cardnumber} )
 328     {
 329         logaction(
 330             "MEMBERS",
 331             "MODIFY",
 332             $data{'borrowernumber'},
 333             to_json(
 334                 {
 335                     cardnumber_replaced => {
 336                         previous_cardnumber => $patron->cardnumber,
 337                         new_cardnumber      => $new_borrower->{cardnumber},
 338                     }
 339                 },
 340                 { utf8 => 1, pretty => 1 }
 341             )
 342         );
 343     }
 344
 345     delete $new_borrower->{userid} if exists $new_borrower->{userid} and not $new_borrower->{userid};
 346
 347     my $execute_success = $patron->store if $patron->set($new_borrower);
 348
 349     if ($execute_success) { # only proceed if the update was a success
 350         # If the patron changes to a category with enrollment fee, we add a fee
 351         if ( $data{categorycode} and $data{categorycode} ne $old_categorycode ) {
 352             if ( C4::Context->preference('FeeOnChangePatronCategory') ) {
 353                 $patron->add_enrolment_fee_if_needed;
 354             }
 355         }
 356
 357         # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
 358         # cronjob will use for syncing with NL
 359         if ( C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
 360             my $borrowersync = Koha::Database->new->schema->resultset('BorrowerSync')->find({
 361                 'synctype'       => 'norwegianpatrondb',
 362                 'borrowernumber' => $data{'borrowernumber'}
 363             });
 364             # Do not set to "edited" if syncstatus is "new". We need to sync as new before
 365             # we can sync as changed. And the "new sync" will pick up all changes since
 366             # the patron was created anyway.
 367             if ( $borrowersync->syncstatus ne 'new' && $borrowersync->syncstatus ne 'delete' ) {
 368                 $borrowersync->update( { 'syncstatus' => 'edited' } );
 369             }
 370             # Set the value of 'sync'
 371             $borrowersync->update( { 'sync' => $data{'sync'} } );
 372             # Try to do the live sync
 373             Koha::NorwegianPatronDB::NLSync({ 'borrowernumber' => $data{'borrowernumber'} });
 374         }
 375
 376         logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "UPDATE (executed w/ arg: $data{'borrowernumber'})") if $borrowers_log;
 377     }
 378     return $execute_success;
 379 }
 380
 381 =head2 AddMember
 382
 383   $borrowernumber = &AddMember(%borrower);
 384
 385 insert new borrower into table
 386
 387 (%borrower keys are database columns. Database columns could be
 388 different in different versions. Please look into database for correct
 389 column names.)
 390
 391 Returns the borrowernumber upon success
 392
 393 Returns as undef upon any db error without further processing
 394
 395 =cut
 396
 397 #'
 398 sub AddMember {
 399     my (%data) = @_;
 400     my $dbh = C4::Context->dbh;
 401     my $schema = Koha::Database->new()->schema;
 402
 403     my $category = Koha::Patron::Categories->find( $data{categorycode} );
 404     unless ($category) {
 405         Koha::Exceptions::BadParameter->throw(
 406             error => 'Invalid parameter passed',
 407             parameter => 'categorycode'
 408         );
 409     }
 410
 411     # trim whitespace from data which has some non-whitespace in it.
 412     foreach my $field_name (keys(%data)) {
 413         if ( defined $data{$field_name} && $data{$field_name} =~ /\S/ ) {
 414             $data{$field_name} =~ s/^\s*|\s*$//g;
 415         }
 416     }
 417
 418     my $p = Koha::Patron->new( { userid => $data{userid} } );
 419     # generate a proper login if none provided
 420     $data{'userid'} = Generate_Userid( $data{'borrowernumber'}, $data{'firstname'}, $data{'surname'} )
 421       if ( $data{'userid'} eq '' || ! $p->has_valid_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 not unique).
 528
 529 =cut
 530
 531 sub Generate_Userid {
 532   my ($borrowernumber, $firstname, $surname) = @_;
 533   my $newuid;
 534   my $offset = 0;
 535   my $patron = Koha::Patron->new;
 536   #The script will "do" the following code and increment the $offset until the generated userid is 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     $patron->userid( $newuid );
 544     $offset++;
 545    } while (! $patron->has_valid_userid );
 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 GetAllIssues
 577
 578   $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
 579
 580 Looks up what the patron with the given borrowernumber has borrowed,
 581 and sorts the results.
 582
 583 C<$sortkey> is the name of a field on which to sort the results. This
 584 should be the name of a field in the C<issues>, C<biblio>,
 585 C<biblioitems>, or C<items> table in the Koha database.
 586
 587 C<$limit> is the maximum number of results to return.
 588
 589 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
 590 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
 591 C<items> tables of the Koha database.
 592
 593 =cut
 594
 595 #'
 596 sub GetAllIssues {
 597     my ( $borrowernumber, $order, $limit ) = @_;
 598
 599     return unless $borrowernumber;
 600     $order = 'date_due desc' unless $order;
 601
 602     my $dbh = C4::Context->dbh;
 603     my $query =
 604 'SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
 605   FROM issues
 606   LEFT JOIN items on items.itemnumber=issues.itemnumber
 607   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
 608   LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
 609   WHERE borrowernumber=?
 610   UNION ALL
 611   SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
 612   FROM old_issues
 613   LEFT JOIN items on items.itemnumber=old_issues.itemnumber
 614   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
 615   LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
 616   WHERE borrowernumber=? AND old_issues.itemnumber IS NOT NULL
 617   order by ' . $order;
 618     if ($limit) {
 619         $query .= " limit $limit";
 620     }
 621
 622     my $sth = $dbh->prepare($query);
 623     $sth->execute( $borrowernumber, $borrowernumber );
 624     return $sth->fetchall_arrayref( {} );
 625 }
 626
 627 sub checkcardnumber {
 628     my ( $cardnumber, $borrowernumber ) = @_;
 629
 630     # If cardnumber is null, we assume they're allowed.
 631     return 0 unless defined $cardnumber;
 632
 633     my $dbh = C4::Context->dbh;
 634     my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
 635     $query .= " AND borrowernumber <> ?" if ($borrowernumber);
 636     my $sth = $dbh->prepare($query);
 637     $sth->execute(
 638         $cardnumber,
 639         ( $borrowernumber ? $borrowernumber : () )
 640     );
 641
 642     return 1 if $sth->fetchrow_hashref;
 643
 644     my ( $min_length, $max_length ) = get_cardnumber_length();
 645     return 2
 646         if length $cardnumber > $max_length
 647         or length $cardnumber < $min_length;
 648
 649     return 0;
 650 }
 651
 652 =head2 get_cardnumber_length
 653
 654     my ($min, $max) = C4::Members::get_cardnumber_length()
 655
 656 Returns the minimum and maximum length for patron cardnumbers as
 657 determined by the CardnumberLength system preference, the
 658 BorrowerMandatoryField system preference, and the width of the
 659 database column.
 660
 661 =cut
 662
 663 sub get_cardnumber_length {
 664     my $borrower = Koha::Schema->resultset('Borrower');
 665     my $field_size = $borrower->result_source->column_info('cardnumber')->{size};
 666     my ( $min, $max ) = ( 0, $field_size ); # borrowers.cardnumber is a nullable varchar(20)
 667     $min = 1 if C4::Context->preference('BorrowerMandatoryField') =~ /cardnumber/;
 668     if ( my $cardnumber_length = C4::Context->preference('CardnumberLength') ) {
 669         # Is integer and length match
 670         if ( $cardnumber_length =~ m|^\d+$| ) {
 671             $min = $max = $cardnumber_length
 672                 if $cardnumber_length >= $min
 673                     and $cardnumber_length <= $max;
 674         }
 675         # Else assuming it is a range
 676         elsif ( $cardnumber_length =~ m|(\d*),(\d*)| ) {
 677             $min = $1 if $1 and $min < $1;
 678             $max = $2 if $2 and $max > $2;
 679         }
 680
 681     }
 682     $min = $max if $min > $max;
 683     return ( $min, $max );
 684 }
 685
 686 =head2 GetBorrowersToExpunge
 687
 688   $borrowers = &GetBorrowersToExpunge(
 689       not_borrowed_since => $not_borrowed_since,
 690       expired_before       => $expired_before,
 691       category_code        => $category_code,
 692       patron_list_id       => $patron_list_id,
 693       branchcode           => $branchcode
 694   );
 695
 696   This function get all borrowers based on the given criteria.
 697
 698 =cut
 699
 700 sub GetBorrowersToExpunge {
 701
 702     my $params = shift;
 703     my $filterdate       = $params->{'not_borrowed_since'};
 704     my $filterexpiry     = $params->{'expired_before'};
 705     my $filterlastseen   = $params->{'last_seen'};
 706     my $filtercategory   = $params->{'category_code'};
 707     my $filterbranch     = $params->{'branchcode'} ||
 708                         ((C4::Context->preference('IndependentBranches')
 709                              && C4::Context->userenv
 710                              && !C4::Context->IsSuperLibrarian()
 711                              && C4::Context->userenv->{branch})
 712                          ? C4::Context->userenv->{branch}
 713                          : "");
 714     my $filterpatronlist = $params->{'patron_list_id'};
 715
 716     my $dbh   = C4::Context->dbh;
 717     my $query = q|
 718         SELECT *
 719         FROM (
 720             SELECT borrowers.borrowernumber,
 721                    MAX(old_issues.timestamp) AS latestissue,
 722                    MAX(issues.timestamp) AS currentissue
 723             FROM   borrowers
 724             JOIN   categories USING (categorycode)
 725             LEFT JOIN (
 726                 SELECT guarantorid
 727                 FROM borrowers
 728                 WHERE guarantorid IS NOT NULL
 729                     AND guarantorid <> 0
 730             ) as tmp ON borrowers.borrowernumber=tmp.guarantorid
 731             LEFT JOIN old_issues USING (borrowernumber)
 732             LEFT JOIN issues USING (borrowernumber)|;
 733     if ( $filterpatronlist  ){
 734         $query .= q| LEFT JOIN patron_list_patrons USING (borrowernumber)|;
 735     }
 736     $query .= q| WHERE  category_type <> 'S'
 737         AND tmp.guarantorid IS NULL
 738     |;
 739     my @query_params;
 740     if ( $filterbranch && $filterbranch ne "" ) {
 741         $query.= " AND borrowers.branchcode = ? ";
 742         push( @query_params, $filterbranch );
 743     }
 744     if ( $filterexpiry ) {
 745         $query .= " AND dateexpiry < ? ";
 746         push( @query_params, $filterexpiry );
 747     }
 748     if ( $filterlastseen ) {
 749         $query .= ' AND lastseen < ? ';
 750         push @query_params, $filterlastseen;
 751     }
 752     if ( $filtercategory ) {
 753         $query .= " AND categorycode = ? ";
 754         push( @query_params, $filtercategory );
 755     }
 756     if ( $filterpatronlist ){
 757         $query.=" AND patron_list_id = ? ";
 758         push( @query_params, $filterpatronlist );
 759     }
 760     $query .= " GROUP BY borrowers.borrowernumber";
 761     $query .= q|
 762         ) xxx WHERE currentissue IS NULL|;
 763     if ( $filterdate ) {
 764         $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
 765         push @query_params,$filterdate;
 766     }
 767
 768     warn $query if $debug;
 769
 770     my $sth = $dbh->prepare($query);
 771     if (scalar(@query_params)>0){
 772         $sth->execute(@query_params);
 773     }
 774     else {
 775         $sth->execute;
 776     }
 777
 778     my @results;
 779     while ( my $data = $sth->fetchrow_hashref ) {
 780         push @results, $data;
 781     }
 782     return \@results;
 783 }
 784
 785 =head2 IssueSlip
 786
 787   IssueSlip($branchcode, $borrowernumber, $quickslip)
 788
 789   Returns letter hash ( see C4::Letters::GetPreparedLetter )
 790
 791   $quickslip is boolean, to indicate whether we want a quick slip
 792
 793   IssueSlip populates ISSUESLIP and ISSUEQSLIP, and will make the following expansions:
 794
 795   Both slips:
 796
 797       <<branches.*>>
 798       <<borrowers.*>>
 799
 800   ISSUESLIP:
 801
 802       <checkedout>
 803          <<biblio.*>>
 804          <<items.*>>
 805          <<biblioitems.*>>
 806          <<issues.*>>
 807       </checkedout>
 808
 809       <overdue>
 810          <<biblio.*>>
 811          <<items.*>>
 812          <<biblioitems.*>>
 813          <<issues.*>>
 814       </overdue>
 815
 816       <news>
 817          <<opac_news.*>>
 818       </news>
 819
 820   ISSUEQSLIP:
 821
 822       <checkedout>
 823          <<biblio.*>>
 824          <<items.*>>
 825          <<biblioitems.*>>
 826          <<issues.*>>
 827       </checkedout>
 828
 829   NOTE: Fields from tables issues, items, biblio and biblioitems are available
 830
 831 =cut
 832
 833 sub IssueSlip {
 834     my ($branch, $borrowernumber, $quickslip) = @_;
 835
 836     # FIXME Check callers before removing this statement
 837     #return unless $borrowernumber;
 838
 839     my $patron = Koha::Patrons->find( $borrowernumber );
 840     return unless $patron;
 841
 842     my $pending_checkouts = $patron->pending_checkouts; # Should be $patron->checkouts->pending?
 843
 844     my ($letter_code, %repeat, %loops);
 845     if ( $quickslip ) {
 846         my $today_start = dt_from_string->set( hour => 0, minute => 0, second => 0 );
 847         my $today_end = dt_from_string->set( hour => 23, minute => 59, second => 0 );
 848         $today_start = Koha::Database->new->schema->storage->datetime_parser->format_datetime( $today_start );
 849         $today_end = Koha::Database->new->schema->storage->datetime_parser->format_datetime( $today_end );
 850         $letter_code = 'ISSUEQSLIP';
 851
 852         # issue date or lastreneweddate is today
 853         my $todays_checkouts = $pending_checkouts->search(
 854             {
 855                 -or => {
 856                     issuedate => {
 857                         '>=' => $today_start,
 858                         '<=' => $today_end,
 859                     },
 860                     lastreneweddate =>
 861                       { '>=' => $today_start, '<=' => $today_end, }
 862                 }
 863             }
 864         );
 865         my @checkouts;
 866         while ( my $c = $todays_checkouts->next ) {
 867             my $all = $c->unblessed_all_relateds;
 868             push @checkouts, {
 869                 biblio      => $all,
 870                 items       => $all,
 871                 biblioitems => $all,
 872                 issues      => $all,
 873             };
 874         }
 875
 876         %repeat =  (
 877             checkedout => \@checkouts, # Historical syntax
 878         );
 879         %loops = (
 880             issues => [ map { $_->{issues}{itemnumber} } @checkouts ], # TT syntax
 881         );
 882     }
 883     else {
 884         my $today = Koha::Database->new->schema->storage->datetime_parser->format_datetime( dt_from_string );
 885         # Checkouts due in the future
 886         my $checkouts = $pending_checkouts->search({ date_due => { '>' => $today } });
 887         my @checkouts; my @overdues;
 888         while ( my $c = $checkouts->next ) {
 889             my $all = $c->unblessed_all_relateds;
 890             push @checkouts, {
 891                 biblio      => $all,
 892                 items       => $all,
 893                 biblioitems => $all,
 894                 issues      => $all,
 895             };
 896         }
 897
 898         # Checkouts due in the past are overdues
 899         my $overdues = $pending_checkouts->search({ date_due => { '<=' => $today } });
 900         while ( my $o = $overdues->next ) {
 901             my $all = $o->unblessed_all_relateds;
 902             push @overdues, {
 903                 biblio      => $all,
 904                 items       => $all,
 905                 biblioitems => $all,
 906                 issues      => $all,
 907             };
 908         }
 909         my $news = GetNewsToDisplay( "slip", $branch );
 910         my @news = map {
 911             $_->{'timestamp'} = $_->{'newdate'};
 912             { opac_news => $_ }
 913         } @$news;
 914         $letter_code = 'ISSUESLIP';
 915         %repeat      = (
 916             checkedout => \@checkouts,
 917             overdue    => \@overdues,
 918             news       => \@news,
 919         );
 920         %loops = (
 921             issues => [ map { $_->{issues}{itemnumber} } @checkouts ],
 922             overdues   => [ map { $_->{issues}{itemnumber} } @overdues ],
 923             opac_news => [ map { $_->{opac_news}{idnew} } @news ],
 924         );
 925     }
 926
 927     return  C4::Letters::GetPreparedLetter (
 928         module => 'circulation',
 929         letter_code => $letter_code,
 930         branchcode => $branch,
 931         lang => $patron->lang,
 932         tables => {
 933             'branches'    => $branch,
 934             'borrowers'   => $borrowernumber,
 935         },
 936         repeat => \%repeat,
 937         loops => \%loops,
 938     );
 939 }
 940
 941 =head2 AddMember_Auto
 942
 943 =cut
 944
 945 sub AddMember_Auto {
 946     my ( %borrower ) = @_;
 947
 948     $borrower{'cardnumber'} ||= fixup_cardnumber();
 949
 950     $borrower{'borrowernumber'} = AddMember(%borrower);
 951
 952     return ( %borrower );
 953 }
 954
 955 =head2 AddMember_Opac
 956
 957 =cut
 958
 959 sub AddMember_Opac {
 960     my ( %borrower ) = @_;
 961
 962     $borrower{'categorycode'} //= C4::Context->preference('PatronSelfRegistrationDefaultCategory');
 963     if (not defined $borrower{'password'}){
 964         my $sr = new String::Random;
 965         $sr->{'A'} = [ 'A'..'Z', 'a'..'z' ];
 966         my $password = $sr->randpattern("AAAAAAAAAA");
 967         $borrower{'password'} = $password;
 968     }
 969
 970     %borrower = AddMember_Auto(%borrower);
 971
 972     return ( $borrower{'borrowernumber'}, $borrower{'password'} );
 973 }
 974
 975 =head2 DeleteExpiredOpacRegistrations
 976
 977     Delete accounts that haven't been upgraded from the 'temporary' category
 978     Returns the number of removed patrons
 979
 980 =cut
 981
 982 sub DeleteExpiredOpacRegistrations {
 983
 984     my $delay = C4::Context->preference('PatronSelfRegistrationExpireTemporaryAccountsDelay');
 985     my $category_code = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
 986
 987     return 0 if not $category_code or not defined $delay or $delay eq q||;
 988
 989     my $query = qq|
 990 SELECT borrowernumber
 991 FROM borrowers
 992 WHERE categorycode = ? AND DATEDIFF( NOW(), dateenrolled ) > ? |;
 993
 994     my $dbh = C4::Context->dbh;
 995     my $sth = $dbh->prepare($query);
 996     $sth->execute( $category_code, $delay );
 997     my $cnt=0;
 998     while ( my ($borrowernumber) = $sth->fetchrow_array() ) {
 999         Koha::Patrons->find($borrowernumber)->delete;
1000         $cnt++;
1001     }
1002     return $cnt;
1003 }
1004
1005 =head2 DeleteUnverifiedOpacRegistrations
1006
1007     Delete all unverified self registrations in borrower_modifications,
1008     older than the specified number of days.
1009
1010 =cut
1011
1012 sub DeleteUnverifiedOpacRegistrations {
1013     my ( $days ) = @_;
1014     my $dbh = C4::Context->dbh;
1015     my $sql=qq|
1016 DELETE FROM borrower_modifications
1017 WHERE borrowernumber = 0 AND DATEDIFF( NOW(), timestamp ) > ?|;
1018     my $cnt=$dbh->do($sql, undef, ($days) );
1019     return $cnt eq '0E0'? 0: $cnt;
1020 }
1021
1022 END { }    # module clean-up code here (global destructor)
1023
1024 1;
1025
1026 __END__
1027
1028 =head1 AUTHOR
1029
1030 Koha Team
1031
1032 =cut