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 Text::Unaccent qw( unac_string );
43 use Koha::AuthUtils qw(hash_password);
46 use Koha::List::Patron;
48 use Koha::Patron::Categories;
51 our (@ISA,@EXPORT,@EXPORT_OK,$debug);
53 use Module::Load::Conditional qw( can_load );
54 if ( ! can_load( modules => { 'Koha::NorwegianPatronDB' => undef } ) ) {
55 $debug && warn "Unable to load Koha::NorwegianPatronDB";
60 $debug = $ENV{DEBUG} || 0;
68 &GetBorrowersToExpunge
95 C4::Members - Perl Module containing convenience functions for member handling
103 This module contains routines for adding, modifying and deleting members/patrons/borrowers
109 $flags = &patronflags($patron);
111 This function is not exported.
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
118 $flags->{CREDITS}->{amount} Amount of credit
119 $flags->{CREDITS}->{message} Message -- deprecated
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
125 $flags->{ LOST } Patron's card reported lost
126 $flags->{ LOST }->{noissues} Set for each LOST
127 $flags->{ LOST }->{message} Message -- deprecated
129 $flags->{DBARRED} Set if patron debarred, no access
130 $flags->{DBARRED}->{noissues} Set for each DBARRED
131 $flags->{DBARRED}->{message} Message -- deprecated
134 $flags->{ NOTES }->{message} The note itself. NOT deprecated
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
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
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.
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.
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.
161 All the "message" fields that include language generated in this function are deprecated,
162 because such strings belong properly in the display layer.
164 The "message" field that comes from the DB is OK.
168 # TODO: use {anonymous => hashes} instead of a dozen %flaginfo
169 # FIXME rename this function.
170 # DEPRECATED Do not use this subroutine!
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;
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;
186 $flags{'CHARGES'} = \%flaginfo;
188 elsif ( ( my $balance = $account->balance ) < 0 ) {
190 $flaginfo{'message'} = sprintf 'Patron has credit of %.02f', -$balance;
191 $flaginfo{'amount'} = sprintf "%.02f", $balance;
192 $flags{'CREDITS'} = \%flaginfo;
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;
206 if ( $guarantees_non_issues_charges > $no_issues_charge_guarantees ) {
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;
215 if ( $patroninformation->{'gonenoaddress'}
216 && $patroninformation->{'gonenoaddress'} == 1 )
219 $flaginfo{'message'} = 'Borrower has no valid address.';
220 $flaginfo{'noissues'} = 1;
221 $flags{'GNA'} = \%flaginfo;
223 if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
225 $flaginfo{'message'} = 'Borrower\'s card reported lost.';
226 $flaginfo{'noissues'} = 1;
227 $flags{'LOST'} = \%flaginfo;
229 if ( $patroninformation->{'debarred'} && check_date( split( /-/, $patroninformation->{'debarred'} ) ) ) {
230 if ( Date_to_Days(Date::Calc::Today) < Date_to_Days( split( /-/, $patroninformation->{'debarred'} ) ) ) {
232 $flaginfo{'debarredcomment'} = $patroninformation->{'debarredcomment'};
233 $flaginfo{'message'} = $patroninformation->{'debarredcomment'};
234 $flaginfo{'noissues'} = 1;
235 $flaginfo{'dateend'} = $patroninformation->{'debarred'};
236 $flags{'DBARRED'} = \%flaginfo;
239 if ( $patroninformation->{'borrowernotes'}
240 && $patroninformation->{'borrowernotes'} )
243 $flaginfo{'message'} = $patroninformation->{'borrowernotes'};
244 $flags{'NOTES'} = \%flaginfo;
246 my ( $odues, $itemsoverdue ) = C4::Overdues::checkoverdues($patroninformation->{'borrowernumber'});
247 if ( $odues && $odues > 0 ) {
249 $flaginfo{'message'} = "Yes";
250 $flaginfo{'itemlist'} = $itemsoverdue;
251 foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
254 $flaginfo{'itemlisttext'} .=
255 "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n"; # newline is display layer
257 $flags{'ODUES'} = \%flaginfo;
260 my $waiting_holds = $patron->holds->search({ found => 'W' });
261 my $nowaiting = $waiting_holds->count;
262 if ( $nowaiting > 0 ) {
264 $flaginfo{'message'} = "Reserved items available";
265 $flaginfo{'itemlist'} = $waiting_holds->unblessed;
266 $flags{'WAITING'} = \%flaginfo;
274 my $success = ModMember(borrowernumber => $borrowernumber,
275 [ field => value ]... );
277 Modify borrower's data. All date fields should ALREADY be in ISO format.
280 true on success, or false on failure
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;
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};
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} );
303 $data{password} = hash_password($data{password});
307 my $old_categorycode = Koha::Patrons->find( $data{borrowernumber} )->categorycode;
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) };
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};
321 my $patron = Koha::Patrons->find( $new_borrower->{borrowernumber} );
323 my $borrowers_log = C4::Context->preference("BorrowersLog");
324 if ( $borrowers_log && $patron->cardnumber ne $new_borrower->{cardnumber} )
329 $data{'borrowernumber'},
332 cardnumber_replaced => {
333 previous_cardnumber => $patron->cardnumber,
334 new_cardnumber => $new_borrower->{cardnumber},
337 { utf8 => 1, pretty => 1 }
342 delete $new_borrower->{userid} if exists $new_borrower->{userid} and not $new_borrower->{userid};
344 my $execute_success = $patron->store if $patron->set($new_borrower);
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;
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'}
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' } );
429 $category->default_privacy() eq 'default' ? 1
430 : $category->default_privacy() eq 'never' ? 2
431 : $category->default_privacy() eq 'forever' ? 0
434 $data{'privacy_guarantor_checkouts'} = 0 unless defined( $data{'privacy_guarantor_checkouts'} );
436 # Make a copy of the plain text password for later use
437 my $plain_text_password = $data{'password'};
439 # create a disabled account if no password provided
440 $data{'password'} = ($data{'password'})? hash_password($data{'password'}) : '!';
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'} );
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) } ;
453 delete $new_member->{borrowernumber};
455 my $patron = Koha::Patron->new( $new_member )->store;
456 $data{borrowernumber} = $patron->borrowernumber;
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',
465 'syncstatus' => 'new',
466 'hashed_pin' => Koha::NorwegianPatronDB::NLEncryptPIN( $plain_text_password ),
470 logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");
472 $patron->add_enrolment_fee_if_needed;
474 return $data{borrowernumber};
479 $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
481 Looks up what the patron with the given borrowernumber has borrowed,
482 and sorts the results.
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.
488 C<$limit> is the maximum number of results to return.
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.
498 my ( $borrowernumber, $order, $limit ) = @_;
500 return unless $borrowernumber;
501 $order = 'date_due desc' unless $order;
503 my $dbh = C4::Context->dbh;
505 'SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
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=?
512 SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
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
520 $query .= " limit $limit";
523 my $sth = $dbh->prepare($query);
524 $sth->execute( $borrowernumber, $borrowernumber );
525 return $sth->fetchall_arrayref( {} );
528 sub checkcardnumber {
529 my ( $cardnumber, $borrowernumber ) = @_;
531 # If cardnumber is null, we assume they're allowed.
532 return 0 unless defined $cardnumber;
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);
540 ( $borrowernumber ? $borrowernumber : () )
543 return 1 if $sth->fetchrow_hashref;
545 my ( $min_length, $max_length ) = get_cardnumber_length();
547 if length $cardnumber > $max_length
548 or length $cardnumber < $min_length;
553 =head2 get_cardnumber_length
555 my ($min, $max) = C4::Members::get_cardnumber_length()
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
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;
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;
583 $min = $max if $min > $max;
584 return ( $min, $max );
587 =head2 GetBorrowersToExpunge
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
597 This function get all borrowers based on the given criteria.
601 sub GetBorrowersToExpunge {
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}
615 my $filterpatronlist = $params->{'patron_list_id'};
617 my $dbh = C4::Context->dbh;
621 SELECT borrowers.borrowernumber,
622 MAX(old_issues.timestamp) AS latestissue,
623 MAX(issues.timestamp) AS currentissue
625 JOIN categories USING (categorycode)
629 WHERE guarantorid IS NOT NULL
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)|;
637 $query .= q| WHERE category_type <> 'S'
638 AND tmp.guarantorid IS NULL
641 if ( $filterbranch && $filterbranch ne "" ) {
642 $query.= " AND borrowers.branchcode = ? ";
643 push( @query_params, $filterbranch );
645 if ( $filterexpiry ) {
646 $query .= " AND dateexpiry < ? ";
647 push( @query_params, $filterexpiry );
649 if ( $filterlastseen ) {
650 $query .= ' AND lastseen < ? ';
651 push @query_params, $filterlastseen;
653 if ( $filtercategory ) {
654 $query .= " AND categorycode = ? ";
655 push( @query_params, $filtercategory );
657 if ( $filterpatronlist ){
658 $query.=" AND patron_list_id = ? ";
659 push( @query_params, $filterpatronlist );
661 $query .= " GROUP BY borrowers.borrowernumber";
663 ) xxx WHERE currentissue IS NULL|;
665 $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
666 push @query_params,$filterdate;
669 warn $query if $debug;
671 my $sth = $dbh->prepare($query);
672 if (scalar(@query_params)>0){
673 $sth->execute(@query_params);
680 while ( my $data = $sth->fetchrow_hashref ) {
681 push @results, $data;
688 IssueSlip($branchcode, $borrowernumber, $quickslip)
690 Returns letter hash ( see C4::Letters::GetPreparedLetter )
692 $quickslip is boolean, to indicate whether we want a quick slip
694 IssueSlip populates ISSUESLIP and ISSUEQSLIP, and will make the following expansions:
730 NOTE: Fields from tables issues, items, biblio and biblioitems are available
735 my ($branch, $borrowernumber, $quickslip) = @_;
737 # FIXME Check callers before removing this statement
738 #return unless $borrowernumber;
740 my $patron = Koha::Patrons->find( $borrowernumber );
741 return unless $patron;
743 my $pending_checkouts = $patron->pending_checkouts; # Should be $patron->checkouts->pending?
745 my ($letter_code, %repeat, %loops);
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';
753 # issue date or lastreneweddate is today
754 my $todays_checkouts = $pending_checkouts->search(
758 '>=' => $today_start,
762 { '>=' => $today_start, '<=' => $today_end, }
767 while ( my $c = $todays_checkouts->next ) {
768 my $all = $c->unblessed_all_relateds;
778 checkedout => \@checkouts, # Historical syntax
781 issues => [ map { $_->{issues}{itemnumber} } @checkouts ], # TT syntax
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;
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;
810 my $news = GetNewsToDisplay( "slip", $branch );
812 $_->{'timestamp'} = $_->{'newdate'};
815 $letter_code = 'ISSUESLIP';
817 checkedout => \@checkouts,
818 overdue => \@overdues,
822 issues => [ map { $_->{issues}{itemnumber} } @checkouts ],
823 overdues => [ map { $_->{issues}{itemnumber} } @overdues ],
824 opac_news => [ map { $_->{opac_news}{idnew} } @news ],
828 return C4::Letters::GetPreparedLetter (
829 module => 'circulation',
830 letter_code => $letter_code,
831 branchcode => $branch,
832 lang => $patron->lang,
834 'branches' => $branch,
835 'borrowers' => $borrowernumber,
842 =head2 AddMember_Auto
847 my ( %borrower ) = @_;
849 $borrower{'borrowernumber'} = AddMember(%borrower);
850 my $patron = Koha::Patrons->find( $borrower{borrowernumber} )->unblessed;
851 $patron->{password} = $borrower{password};
855 =head2 AddMember_Opac
860 my ( %borrower ) = @_;
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;
870 %borrower = AddMember_Auto(%borrower);
872 return ( $borrower{'borrowernumber'}, $borrower{'password'} );
875 =head2 DeleteExpiredOpacRegistrations
877 Delete accounts that haven't been upgraded from the 'temporary' category
878 Returns the number of removed patrons
882 sub DeleteExpiredOpacRegistrations {
884 my $delay = C4::Context->preference('PatronSelfRegistrationExpireTemporaryAccountsDelay');
885 my $category_code = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
887 return 0 if not $category_code or not defined $delay or $delay eq q||;
890 SELECT borrowernumber
892 WHERE categorycode = ? AND DATEDIFF( NOW(), dateenrolled ) > ? |;
894 my $dbh = C4::Context->dbh;
895 my $sth = $dbh->prepare($query);
896 $sth->execute( $category_code, $delay );
898 while ( my ($borrowernumber) = $sth->fetchrow_array() ) {
899 Koha::Patrons->find($borrowernumber)->delete;
905 =head2 DeleteUnverifiedOpacRegistrations
907 Delete all unverified self registrations in borrower_modifications,
908 older than the specified number of days.
912 sub DeleteUnverifiedOpacRegistrations {
914 my $dbh = C4::Context->dbh;
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;
922 END { } # module clean-up code here (global destructor)