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