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 Modern::Perl;
  24 use C4::Context;
  25 use Scalar::Util qw( looks_like_number );
  26 use Date::Calc qw( check_date Date_to_Days );
  27 use C4::Overdues qw( checkoverdues );
  28 use C4::Reserves;
  29 use C4::Accounts;
  30 use C4::Letters qw( GetPreparedLetter );
  31 use DateTime;
  32 use Koha::Database;
  33 use Koha::DateUtils qw( dt_from_string output_pref );
  34 use Koha::Database;
  35 use Koha::Holds;
  36 use Koha::AdditionalContents;
  37 use Koha::Patrons;
  38 use Koha::Patron::Categories;
  39
  40 our (@ISA, @EXPORT_OK);
  41 BEGIN {
  42     require Exporter;
  43     @ISA = qw(Exporter);
  44     @EXPORT_OK = qw(
  45       GetBorrowersToExpunge
  46
  47       IssueSlip
  48
  49       DeleteUnverifiedOpacRegistrations
  50       DeleteExpiredOpacRegistrations
  51     );
  52 }
  53
  54 =head1 NAME
  55
  56 C4::Members - Perl Module containing convenience functions for member handling
  57
  58 =head1 SYNOPSIS
  59
  60 use C4::Members;
  61
  62 =head1 DESCRIPTION
  63
  64 This module contains routines for adding, modifying and deleting members/patrons/borrowers
  65
  66 =head1 FUNCTIONS
  67
  68 =head2 patronflags
  69
  70  $flags = &patronflags($patron);
  71
  72 This function is not exported.
  73
  74 The following will be set where applicable:
  75  $flags->{CHARGES}->{amount}        Amount of debt
  76  $flags->{CHARGES}->{noissues}      Set if debt amount >$5.00 (or syspref noissuescharge)
  77  $flags->{CHARGES}->{message}       Message -- deprecated
  78
  79  $flags->{CREDITS}->{amount}        Amount of credit
  80  $flags->{CREDITS}->{message}       Message -- deprecated
  81
  82  $flags->{  GNA  }                  Patron has no valid address
  83  $flags->{  GNA  }->{noissues}      Set for each GNA
  84  $flags->{  GNA  }->{message}       "Borrower has no valid address" -- deprecated
  85
  86  $flags->{ LOST  }                  Patron's card reported lost
  87  $flags->{ LOST  }->{noissues}      Set for each LOST
  88  $flags->{ LOST  }->{message}       Message -- deprecated
  89
  90  $flags->{DBARRED}                  Set if patron debarred, no access
  91  $flags->{DBARRED}->{noissues}      Set for each DBARRED
  92  $flags->{DBARRED}->{message}       Message -- deprecated
  93
  94  $flags->{ NOTES }
  95  $flags->{ NOTES }->{message}       The note itself.  NOT deprecated
  96
  97  $flags->{ ODUES }                  Set if patron has overdue books.
  98  $flags->{ ODUES }->{message}       "Yes"  -- deprecated
  99  $flags->{ ODUES }->{itemlist}      ref-to-array: list of overdue books
 100  $flags->{ ODUES }->{itemlisttext}  Text list of overdue items -- deprecated
 101
 102  $flags->{WAITING}                  Set if any of patron's reserves are available
 103  $flags->{WAITING}->{message}       Message -- deprecated
 104  $flags->{WAITING}->{itemlist}      ref-to-array: list of available items
 105
 106 =over
 107
 108 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the
 109 overdue items. Its elements are references-to-hash, each describing an
 110 overdue item. The keys are selected fields from the issues, biblio,
 111 biblioitems, and items tables of the Koha database.
 112
 113 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlisttext}> is a string giving a text listing of
 114 the overdue items, one per line.  Deprecated.
 115
 116 =item C<$flags-E<gt>{WAITING}-E<gt>{itemlist}> is a reference-to-array listing the
 117 available items. Each element is a reference-to-hash whose keys are
 118 fields from the reserves table of the Koha database.
 119
 120 =back
 121
 122 All the "message" fields that include language generated in this function are deprecated,
 123 because such strings belong properly in the display layer.
 124
 125 The "message" field that comes from the DB is OK.
 126
 127 =cut
 128
 129 # TODO: use {anonymous => hashes} instead of a dozen %flaginfo
 130 # FIXME rename this function.
 131 # DEPRECATED Do not use this subroutine!
 132 sub patronflags {
 133     my %flags;
 134     my ( $patroninformation) = @_;
 135     my $dbh=C4::Context->dbh;
 136     my $patron = Koha::Patrons->find( $patroninformation->{borrowernumber} );
 137     my $account = $patron->account;
 138     my $owing = $account->non_issues_charges;
 139     if ( $owing > 0 ) {
 140         my %flaginfo;
 141         my $noissuescharge = C4::Context->preference("noissuescharge") || 5;
 142         $flaginfo{'message'} = sprintf 'Patron owes %.02f', $owing;
 143         $flaginfo{'amount'}  = sprintf "%.02f", $owing;
 144         if ( $owing > $noissuescharge && !C4::Context->preference("AllowFineOverride") ) {
 145             $flaginfo{'noissues'} = 1;
 146         }
 147         $flags{'CHARGES'} = \%flaginfo;
 148     }
 149     elsif ( ( my $balance = $account->balance ) < 0 ) {
 150         my %flaginfo;
 151         $flaginfo{'message'} = sprintf 'Patron has credit of %.02f', -$balance;
 152         $flaginfo{'amount'}  = sprintf "%.02f", $balance;
 153         $flags{'CREDITS'} = \%flaginfo;
 154     }
 155
 156     # Check the debt of the guarntees of this patron
 157     my $no_issues_charge_guarantees = C4::Context->preference("NoIssuesChargeGuarantees");
 158     $no_issues_charge_guarantees = undef unless looks_like_number( $no_issues_charge_guarantees );
 159     if ( defined $no_issues_charge_guarantees ) {
 160         my $p = Koha::Patrons->find( $patroninformation->{borrowernumber} );
 161         my @guarantees = map { $_->guarantee } $p->guarantee_relationships->as_list;
 162         my $guarantees_non_issues_charges = 0;
 163         foreach my $g ( @guarantees ) {
 164             $guarantees_non_issues_charges += $g->account->non_issues_charges;
 165         }
 166
 167         if ( $guarantees_non_issues_charges > $no_issues_charge_guarantees ) {
 168             my %flaginfo;
 169             $flaginfo{'message'} = sprintf 'patron guarantees owe %.02f', $guarantees_non_issues_charges;
 170             $flaginfo{'amount'}  = $guarantees_non_issues_charges;
 171             $flaginfo{'noissues'} = 1 unless C4::Context->preference("allowfineoverride");
 172             $flags{'CHARGES_GUARANTEES'} = \%flaginfo;
 173         }
 174     }
 175
 176     if (   $patroninformation->{'gonenoaddress'}
 177         && $patroninformation->{'gonenoaddress'} == 1 )
 178     {
 179         my %flaginfo;
 180         $flaginfo{'message'}  = 'Borrower has no valid address.';
 181         $flaginfo{'noissues'} = 1;
 182         $flags{'GNA'}         = \%flaginfo;
 183     }
 184     if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
 185         my %flaginfo;
 186         $flaginfo{'message'}  = 'Borrower\'s card reported lost.';
 187         $flaginfo{'noissues'} = 1;
 188         $flags{'LOST'}        = \%flaginfo;
 189     }
 190     if ( $patroninformation->{'debarred'} && check_date( split( /-/, $patroninformation->{'debarred'} ) ) ) {
 191         if ( Date_to_Days(Date::Calc::Today) < Date_to_Days( split( /-/, $patroninformation->{'debarred'} ) ) ) {
 192             my %flaginfo;
 193             $flaginfo{'debarredcomment'} = $patroninformation->{'debarredcomment'};
 194             $flaginfo{'message'}         = $patroninformation->{'debarredcomment'};
 195             $flaginfo{'noissues'}        = 1;
 196             $flaginfo{'dateend'}         = $patroninformation->{'debarred'};
 197             $flags{'DBARRED'}           = \%flaginfo;
 198         }
 199     }
 200     if (   $patroninformation->{'borrowernotes'}
 201         && $patroninformation->{'borrowernotes'} )
 202     {
 203         my %flaginfo;
 204         $flaginfo{'message'} = $patroninformation->{'borrowernotes'};
 205         $flags{'NOTES'}      = \%flaginfo;
 206     }
 207     my ( $odues, $itemsoverdue ) = C4::Overdues::checkoverdues($patroninformation->{'borrowernumber'});
 208     if ( $odues && $odues > 0 ) {
 209         my %flaginfo;
 210         $flaginfo{'message'}  = "Yes";
 211         $flaginfo{'itemlist'} = $itemsoverdue;
 212         foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
 213             @$itemsoverdue )
 214         {
 215             $flaginfo{'itemlisttext'} .=
 216               "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n";  # newline is display layer
 217         }
 218         $flags{'ODUES'} = \%flaginfo;
 219     }
 220
 221     my $waiting_holds = $patron->holds->search({ found => 'W' });
 222     my $nowaiting = $waiting_holds->count;
 223     if ( $nowaiting > 0 ) {
 224         my %flaginfo;
 225         $flaginfo{'message'}  = "Reserved items available";
 226         $flaginfo{'itemlist'} = $waiting_holds->unblessed;
 227         $flags{'WAITING'}     = \%flaginfo;
 228     }
 229     return ( \%flags );
 230 }
 231
 232 =head2 GetBorrowersToExpunge
 233
 234   $borrowers = &GetBorrowersToExpunge(
 235       not_borrowed_since => $not_borrowed_since,
 236       expired_before       => $expired_before,
 237       category_code        => \@category_code,
 238       patron_list_id       => $patron_list_id,
 239       branchcode           => $branchcode
 240   );
 241
 242   This function get all borrowers based on the given criteria.
 243
 244 =cut
 245
 246 sub GetBorrowersToExpunge {
 247
 248     my $params = shift;
 249     my $filterdate       = $params->{'not_borrowed_since'};
 250     my $filterexpiry     = $params->{'expired_before'};
 251     my $filterlastseen   = $params->{'last_seen'};
 252     my $filtercategory   = $params->{'category_code'};
 253     my $filterbranch     = $params->{'branchcode'} ||
 254                         ((C4::Context->preference('IndependentBranches')
 255                              && C4::Context->userenv
 256                              && !C4::Context->IsSuperLibrarian()
 257                              && C4::Context->userenv->{branch})
 258                          ? C4::Context->userenv->{branch}
 259                          : "");
 260     my $filterpatronlist = $params->{'patron_list_id'};
 261
 262     my $dbh   = C4::Context->dbh;
 263     my $query = q|
 264         SELECT *
 265         FROM (
 266             SELECT borrowers.borrowernumber,
 267                    MAX(old_issues.timestamp) AS latestissue,
 268                    MAX(issues.timestamp) AS currentissue
 269             FROM   borrowers
 270             JOIN   categories USING (categorycode)
 271             LEFT JOIN (
 272                 SELECT guarantor_id
 273                 FROM borrower_relationships
 274                 WHERE guarantor_id IS NOT NULL
 275                     AND guarantor_id <> 0
 276             ) as tmp ON borrowers.borrowernumber=tmp.guarantor_id
 277             LEFT JOIN old_issues USING (borrowernumber)
 278             LEFT JOIN issues USING (borrowernumber)|;
 279     if ( $filterpatronlist  ){
 280         $query .= q| LEFT JOIN patron_list_patrons USING (borrowernumber)|;
 281     }
 282     $query .= q| WHERE  category_type <> 'S'
 283         AND ( borrowers.flags IS NULL OR borrowers.flags = 0 )
 284         AND tmp.guarantor_id IS NULL
 285     |;
 286     my @query_params;
 287     if ( $filterbranch && $filterbranch ne "" ) {
 288         $query.= " AND borrowers.branchcode = ? ";
 289         push( @query_params, $filterbranch );
 290     }
 291     if ( $filterexpiry ) {
 292         $query .= " AND dateexpiry < ? ";
 293         push( @query_params, $filterexpiry );
 294     }
 295     if ( $filterlastseen ) {
 296         $query .= ' AND lastseen < ? ';
 297         push @query_params, $filterlastseen;
 298     }
 299     if ( $filtercategory ) {
 300         if (ref($filtercategory) ne 'ARRAY' ) {
 301             $filtercategory = [ $filtercategory ];
 302         }
 303         if ( @$filtercategory ) {
 304             $query .= " AND categorycode IN (" . join(',', ('?') x @$filtercategory) . ") ";
 305             push( @query_params, @$filtercategory );
 306         }
 307     }
 308     if ( $filterpatronlist ){
 309         $query.=" AND patron_list_id = ? ";
 310         push( @query_params, $filterpatronlist );
 311     }
 312     $query .= " GROUP BY borrowers.borrowernumber";
 313     $query .= q|
 314         ) xxx WHERE currentissue IS NULL|;
 315     if ( $filterdate ) {
 316         $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
 317         push @query_params,$filterdate;
 318     }
 319
 320     if ( my $anonymous_patron = C4::Context->preference("AnonymousPatron") ) {
 321         $query .= q{ AND borrowernumber != ? };
 322         push( @query_params, $anonymous_patron );
 323     }
 324
 325     my $sth = $dbh->prepare($query);
 326     if (scalar(@query_params)>0){
 327         $sth->execute(@query_params);
 328     }
 329     else {
 330         $sth->execute;
 331     }
 332
 333     my @results;
 334     while ( my $data = $sth->fetchrow_hashref ) {
 335         push @results, $data;
 336     }
 337     return \@results;
 338 }
 339
 340 =head2 IssueSlip
 341
 342   IssueSlip($branchcode, $borrowernumber, $quickslip)
 343
 344   Returns letter hash ( see C4::Letters::GetPreparedLetter )
 345
 346   $quickslip is boolean, to indicate whether we want a quick slip
 347
 348   IssueSlip populates ISSUESLIP and ISSUEQSLIP, and will make the following expansions:
 349
 350   Both slips:
 351
 352       <<branches.*>>
 353       <<borrowers.*>>
 354
 355   ISSUESLIP:
 356
 357       <checkedout>
 358          <<biblio.*>>
 359          <<items.*>>
 360          <<biblioitems.*>>
 361          <<issues.*>>
 362       </checkedout>
 363
 364       <overdue>
 365          <<biblio.*>>
 366          <<items.*>>
 367          <<biblioitems.*>>
 368          <<issues.*>>
 369       </overdue>
 370
 371       <news>
 372          <<additional_contents.*>>
 373       </news>
 374
 375   ISSUEQSLIP:
 376
 377       <checkedout>
 378          <<biblio.*>>
 379          <<items.*>>
 380          <<biblioitems.*>>
 381          <<issues.*>>
 382       </checkedout>
 383
 384   NOTE: Fields from tables issues, items, biblio and biblioitems are available
 385
 386 =cut
 387
 388 sub IssueSlip {
 389     my ($branch, $borrowernumber, $quickslip) = @_;
 390
 391     # FIXME Check callers before removing this statement
 392     #return unless $borrowernumber;
 393
 394     my $patron = Koha::Patrons->find( $borrowernumber );
 395     return unless $patron;
 396
 397     my $pending_checkouts = $patron->pending_checkouts; # Should be $patron->checkouts->pending?
 398
 399     my ($letter_code, %repeat, %loops);
 400     if ( $quickslip ) {
 401         my $today_start = dt_from_string->set( hour => 0, minute => 0, second => 0 );
 402         my $today_end = dt_from_string->set( hour => 23, minute => 59, second => 0 );
 403         $today_start = Koha::Database->new->schema->storage->datetime_parser->format_datetime( $today_start );
 404         $today_end = Koha::Database->new->schema->storage->datetime_parser->format_datetime( $today_end );
 405         $letter_code = 'ISSUEQSLIP';
 406
 407         # issue date or lastreneweddate is today
 408         my $todays_checkouts = $pending_checkouts->search(
 409             {
 410                 -or => {
 411                     issuedate => {
 412                         '>=' => $today_start,
 413                         '<=' => $today_end,
 414                     },
 415                     lastreneweddate =>
 416                       { '>=' => $today_start, '<=' => $today_end, }
 417                 }
 418             }
 419         );
 420         my @checkouts;
 421         while ( my $c = $todays_checkouts->next ) {
 422             my $all = $c->unblessed_all_relateds;
 423             push @checkouts, {
 424                 biblio      => $all,
 425                 items       => $all,
 426                 biblioitems => $all,
 427                 issues      => $all,
 428             };
 429         }
 430
 431         %repeat =  (
 432             checkedout => \@checkouts, # Historical syntax
 433         );
 434         %loops = (
 435             issues => [ map { $_->{issues}{itemnumber} } @checkouts ], # TT syntax
 436         );
 437     }
 438     else {
 439         my $today = Koha::Database->new->schema->storage->datetime_parser->format_datetime( dt_from_string );
 440         # Checkouts due in the future
 441         my $checkouts = $pending_checkouts->search({ date_due => { '>' => $today } });
 442         my @checkouts; my @overdues;
 443         while ( my $c = $checkouts->next ) {
 444             my $all = $c->unblessed_all_relateds;
 445             push @checkouts, {
 446                 biblio      => $all,
 447                 items       => $all,
 448                 biblioitems => $all,
 449                 issues      => $all,
 450             };
 451         }
 452
 453         # Checkouts due in the past are overdues
 454         my $overdues = $pending_checkouts->search({ date_due => { '<=' => $today } });
 455         while ( my $o = $overdues->next ) {
 456             my $all = $o->unblessed_all_relateds;
 457             push @overdues, {
 458                 biblio      => $all,
 459                 items       => $all,
 460                 biblioitems => $all,
 461                 issues      => $all,
 462             };
 463         }
 464         my $news = Koha::AdditionalContents->search_for_display(
 465             {
 466                 category   => 'news',
 467                 location   => 'slip',
 468                 lang       => $patron->lang,
 469                 library_id => $branch,
 470             }
 471         );
 472         my @news;
 473         while ( my $n = $news->next ) {
 474             my $all = $n->unblessed_all_relateds;
 475
 476             # FIXME We keep newdate and timestamp for backward compatibility (from GetNewsToDisplay)
 477             # But we should remove them and adjust the existing templates in a db rev
 478             # FIXME This must be formatted in the notice template
 479             my $published_on_dt = output_pref({ dt => dt_from_string( $all->{published_on} ), dateonly => 1 });
 480             $all->{newdate} = $published_on_dt;
 481             $all->{timestamp} = $published_on_dt;
 482
 483             push @news, {
 484                 additional_contents => $all,
 485             };
 486         }
 487         $letter_code = 'ISSUESLIP';
 488         %repeat      = (
 489             checkedout => \@checkouts,
 490             overdue    => \@overdues,
 491             news       => \@news,
 492         );
 493         %loops = (
 494             issues => [ map { $_->{issues}{itemnumber} } @checkouts ],
 495             overdues   => [ map { $_->{issues}{itemnumber} } @overdues ],
 496             opac_news => [ map { $_->{additional_contents}{idnew} } @news ],
 497             additional_contents => [ map { $_->{additional_contents}{idnew} } @news ],
 498         );
 499     }
 500
 501     return  C4::Letters::GetPreparedLetter (
 502         module => 'circulation',
 503         letter_code => $letter_code,
 504         branchcode => $branch,
 505         lang => $patron->lang,
 506         tables => {
 507             'branches'    => $branch,
 508             'borrowers'   => $borrowernumber,
 509         },
 510         repeat => \%repeat,
 511         loops => \%loops,
 512     );
 513 }
 514
 515 =head2 DeleteExpiredOpacRegistrations
 516
 517     Delete accounts that haven't been upgraded from the 'temporary' category
 518     Returns the number of removed patrons
 519
 520 =cut
 521
 522 sub DeleteExpiredOpacRegistrations {
 523
 524     my $delay = C4::Context->preference('PatronSelfRegistrationExpireTemporaryAccountsDelay');
 525     my $category_code = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
 526
 527     return 0 unless $category_code && $delay;
 528         # DO NOT REMOVE test on delay here!
 529         # Some libraries may not use a temporary category, but want to keep patrons.
 530         # We should not delete patrons when the value is NULL, empty string or 0.
 531
 532     my $date_enrolled = dt_from_string();
 533     $date_enrolled->subtract( days => $delay );
 534
 535     my $registrations_to_del = Koha::Patrons->search({
 536         dateenrolled => {'<=' => $date_enrolled->ymd},
 537         categorycode => $category_code,
 538     });
 539
 540     my $cnt=0;
 541     while ( my $registration = $registrations_to_del->next() ) {
 542         next if $registration->checkouts->count || $registration->account->balance;
 543         $registration->delete;
 544         $cnt++;
 545     }
 546     return $cnt;
 547 }
 548
 549 =head2 DeleteUnverifiedOpacRegistrations
 550
 551     Delete all unverified self registrations in borrower_modifications,
 552     older than the specified number of days.
 553
 554 =cut
 555
 556 sub DeleteUnverifiedOpacRegistrations {
 557     my ( $days ) = @_;
 558     my $dbh = C4::Context->dbh;
 559     my $sql=qq|
 560 DELETE FROM borrower_modifications
 561 WHERE borrowernumber = 0 AND DATEDIFF( NOW(), timestamp ) > ?|;
 562     my $cnt=$dbh->do($sql, undef, ($days) );
 563     return $cnt eq '0E0'? 0: $cnt;
 564 }
 565
 566 END { }    # module clean-up code here (global destructor)
 567
 568 1;
 569
 570 __END__
 571
 572 =head1 AUTHOR
 573
 574 Koha Team
 575
 576 =cut