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