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