3 # Copyright 2000-2003 Katipo Communications
4 # Copyright 2010 BibLibre
5 # Parts Copyright 2010 Catalyst IT
7 # This file is part of Koha.
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.
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.
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>.
24 #use warnings; FIXME - Bug 2505
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 );
31 use C4::Log; # logaction
37 use C4::Members::Attributes qw(SearchIdMatchingAttribute UpdateBorrowerAttribute);
38 use C4::NewsChannels; #get slip news
42 use Koha::AuthUtils qw(hash_password);
45 use Koha::List::Patron;
47 use Koha::Patron::Categories;
49 our (@ISA,@EXPORT,@EXPORT_OK,$debug);
51 use Module::Load::Conditional qw( can_load );
52 if ( ! can_load( modules => { 'Koha::NorwegianPatronDB' => undef } ) ) {
53 $debug && warn "Unable to load Koha::NorwegianPatronDB";
58 $debug = $ENV{DEBUG} || 0;
66 &GetBorrowersToExpunge
93 C4::Members - Perl Module containing convenience functions for member handling
101 This module contains routines for adding, modifying and deleting members/patrons/borrowers
107 $flags = &patronflags($patron);
109 This function is not exported.
111 The following will be set where applicable:
112 $flags->{CHARGES}->{amount} Amount of debt
113 $flags->{CHARGES}->{noissues} Set if debt amount >$5.00 (or syspref noissuescharge)
114 $flags->{CHARGES}->{message} Message -- deprecated
116 $flags->{CREDITS}->{amount} Amount of credit
117 $flags->{CREDITS}->{message} Message -- deprecated
119 $flags->{ GNA } Patron has no valid address
120 $flags->{ GNA }->{noissues} Set for each GNA
121 $flags->{ GNA }->{message} "Borrower has no valid address" -- deprecated
123 $flags->{ LOST } Patron's card reported lost
124 $flags->{ LOST }->{noissues} Set for each LOST
125 $flags->{ LOST }->{message} Message -- deprecated
127 $flags->{DBARRED} Set if patron debarred, no access
128 $flags->{DBARRED}->{noissues} Set for each DBARRED
129 $flags->{DBARRED}->{message} Message -- deprecated
132 $flags->{ NOTES }->{message} The note itself. NOT deprecated
134 $flags->{ ODUES } Set if patron has overdue books.
135 $flags->{ ODUES }->{message} "Yes" -- deprecated
136 $flags->{ ODUES }->{itemlist} ref-to-array: list of overdue books
137 $flags->{ ODUES }->{itemlisttext} Text list of overdue items -- deprecated
139 $flags->{WAITING} Set if any of patron's reserves are available
140 $flags->{WAITING}->{message} Message -- deprecated
141 $flags->{WAITING}->{itemlist} ref-to-array: list of available items
145 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the
146 overdue items. Its elements are references-to-hash, each describing an
147 overdue item. The keys are selected fields from the issues, biblio,
148 biblioitems, and items tables of the Koha database.
150 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlisttext}> is a string giving a text listing of
151 the overdue items, one per line. Deprecated.
153 =item C<$flags-E<gt>{WAITING}-E<gt>{itemlist}> is a reference-to-array listing the
154 available items. Each element is a reference-to-hash whose keys are
155 fields from the reserves table of the Koha database.
159 All the "message" fields that include language generated in this function are deprecated,
160 because such strings belong properly in the display layer.
162 The "message" field that comes from the DB is OK.
166 # TODO: use {anonymous => hashes} instead of a dozen %flaginfo
167 # FIXME rename this function.
168 # DEPRECATED Do not use this subroutine!
171 my ( $patroninformation) = @_;
172 my $dbh=C4::Context->dbh;
173 my $patron = Koha::Patrons->find( $patroninformation->{borrowernumber} );
174 my $account = $patron->account;
175 my $owing = $account->non_issues_charges;
178 my $noissuescharge = C4::Context->preference("noissuescharge") || 5;
179 $flaginfo{'message'} = sprintf 'Patron owes %.02f', $owing;
180 $flaginfo{'amount'} = sprintf "%.02f", $owing;
181 if ( $owing > $noissuescharge && !C4::Context->preference("AllowFineOverride") ) {
182 $flaginfo{'noissues'} = 1;
184 $flags{'CHARGES'} = \%flaginfo;
186 elsif ( ( my $balance = $account->balance ) < 0 ) {
188 $flaginfo{'message'} = sprintf 'Patron has credit of %.02f', -$balance;
189 $flaginfo{'amount'} = sprintf "%.02f", $balance;
190 $flags{'CREDITS'} = \%flaginfo;
193 # Check the debt of the guarntees of this patron
194 my $no_issues_charge_guarantees = C4::Context->preference("NoIssuesChargeGuarantees");
195 $no_issues_charge_guarantees = undef unless looks_like_number( $no_issues_charge_guarantees );
196 if ( defined $no_issues_charge_guarantees ) {
197 my $p = Koha::Patrons->find( $patroninformation->{borrowernumber} );
198 my @guarantees = $p->guarantees();
199 my $guarantees_non_issues_charges;
200 foreach my $g ( @guarantees ) {
201 $guarantees_non_issues_charges += $g->account->non_issues_charges;
204 if ( $guarantees_non_issues_charges > $no_issues_charge_guarantees ) {
206 $flaginfo{'message'} = sprintf 'patron guarantees owe %.02f', $guarantees_non_issues_charges;
207 $flaginfo{'amount'} = $guarantees_non_issues_charges;
208 $flaginfo{'noissues'} = 1 unless C4::Context->preference("allowfineoverride");
209 $flags{'CHARGES_GUARANTEES'} = \%flaginfo;
213 if ( $patroninformation->{'gonenoaddress'}
214 && $patroninformation->{'gonenoaddress'} == 1 )
217 $flaginfo{'message'} = 'Borrower has no valid address.';
218 $flaginfo{'noissues'} = 1;
219 $flags{'GNA'} = \%flaginfo;
221 if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
223 $flaginfo{'message'} = 'Borrower\'s card reported lost.';
224 $flaginfo{'noissues'} = 1;
225 $flags{'LOST'} = \%flaginfo;
227 if ( $patroninformation->{'debarred'} && check_date( split( /-/, $patroninformation->{'debarred'} ) ) ) {
228 if ( Date_to_Days(Date::Calc::Today) < Date_to_Days( split( /-/, $patroninformation->{'debarred'} ) ) ) {
230 $flaginfo{'debarredcomment'} = $patroninformation->{'debarredcomment'};
231 $flaginfo{'message'} = $patroninformation->{'debarredcomment'};
232 $flaginfo{'noissues'} = 1;
233 $flaginfo{'dateend'} = $patroninformation->{'debarred'};
234 $flags{'DBARRED'} = \%flaginfo;
237 if ( $patroninformation->{'borrowernotes'}
238 && $patroninformation->{'borrowernotes'} )
241 $flaginfo{'message'} = $patroninformation->{'borrowernotes'};
242 $flags{'NOTES'} = \%flaginfo;
244 my ( $odues, $itemsoverdue ) = C4::Overdues::checkoverdues($patroninformation->{'borrowernumber'});
245 if ( $odues && $odues > 0 ) {
247 $flaginfo{'message'} = "Yes";
248 $flaginfo{'itemlist'} = $itemsoverdue;
249 foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
252 $flaginfo{'itemlisttext'} .=
253 "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n"; # newline is display layer
255 $flags{'ODUES'} = \%flaginfo;
258 my $waiting_holds = $patron->holds->search({ found => 'W' });
259 my $nowaiting = $waiting_holds->count;
260 if ( $nowaiting > 0 ) {
262 $flaginfo{'message'} = "Reserved items available";
263 $flaginfo{'itemlist'} = $waiting_holds->unblessed;
264 $flags{'WAITING'} = \%flaginfo;
272 my $success = ModMember(borrowernumber => $borrowernumber,
273 [ field => value ]... );
275 Modify borrower's data. All date fields should ALREADY be in ISO format.
278 true on success, or false on failure
285 # trim whitespace from data which has some non-whitespace in it.
286 foreach my $field_name (keys(%data)) {
287 if ( defined $data{$field_name} && $data{$field_name} =~ /\S/ ) {
288 $data{$field_name} =~ s/^\s*|\s*$//g;
292 # test to know if you must update or not the borrower password
293 if (exists $data{password}) {
294 if ($data{password} eq '****' or $data{password} eq '') {
295 delete $data{password};
297 if ( C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
298 warn "C4::Members::ModMember - NorwegianPatronDB hooks will be deprecated as of 18.11.0\n";
299 # Update the hashed PIN in borrower_sync.hashed_pin, before Koha hashes it
300 Koha::NorwegianPatronDB::NLUpdateHashedPIN( $data{'borrowernumber'}, $data{password} );
302 $data{password} = hash_password($data{password});
306 my $old_categorycode = Koha::Patrons->find( $data{borrowernumber} )->categorycode;
308 # get only the columns of a borrower
309 my $schema = Koha::Database->new()->schema;
310 my @columns = $schema->source('Borrower')->columns;
311 my $new_borrower = { map { join(' ', @columns) =~ /$_/ ? ( $_ => $data{$_} ) : () } keys(%data) };
313 $new_borrower->{dateofbirth} ||= undef if exists $new_borrower->{dateofbirth};
314 $new_borrower->{dateenrolled} ||= undef if exists $new_borrower->{dateenrolled};
315 $new_borrower->{dateexpiry} ||= undef if exists $new_borrower->{dateexpiry};
316 $new_borrower->{debarred} ||= undef if exists $new_borrower->{debarred};
317 $new_borrower->{sms_provider_id} ||= undef if exists $new_borrower->{sms_provider_id};
318 $new_borrower->{guarantorid} ||= undef if exists $new_borrower->{guarantorid};
320 my $patron = Koha::Patrons->find( $new_borrower->{borrowernumber} );
322 my $borrowers_log = C4::Context->preference("BorrowersLog");
323 if ( $borrowers_log && $patron->cardnumber ne $new_borrower->{cardnumber} )
328 $data{'borrowernumber'},
331 cardnumber_replaced => {
332 previous_cardnumber => $patron->cardnumber,
333 new_cardnumber => $new_borrower->{cardnumber},
336 { utf8 => 1, pretty => 1 }
341 delete $new_borrower->{userid} if exists $new_borrower->{userid} and not $new_borrower->{userid};
343 my $execute_success = $patron->store if $patron->set($new_borrower);
345 if ($execute_success) { # only proceed if the update was a success
346 # If the patron changes to a category with enrollment fee, we add a fee
347 if ( $data{categorycode} and $data{categorycode} ne $old_categorycode ) {
348 if ( C4::Context->preference('FeeOnChangePatronCategory') ) {
349 $patron->add_enrolment_fee_if_needed;
353 # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
354 # cronjob will use for syncing with NL
355 if ( C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
356 warn "C4::Members::ModMember - NorwegianPatronDB hooks will be deprecated as of 18.11.0\n";
357 my $borrowersync = Koha::Database->new->schema->resultset('BorrowerSync')->find({
358 'synctype' => 'norwegianpatrondb',
359 'borrowernumber' => $data{'borrowernumber'}
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' } );
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'} });
373 logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "UPDATE (executed w/ arg: $data{'borrowernumber'})") if $borrowers_log;
375 return $execute_success;
380 $borrowernumber = &AddMember(%borrower);
382 insert new borrower into table
384 (%borrower keys are database columns. Database columns could be
385 different in different versions. Please look into database for correct
388 Returns the borrowernumber upon success
390 Returns as undef upon any db error without further processing
397 my $dbh = C4::Context->dbh;
398 my $schema = Koha::Database->new()->schema;
400 my $category = Koha::Patron::Categories->find( $data{categorycode} );
402 Koha::Exceptions::Object::FKConstraint->throw(
403 broken_fk => 'categorycode',
404 value => $data{categorycode},
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;
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 );
420 # add expiration date if it isn't already there
421 $data{dateexpiry} ||= $category->get_expiry_date;
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' } );
428 if ( C4::Context->preference("autoMemberNum") ) {
429 if ( not exists $data{cardnumber} or not defined $data{cardnumber} or $data{cardnumber} eq '' ) {
430 $data{cardnumber} = fixup_cardnumber( $data{cardnumber} );
435 $category->default_privacy() eq 'default' ? 1
436 : $category->default_privacy() eq 'never' ? 2
437 : $category->default_privacy() eq 'forever' ? 0
440 $data{'privacy_guarantor_checkouts'} = 0 unless defined( $data{'privacy_guarantor_checkouts'} );
442 # Make a copy of the plain text password for later use
443 my $plain_text_password = $data{'password'};
445 # create a disabled account if no password provided
446 $data{'password'} = ($data{'password'})? hash_password($data{'password'}) : '!';
448 # we don't want invalid dates in the db (mysql has a bad habit of inserting 0000-00-00
449 $data{'dateofbirth'} = undef if ( not $data{'dateofbirth'} );
450 $data{'debarred'} = undef if ( not $data{'debarred'} );
451 $data{'sms_provider_id'} = undef if ( not $data{'sms_provider_id'} );
452 $data{'guarantorid'} = undef if ( not $data{'guarantorid'} );
454 # get only the columns of Borrower
455 # FIXME Do we really need this check?
456 my @columns = $schema->source('Borrower')->columns;
457 my $new_member = { map { join(' ',@columns) =~ /$_/ ? ( $_ => $data{$_} ) : () } keys(%data) } ;
459 delete $new_member->{borrowernumber};
461 my $patron = Koha::Patron->new( $new_member )->store;
462 $data{borrowernumber} = $patron->borrowernumber;
464 # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
465 # cronjob will use for syncing with NL
466 if ( exists $data{'borrowernumber'} && C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
467 warn "C4::Members::AddMember - NorwegianPatronDB hooks will be deprecated as of 18.11.0\n";
468 Koha::Database->new->schema->resultset('BorrowerSync')->create({
469 'borrowernumber' => $data{'borrowernumber'},
470 'synctype' => 'norwegianpatrondb',
472 'syncstatus' => 'new',
473 'hashed_pin' => Koha::NorwegianPatronDB::NLEncryptPIN( $plain_text_password ),
477 logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");
479 $patron->add_enrolment_fee_if_needed;
481 return $data{borrowernumber};
484 =head2 fixup_cardnumber
486 Warning: The caller is responsible for locking the members table in write
487 mode, to avoid database corruption.
491 sub fixup_cardnumber {
492 my ($cardnumber) = @_;
493 my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0;
495 # Find out whether member numbers should be generated
496 # automatically. Should be either "1" or something else.
497 # Defaults to "0", which is interpreted as "no".
499 ($autonumber_members) or return $cardnumber;
500 my $dbh = C4::Context->dbh;
502 my $sth = $dbh->prepare(
503 'SELECT MAX( CAST( cardnumber AS SIGNED ) ) FROM borrowers WHERE cardnumber REGEXP "^-?[0-9]+$"'
506 my ($result) = $sth->fetchrow;
512 $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
514 Looks up what the patron with the given borrowernumber has borrowed,
515 and sorts the results.
517 C<$sortkey> is the name of a field on which to sort the results. This
518 should be the name of a field in the C<issues>, C<biblio>,
519 C<biblioitems>, or C<items> table in the Koha database.
521 C<$limit> is the maximum number of results to return.
523 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
524 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
525 C<items> tables of the Koha database.
531 my ( $borrowernumber, $order, $limit ) = @_;
533 return unless $borrowernumber;
534 $order = 'date_due desc' unless $order;
536 my $dbh = C4::Context->dbh;
538 'SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
540 LEFT JOIN items on items.itemnumber=issues.itemnumber
541 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
542 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
543 WHERE borrowernumber=?
545 SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
547 LEFT JOIN items on items.itemnumber=old_issues.itemnumber
548 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
549 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
550 WHERE borrowernumber=? AND old_issues.itemnumber IS NOT NULL
553 $query .= " limit $limit";
556 my $sth = $dbh->prepare($query);
557 $sth->execute( $borrowernumber, $borrowernumber );
558 return $sth->fetchall_arrayref( {} );
561 sub checkcardnumber {
562 my ( $cardnumber, $borrowernumber ) = @_;
564 # If cardnumber is null, we assume they're allowed.
565 return 0 unless defined $cardnumber;
567 my $dbh = C4::Context->dbh;
568 my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
569 $query .= " AND borrowernumber <> ?" if ($borrowernumber);
570 my $sth = $dbh->prepare($query);
573 ( $borrowernumber ? $borrowernumber : () )
576 return 1 if $sth->fetchrow_hashref;
578 my ( $min_length, $max_length ) = get_cardnumber_length();
580 if length $cardnumber > $max_length
581 or length $cardnumber < $min_length;
586 =head2 get_cardnumber_length
588 my ($min, $max) = C4::Members::get_cardnumber_length()
590 Returns the minimum and maximum length for patron cardnumbers as
591 determined by the CardnumberLength system preference, the
592 BorrowerMandatoryField system preference, and the width of the
597 sub get_cardnumber_length {
598 my $borrower = Koha::Database->new->schema->resultset('Borrower');
599 my $field_size = $borrower->result_source->column_info('cardnumber')->{size};
600 my ( $min, $max ) = ( 0, $field_size ); # borrowers.cardnumber is a nullable varchar(20)
601 $min = 1 if C4::Context->preference('BorrowerMandatoryField') =~ /cardnumber/;
602 if ( my $cardnumber_length = C4::Context->preference('CardnumberLength') ) {
603 # Is integer and length match
604 if ( $cardnumber_length =~ m|^\d+$| ) {
605 $min = $max = $cardnumber_length
606 if $cardnumber_length >= $min
607 and $cardnumber_length <= $max;
609 # Else assuming it is a range
610 elsif ( $cardnumber_length =~ m|(\d*),(\d*)| ) {
611 $min = $1 if $1 and $min < $1;
612 $max = $2 if $2 and $max > $2;
616 $min = $max if $min > $max;
617 return ( $min, $max );
620 =head2 GetBorrowersToExpunge
622 $borrowers = &GetBorrowersToExpunge(
623 not_borrowed_since => $not_borrowed_since,
624 expired_before => $expired_before,
625 category_code => $category_code,
626 patron_list_id => $patron_list_id,
627 branchcode => $branchcode
630 This function get all borrowers based on the given criteria.
634 sub GetBorrowersToExpunge {
637 my $filterdate = $params->{'not_borrowed_since'};
638 my $filterexpiry = $params->{'expired_before'};
639 my $filterlastseen = $params->{'last_seen'};
640 my $filtercategory = $params->{'category_code'};
641 my $filterbranch = $params->{'branchcode'} ||
642 ((C4::Context->preference('IndependentBranches')
643 && C4::Context->userenv
644 && !C4::Context->IsSuperLibrarian()
645 && C4::Context->userenv->{branch})
646 ? C4::Context->userenv->{branch}
648 my $filterpatronlist = $params->{'patron_list_id'};
650 my $dbh = C4::Context->dbh;
654 SELECT borrowers.borrowernumber,
655 MAX(old_issues.timestamp) AS latestissue,
656 MAX(issues.timestamp) AS currentissue
658 JOIN categories USING (categorycode)
662 WHERE guarantorid IS NOT NULL
664 ) as tmp ON borrowers.borrowernumber=tmp.guarantorid
665 LEFT JOIN old_issues USING (borrowernumber)
666 LEFT JOIN issues USING (borrowernumber)|;
667 if ( $filterpatronlist ){
668 $query .= q| LEFT JOIN patron_list_patrons USING (borrowernumber)|;
670 $query .= q| WHERE category_type <> 'S'
671 AND tmp.guarantorid IS NULL
674 if ( $filterbranch && $filterbranch ne "" ) {
675 $query.= " AND borrowers.branchcode = ? ";
676 push( @query_params, $filterbranch );
678 if ( $filterexpiry ) {
679 $query .= " AND dateexpiry < ? ";
680 push( @query_params, $filterexpiry );
682 if ( $filterlastseen ) {
683 $query .= ' AND lastseen < ? ';
684 push @query_params, $filterlastseen;
686 if ( $filtercategory ) {
687 $query .= " AND categorycode = ? ";
688 push( @query_params, $filtercategory );
690 if ( $filterpatronlist ){
691 $query.=" AND patron_list_id = ? ";
692 push( @query_params, $filterpatronlist );
694 $query .= " GROUP BY borrowers.borrowernumber";
696 ) xxx WHERE currentissue IS NULL|;
698 $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
699 push @query_params,$filterdate;
702 warn $query if $debug;
704 my $sth = $dbh->prepare($query);
705 if (scalar(@query_params)>0){
706 $sth->execute(@query_params);
713 while ( my $data = $sth->fetchrow_hashref ) {
714 push @results, $data;
721 IssueSlip($branchcode, $borrowernumber, $quickslip)
723 Returns letter hash ( see C4::Letters::GetPreparedLetter )
725 $quickslip is boolean, to indicate whether we want a quick slip
727 IssueSlip populates ISSUESLIP and ISSUEQSLIP, and will make the following expansions:
763 NOTE: Fields from tables issues, items, biblio and biblioitems are available
768 my ($branch, $borrowernumber, $quickslip) = @_;
770 # FIXME Check callers before removing this statement
771 #return unless $borrowernumber;
773 my $patron = Koha::Patrons->find( $borrowernumber );
774 return unless $patron;
776 my $pending_checkouts = $patron->pending_checkouts; # Should be $patron->checkouts->pending?
778 my ($letter_code, %repeat, %loops);
780 my $today_start = dt_from_string->set( hour => 0, minute => 0, second => 0 );
781 my $today_end = dt_from_string->set( hour => 23, minute => 59, second => 0 );
782 $today_start = Koha::Database->new->schema->storage->datetime_parser->format_datetime( $today_start );
783 $today_end = Koha::Database->new->schema->storage->datetime_parser->format_datetime( $today_end );
784 $letter_code = 'ISSUEQSLIP';
786 # issue date or lastreneweddate is today
787 my $todays_checkouts = $pending_checkouts->search(
791 '>=' => $today_start,
795 { '>=' => $today_start, '<=' => $today_end, }
800 while ( my $c = $todays_checkouts->next ) {
801 my $all = $c->unblessed_all_relateds;
811 checkedout => \@checkouts, # Historical syntax
814 issues => [ map { $_->{issues}{itemnumber} } @checkouts ], # TT syntax
818 my $today = Koha::Database->new->schema->storage->datetime_parser->format_datetime( dt_from_string );
819 # Checkouts due in the future
820 my $checkouts = $pending_checkouts->search({ date_due => { '>' => $today } });
821 my @checkouts; my @overdues;
822 while ( my $c = $checkouts->next ) {
823 my $all = $c->unblessed_all_relateds;
832 # Checkouts due in the past are overdues
833 my $overdues = $pending_checkouts->search({ date_due => { '<=' => $today } });
834 while ( my $o = $overdues->next ) {
835 my $all = $o->unblessed_all_relateds;
843 my $news = GetNewsToDisplay( "slip", $branch );
845 $_->{'timestamp'} = $_->{'newdate'};
848 $letter_code = 'ISSUESLIP';
850 checkedout => \@checkouts,
851 overdue => \@overdues,
855 issues => [ map { $_->{issues}{itemnumber} } @checkouts ],
856 overdues => [ map { $_->{issues}{itemnumber} } @overdues ],
857 opac_news => [ map { $_->{opac_news}{idnew} } @news ],
861 return C4::Letters::GetPreparedLetter (
862 module => 'circulation',
863 letter_code => $letter_code,
864 branchcode => $branch,
865 lang => $patron->lang,
867 'branches' => $branch,
868 'borrowers' => $borrowernumber,
875 =head2 AddMember_Auto
880 my ( %borrower ) = @_;
882 $borrower{'cardnumber'} ||= fixup_cardnumber();
884 $borrower{'borrowernumber'} = AddMember(%borrower);
886 return ( %borrower );
889 =head2 AddMember_Opac
894 my ( %borrower ) = @_;
896 $borrower{'categorycode'} //= C4::Context->preference('PatronSelfRegistrationDefaultCategory');
897 if (not defined $borrower{'password'}){
898 my $sr = new String::Random;
899 $sr->{'A'} = [ 'A'..'Z', 'a'..'z' ];
900 my $password = $sr->randpattern("AAAAAAAAAA");
901 $borrower{'password'} = $password;
904 %borrower = AddMember_Auto(%borrower);
906 return ( $borrower{'borrowernumber'}, $borrower{'password'} );
909 =head2 DeleteExpiredOpacRegistrations
911 Delete accounts that haven't been upgraded from the 'temporary' category
912 Returns the number of removed patrons
916 sub DeleteExpiredOpacRegistrations {
918 my $delay = C4::Context->preference('PatronSelfRegistrationExpireTemporaryAccountsDelay');
919 my $category_code = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
921 return 0 if not $category_code or not defined $delay or $delay eq q||;
922 my $date_enrolled = dt_from_string();
923 $date_enrolled->subtract( days => $delay );
925 my $registrations_to_del = Koha::Patrons->search({
926 dateenrolled => {'<=' => $date_enrolled->ymd},
927 categorycode => $category_code,
931 while ( my $registration = $registrations_to_del->next() ) {
932 next if $registration->checkouts->count || $registration->account->balance;
933 $registration->delete;
939 =head2 DeleteUnverifiedOpacRegistrations
941 Delete all unverified self registrations in borrower_modifications,
942 older than the specified number of days.
946 sub DeleteUnverifiedOpacRegistrations {
948 my $dbh = C4::Context->dbh;
950 DELETE FROM borrower_modifications
951 WHERE borrowernumber = 0 AND DATEDIFF( NOW(), timestamp ) > ?|;
952 my $cnt=$dbh->do($sql, undef, ($days) );
953 return $cnt eq '0E0'? 0: $cnt;
956 END { } # module clean-up code here (global destructor)