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     # trim whitespace from data which has some non-whitespace in it.
 409     foreach my $field_name (keys(%data)) {
 410         if ( defined $data{$field_name} && $data{$field_name} =~ /\S/ ) {
 411             $data{$field_name} =~ s/^\s*|\s*$//g;
 412         }
 413     }
 414
 415     my $p = Koha::Patron->new( { userid => $data{userid}, firstname => $data{firstname}, surname => $data{surname} } );
 416     # generate a proper login if none provided
 417     $data{'userid'} = $p->generate_userid
 418       if ( $data{'userid'} eq '' || ! $p->has_valid_userid );
 419
 420     # add expiration date if it isn't already there
 421     $data{dateexpiry} ||= $category->get_expiry_date;
 422
 423     # add enrollment date if it isn't already there
 424     unless ( $data{'dateenrolled'} ) {
 425         $data{'dateenrolled'} = output_pref( { dt => dt_from_string, dateonly => 1, dateformat => 'iso' } );
 426     }
 427
 428     $data{'privacy'} =
 429         $category->default_privacy() eq 'default' ? 1
 430       : $category->default_privacy() eq 'never'   ? 2
 431       : $category->default_privacy() eq 'forever' ? 0
 432       :                                             undef;
 433
 434     $data{'privacy_guarantor_checkouts'} = 0 unless defined( $data{'privacy_guarantor_checkouts'} );
 435
 436     # Make a copy of the plain text password for later use
 437     my $plain_text_password = $data{'password'};
 438
 439     # create a disabled account if no password provided
 440     $data{'password'} = ($data{'password'})? hash_password($data{'password'}) : '!';
 441
 442     # we don't want invalid dates in the db (mysql has a bad habit of inserting 0000-00-00
 443     $data{'dateofbirth'}     = undef if ( not $data{'dateofbirth'} );
 444     $data{'debarred'}        = undef if ( not $data{'debarred'} );
 445     $data{'sms_provider_id'} = undef if ( not $data{'sms_provider_id'} );
 446     $data{'guarantorid'}     = undef if ( not $data{'guarantorid'} );
 447
 448     # get only the columns of Borrower
 449     # FIXME Do we really need this check?
 450     my @columns = $schema->source('Borrower')->columns;
 451     my $new_member = { map { join(' ',@columns) =~ /$_/ ? ( $_ => $data{$_} )  : () } keys(%data) } ;
 452
 453     delete $new_member->{borrowernumber};
 454
 455     my $patron = Koha::Patron->new( $new_member )->store;
 456     $data{borrowernumber} = $patron->borrowernumber;
 457
 458     # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
 459     # cronjob will use for syncing with NL
 460     if ( exists $data{'borrowernumber'} && C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
 461         Koha::Database->new->schema->resultset('BorrowerSync')->create({
 462             'borrowernumber' => $data{'borrowernumber'},
 463             'synctype'       => 'norwegianpatrondb',
 464             'sync'           => 1,
 465             'syncstatus'     => 'new',
 466             'hashed_pin'     => Koha::NorwegianPatronDB::NLEncryptPIN( $plain_text_password ),
 467         });
 468     }
 469
 470     logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");
 471
 472     $patron->add_enrolment_fee_if_needed;
 473
 474     return $data{borrowernumber};
 475 }
 476
 477 =head2 GetAllIssues
 478
 479   $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
 480
 481 Looks up what the patron with the given borrowernumber has borrowed,
 482 and sorts the results.
 483
 484 C<$sortkey> is the name of a field on which to sort the results. This
 485 should be the name of a field in the C<issues>, C<biblio>,
 486 C<biblioitems>, or C<items> table in the Koha database.
 487
 488 C<$limit> is the maximum number of results to return.
 489
 490 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
 491 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
 492 C<items> tables of the Koha database.
 493
 494 =cut
 495
 496 #'
 497 sub GetAllIssues {
 498     my ( $borrowernumber, $order, $limit ) = @_;
 499
 500     return unless $borrowernumber;
 501     $order = 'date_due desc' unless $order;
 502
 503     my $dbh = C4::Context->dbh;
 504     my $query =
 505 'SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
 506   FROM issues
 507   LEFT JOIN items on items.itemnumber=issues.itemnumber
 508   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
 509   LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
 510   WHERE borrowernumber=?
 511   UNION ALL
 512   SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
 513   FROM old_issues
 514   LEFT JOIN items on items.itemnumber=old_issues.itemnumber
 515   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
 516   LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
 517   WHERE borrowernumber=? AND old_issues.itemnumber IS NOT NULL
 518   order by ' . $order;
 519     if ($limit) {
 520         $query .= " limit $limit";
 521     }
 522
 523     my $sth = $dbh->prepare($query);
 524     $sth->execute( $borrowernumber, $borrowernumber );
 525     return $sth->fetchall_arrayref( {} );
 526 }
 527
 528 sub checkcardnumber {
 529     my ( $cardnumber, $borrowernumber ) = @_;
 530
 531     # If cardnumber is null, we assume they're allowed.
 532     return 0 unless defined $cardnumber;
 533
 534     my $dbh = C4::Context->dbh;
 535     my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
 536     $query .= " AND borrowernumber <> ?" if ($borrowernumber);
 537     my $sth = $dbh->prepare($query);
 538     $sth->execute(
 539         $cardnumber,
 540         ( $borrowernumber ? $borrowernumber : () )
 541     );
 542
 543     return 1 if $sth->fetchrow_hashref;
 544
 545     my ( $min_length, $max_length ) = get_cardnumber_length();
 546     return 2
 547         if length $cardnumber > $max_length
 548         or length $cardnumber < $min_length;
 549
 550     return 0;
 551 }
 552
 553 =head2 get_cardnumber_length
 554
 555     my ($min, $max) = C4::Members::get_cardnumber_length()
 556
 557 Returns the minimum and maximum length for patron cardnumbers as
 558 determined by the CardnumberLength system preference, the
 559 BorrowerMandatoryField system preference, and the width of the
 560 database column.
 561
 562 =cut
 563
 564 sub get_cardnumber_length {
 565     my $borrower = Koha::Schema->resultset('Borrower');
 566     my $field_size = $borrower->result_source->column_info('cardnumber')->{size};
 567     my ( $min, $max ) = ( 0, $field_size ); # borrowers.cardnumber is a nullable varchar(20)
 568     $min = 1 if C4::Context->preference('BorrowerMandatoryField') =~ /cardnumber/;
 569     if ( my $cardnumber_length = C4::Context->preference('CardnumberLength') ) {
 570         # Is integer and length match
 571         if ( $cardnumber_length =~ m|^\d+$| ) {
 572             $min = $max = $cardnumber_length
 573                 if $cardnumber_length >= $min
 574                     and $cardnumber_length <= $max;
 575         }
 576         # Else assuming it is a range
 577         elsif ( $cardnumber_length =~ m|(\d*),(\d*)| ) {
 578             $min = $1 if $1 and $min < $1;
 579             $max = $2 if $2 and $max > $2;
 580         }
 581
 582     }
 583     $min = $max if $min > $max;
 584     return ( $min, $max );
 585 }
 586
 587 =head2 GetBorrowersToExpunge
 588
 589   $borrowers = &GetBorrowersToExpunge(
 590       not_borrowed_since => $not_borrowed_since,
 591       expired_before       => $expired_before,
 592       category_code        => $category_code,
 593       patron_list_id       => $patron_list_id,
 594       branchcode           => $branchcode
 595   );
 596
 597   This function get all borrowers based on the given criteria.
 598
 599 =cut
 600
 601 sub GetBorrowersToExpunge {
 602
 603     my $params = shift;
 604     my $filterdate       = $params->{'not_borrowed_since'};
 605     my $filterexpiry     = $params->{'expired_before'};
 606     my $filterlastseen   = $params->{'last_seen'};
 607     my $filtercategory   = $params->{'category_code'};
 608     my $filterbranch     = $params->{'branchcode'} ||
 609                         ((C4::Context->preference('IndependentBranches')
 610                              && C4::Context->userenv
 611                              && !C4::Context->IsSuperLibrarian()
 612                              && C4::Context->userenv->{branch})
 613                          ? C4::Context->userenv->{branch}
 614                          : "");
 615     my $filterpatronlist = $params->{'patron_list_id'};
 616
 617     my $dbh   = C4::Context->dbh;
 618     my $query = q|
 619         SELECT *
 620         FROM (
 621             SELECT borrowers.borrowernumber,
 622                    MAX(old_issues.timestamp) AS latestissue,
 623                    MAX(issues.timestamp) AS currentissue
 624             FROM   borrowers
 625             JOIN   categories USING (categorycode)
 626             LEFT JOIN (
 627                 SELECT guarantorid
 628                 FROM borrowers
 629                 WHERE guarantorid IS NOT NULL
 630                     AND guarantorid <> 0
 631             ) as tmp ON borrowers.borrowernumber=tmp.guarantorid
 632             LEFT JOIN old_issues USING (borrowernumber)
 633             LEFT JOIN issues USING (borrowernumber)|;
 634     if ( $filterpatronlist  ){
 635         $query .= q| LEFT JOIN patron_list_patrons USING (borrowernumber)|;
 636     }
 637     $query .= q| WHERE  category_type <> 'S'
 638         AND tmp.guarantorid IS NULL
 639     |;
 640     my @query_params;
 641     if ( $filterbranch && $filterbranch ne "" ) {
 642         $query.= " AND borrowers.branchcode = ? ";
 643         push( @query_params, $filterbranch );
 644     }
 645     if ( $filterexpiry ) {
 646         $query .= " AND dateexpiry < ? ";
 647         push( @query_params, $filterexpiry );
 648     }
 649     if ( $filterlastseen ) {
 650         $query .= ' AND lastseen < ? ';
 651         push @query_params, $filterlastseen;
 652     }
 653     if ( $filtercategory ) {
 654         $query .= " AND categorycode = ? ";
 655         push( @query_params, $filtercategory );
 656     }
 657     if ( $filterpatronlist ){
 658         $query.=" AND patron_list_id = ? ";
 659         push( @query_params, $filterpatronlist );
 660     }
 661     $query .= " GROUP BY borrowers.borrowernumber";
 662     $query .= q|
 663         ) xxx WHERE currentissue IS NULL|;
 664     if ( $filterdate ) {
 665         $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
 666         push @query_params,$filterdate;
 667     }
 668
 669     warn $query if $debug;
 670
 671     my $sth = $dbh->prepare($query);
 672     if (scalar(@query_params)>0){
 673         $sth->execute(@query_params);
 674     }
 675     else {
 676         $sth->execute;
 677     }
 678
 679     my @results;
 680     while ( my $data = $sth->fetchrow_hashref ) {
 681         push @results, $data;
 682     }
 683     return \@results;
 684 }
 685
 686 =head2 IssueSlip
 687
 688   IssueSlip($branchcode, $borrowernumber, $quickslip)
 689
 690   Returns letter hash ( see C4::Letters::GetPreparedLetter )
 691
 692   $quickslip is boolean, to indicate whether we want a quick slip
 693
 694   IssueSlip populates ISSUESLIP and ISSUEQSLIP, and will make the following expansions:
 695
 696   Both slips:
 697
 698       <<branches.*>>
 699       <<borrowers.*>>
 700
 701   ISSUESLIP:
 702
 703       <checkedout>
 704          <<biblio.*>>
 705          <<items.*>>
 706          <<biblioitems.*>>
 707          <<issues.*>>
 708       </checkedout>
 709
 710       <overdue>
 711          <<biblio.*>>
 712          <<items.*>>
 713          <<biblioitems.*>>
 714          <<issues.*>>
 715       </overdue>
 716
 717       <news>
 718          <<opac_news.*>>
 719       </news>
 720
 721   ISSUEQSLIP:
 722
 723       <checkedout>
 724          <<biblio.*>>
 725          <<items.*>>
 726          <<biblioitems.*>>
 727          <<issues.*>>
 728       </checkedout>
 729
 730   NOTE: Fields from tables issues, items, biblio and biblioitems are available
 731
 732 =cut
 733
 734 sub IssueSlip {
 735     my ($branch, $borrowernumber, $quickslip) = @_;
 736
 737     # FIXME Check callers before removing this statement
 738     #return unless $borrowernumber;
 739
 740     my $patron = Koha::Patrons->find( $borrowernumber );
 741     return unless $patron;
 742
 743     my $pending_checkouts = $patron->pending_checkouts; # Should be $patron->checkouts->pending?
 744
 745     my ($letter_code, %repeat, %loops);
 746     if ( $quickslip ) {
 747         my $today_start = dt_from_string->set( hour => 0, minute => 0, second => 0 );
 748         my $today_end = dt_from_string->set( hour => 23, minute => 59, second => 0 );
 749         $today_start = Koha::Database->new->schema->storage->datetime_parser->format_datetime( $today_start );
 750         $today_end = Koha::Database->new->schema->storage->datetime_parser->format_datetime( $today_end );
 751         $letter_code = 'ISSUEQSLIP';
 752
 753         # issue date or lastreneweddate is today
 754         my $todays_checkouts = $pending_checkouts->search(
 755             {
 756                 -or => {
 757                     issuedate => {
 758                         '>=' => $today_start,
 759                         '<=' => $today_end,
 760                     },
 761                     lastreneweddate =>
 762                       { '>=' => $today_start, '<=' => $today_end, }
 763                 }
 764             }
 765         );
 766         my @checkouts;
 767         while ( my $c = $todays_checkouts->next ) {
 768             my $all = $c->unblessed_all_relateds;
 769             push @checkouts, {
 770                 biblio      => $all,
 771                 items       => $all,
 772                 biblioitems => $all,
 773                 issues      => $all,
 774             };
 775         }
 776
 777         %repeat =  (
 778             checkedout => \@checkouts, # Historical syntax
 779         );
 780         %loops = (
 781             issues => [ map { $_->{issues}{itemnumber} } @checkouts ], # TT syntax
 782         );
 783     }
 784     else {
 785         my $today = Koha::Database->new->schema->storage->datetime_parser->format_datetime( dt_from_string );
 786         # Checkouts due in the future
 787         my $checkouts = $pending_checkouts->search({ date_due => { '>' => $today } });
 788         my @checkouts; my @overdues;
 789         while ( my $c = $checkouts->next ) {
 790             my $all = $c->unblessed_all_relateds;
 791             push @checkouts, {
 792                 biblio      => $all,
 793                 items       => $all,
 794                 biblioitems => $all,
 795                 issues      => $all,
 796             };
 797         }
 798
 799         # Checkouts due in the past are overdues
 800         my $overdues = $pending_checkouts->search({ date_due => { '<=' => $today } });
 801         while ( my $o = $overdues->next ) {
 802             my $all = $o->unblessed_all_relateds;
 803             push @overdues, {
 804                 biblio      => $all,
 805                 items       => $all,
 806                 biblioitems => $all,
 807                 issues      => $all,
 808             };
 809         }
 810         my $news = GetNewsToDisplay( "slip", $branch );
 811         my @news = map {
 812             $_->{'timestamp'} = $_->{'newdate'};
 813             { opac_news => $_ }
 814         } @$news;
 815         $letter_code = 'ISSUESLIP';
 816         %repeat      = (
 817             checkedout => \@checkouts,
 818             overdue    => \@overdues,
 819             news       => \@news,
 820         );
 821         %loops = (
 822             issues => [ map { $_->{issues}{itemnumber} } @checkouts ],
 823             overdues   => [ map { $_->{issues}{itemnumber} } @overdues ],
 824             opac_news => [ map { $_->{opac_news}{idnew} } @news ],
 825         );
 826     }
 827
 828     return  C4::Letters::GetPreparedLetter (
 829         module => 'circulation',
 830         letter_code => $letter_code,
 831         branchcode => $branch,
 832         lang => $patron->lang,
 833         tables => {
 834             'branches'    => $branch,
 835             'borrowers'   => $borrowernumber,
 836         },
 837         repeat => \%repeat,
 838         loops => \%loops,
 839     );
 840 }
 841
 842 =head2 AddMember_Auto
 843
 844 =cut
 845
 846 sub AddMember_Auto {
 847     my ( %borrower ) = @_;
 848
 849     $borrower{'borrowernumber'} = AddMember(%borrower);
 850     my $patron = Koha::Patrons->find( $borrower{borrowernumber} )->unblessed;
 851     $patron->{password} = $borrower{password};
 852     return %$patron;
 853 }
 854
 855 =head2 AddMember_Opac
 856
 857 =cut
 858
 859 sub AddMember_Opac {
 860     my ( %borrower ) = @_;
 861
 862     $borrower{'categorycode'} //= C4::Context->preference('PatronSelfRegistrationDefaultCategory');
 863     if (not defined $borrower{'password'}){
 864         my $sr = new String::Random;
 865         $sr->{'A'} = [ 'A'..'Z', 'a'..'z' ];
 866         my $password = $sr->randpattern("AAAAAAAAAA");
 867         $borrower{'password'} = $password;
 868     }
 869
 870     %borrower = AddMember_Auto(%borrower);
 871
 872     return ( $borrower{'borrowernumber'}, $borrower{'password'} );
 873 }
 874
 875 =head2 DeleteExpiredOpacRegistrations
 876
 877     Delete accounts that haven't been upgraded from the 'temporary' category
 878     Returns the number of removed patrons
 879
 880 =cut
 881
 882 sub DeleteExpiredOpacRegistrations {
 883
 884     my $delay = C4::Context->preference('PatronSelfRegistrationExpireTemporaryAccountsDelay');
 885     my $category_code = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
 886
 887     return 0 if not $category_code or not defined $delay or $delay eq q||;
 888
 889     my $query = qq|
 890 SELECT borrowernumber
 891 FROM borrowers
 892 WHERE categorycode = ? AND DATEDIFF( NOW(), dateenrolled ) > ? |;
 893
 894     my $dbh = C4::Context->dbh;
 895     my $sth = $dbh->prepare($query);
 896     $sth->execute( $category_code, $delay );
 897     my $cnt=0;
 898     while ( my ($borrowernumber) = $sth->fetchrow_array() ) {
 899         Koha::Patrons->find($borrowernumber)->delete;
 900         $cnt++;
 901     }
 902     return $cnt;
 903 }
 904
 905 =head2 DeleteUnverifiedOpacRegistrations
 906
 907     Delete all unverified self registrations in borrower_modifications,
 908     older than the specified number of days.
 909
 910 =cut
 911
 912 sub DeleteUnverifiedOpacRegistrations {
 913     my ( $days ) = @_;
 914     my $dbh = C4::Context->dbh;
 915     my $sql=qq|
 916 DELETE FROM borrower_modifications
 917 WHERE borrowernumber = 0 AND DATEDIFF( NOW(), timestamp ) > ?|;
 918     my $cnt=$dbh->do($sql, undef, ($days) );
 919     return $cnt eq '0E0'? 0: $cnt;
 920 }
 921
 922 END { }    # module clean-up code here (global destructor)
 923
 924 1;
 925
 926 __END__
 927
 928 =head1 AUTHOR
 929
 930 Koha Team
 931
 932 =cut