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 my $p = Koha::Patron->new( { userid => $data{userid}, firstname => $data{firstname}, surname => $data{surname} } );
409 # generate a proper login if none provided
410 $data{'userid'} = $p->generate_userid
411 if ( $data{'userid'} eq '' || ! $p->has_valid_userid );
413 # add expiration date if it isn't already there
414 $data{dateexpiry} ||= $category->get_expiry_date;
416 # add enrollment date if it isn't already there
417 unless ( $data{'dateenrolled'} ) {
418 $data{'dateenrolled'} = output_pref( { dt => dt_from_string, dateonly => 1, dateformat => 'iso' } );
422 $category->default_privacy() eq 'default' ? 1
423 : $category->default_privacy() eq 'never' ? 2
424 : $category->default_privacy() eq 'forever' ? 0
427 $data{'privacy_guarantor_checkouts'} = 0 unless defined( $data{'privacy_guarantor_checkouts'} );
429 # Make a copy of the plain text password for later use
430 my $plain_text_password = $data{'password'};
432 # create a disabled account if no password provided
433 $data{'password'} = ($data{'password'})? hash_password($data{'password'}) : '!';
435 # we don't want invalid dates in the db (mysql has a bad habit of inserting 0000-00-00
436 $data{'dateofbirth'} = undef if ( not $data{'dateofbirth'} );
437 $data{'debarred'} = undef if ( not $data{'debarred'} );
438 $data{'sms_provider_id'} = undef if ( not $data{'sms_provider_id'} );
439 $data{'guarantorid'} = undef if ( not $data{'guarantorid'} );
441 # get only the columns of Borrower
442 # FIXME Do we really need this check?
443 my @columns = $schema->source('Borrower')->columns;
444 my $new_member = { map { join(' ',@columns) =~ /$_/ ? ( $_ => $data{$_} ) : () } keys(%data) } ;
446 delete $new_member->{borrowernumber};
448 my $patron = Koha::Patron->new( $new_member )->store;
449 $data{borrowernumber} = $patron->borrowernumber;
451 # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
452 # cronjob will use for syncing with NL
453 if ( exists $data{'borrowernumber'} && C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
454 Koha::Database->new->schema->resultset('BorrowerSync')->create({
455 'borrowernumber' => $data{'borrowernumber'},
456 'synctype' => 'norwegianpatrondb',
458 'syncstatus' => 'new',
459 'hashed_pin' => Koha::NorwegianPatronDB::NLEncryptPIN( $plain_text_password ),
463 logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");
465 $patron->add_enrolment_fee_if_needed;
467 return $data{borrowernumber};
472 $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
474 Looks up what the patron with the given borrowernumber has borrowed,
475 and sorts the results.
477 C<$sortkey> is the name of a field on which to sort the results. This
478 should be the name of a field in the C<issues>, C<biblio>,
479 C<biblioitems>, or C<items> table in the Koha database.
481 C<$limit> is the maximum number of results to return.
483 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
484 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
485 C<items> tables of the Koha database.
491 my ( $borrowernumber, $order, $limit ) = @_;
493 return unless $borrowernumber;
494 $order = 'date_due desc' unless $order;
496 my $dbh = C4::Context->dbh;
498 'SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
500 LEFT JOIN items on items.itemnumber=issues.itemnumber
501 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
502 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
503 WHERE borrowernumber=?
505 SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
507 LEFT JOIN items on items.itemnumber=old_issues.itemnumber
508 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
509 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
510 WHERE borrowernumber=? AND old_issues.itemnumber IS NOT NULL
513 $query .= " limit $limit";
516 my $sth = $dbh->prepare($query);
517 $sth->execute( $borrowernumber, $borrowernumber );
518 return $sth->fetchall_arrayref( {} );
521 sub checkcardnumber {
522 my ( $cardnumber, $borrowernumber ) = @_;
524 # If cardnumber is null, we assume they're allowed.
525 return 0 unless defined $cardnumber;
527 my $dbh = C4::Context->dbh;
528 my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
529 $query .= " AND borrowernumber <> ?" if ($borrowernumber);
530 my $sth = $dbh->prepare($query);
533 ( $borrowernumber ? $borrowernumber : () )
536 return 1 if $sth->fetchrow_hashref;
538 my ( $min_length, $max_length ) = get_cardnumber_length();
540 if length $cardnumber > $max_length
541 or length $cardnumber < $min_length;
546 =head2 get_cardnumber_length
548 my ($min, $max) = C4::Members::get_cardnumber_length()
550 Returns the minimum and maximum length for patron cardnumbers as
551 determined by the CardnumberLength system preference, the
552 BorrowerMandatoryField system preference, and the width of the
557 sub get_cardnumber_length {
558 my $borrower = Koha::Schema->resultset('Borrower');
559 my $field_size = $borrower->result_source->column_info('cardnumber')->{size};
560 my ( $min, $max ) = ( 0, $field_size ); # borrowers.cardnumber is a nullable varchar(20)
561 $min = 1 if C4::Context->preference('BorrowerMandatoryField') =~ /cardnumber/;
562 if ( my $cardnumber_length = C4::Context->preference('CardnumberLength') ) {
563 # Is integer and length match
564 if ( $cardnumber_length =~ m|^\d+$| ) {
565 $min = $max = $cardnumber_length
566 if $cardnumber_length >= $min
567 and $cardnumber_length <= $max;
569 # Else assuming it is a range
570 elsif ( $cardnumber_length =~ m|(\d*),(\d*)| ) {
571 $min = $1 if $1 and $min < $1;
572 $max = $2 if $2 and $max > $2;
576 $min = $max if $min > $max;
577 return ( $min, $max );
580 =head2 GetBorrowersToExpunge
582 $borrowers = &GetBorrowersToExpunge(
583 not_borrowed_since => $not_borrowed_since,
584 expired_before => $expired_before,
585 category_code => $category_code,
586 patron_list_id => $patron_list_id,
587 branchcode => $branchcode
590 This function get all borrowers based on the given criteria.
594 sub GetBorrowersToExpunge {
597 my $filterdate = $params->{'not_borrowed_since'};
598 my $filterexpiry = $params->{'expired_before'};
599 my $filterlastseen = $params->{'last_seen'};
600 my $filtercategory = $params->{'category_code'};
601 my $filterbranch = $params->{'branchcode'} ||
602 ((C4::Context->preference('IndependentBranches')
603 && C4::Context->userenv
604 && !C4::Context->IsSuperLibrarian()
605 && C4::Context->userenv->{branch})
606 ? C4::Context->userenv->{branch}
608 my $filterpatronlist = $params->{'patron_list_id'};
610 my $dbh = C4::Context->dbh;
614 SELECT borrowers.borrowernumber,
615 MAX(old_issues.timestamp) AS latestissue,
616 MAX(issues.timestamp) AS currentissue
618 JOIN categories USING (categorycode)
622 WHERE guarantorid IS NOT NULL
624 ) as tmp ON borrowers.borrowernumber=tmp.guarantorid
625 LEFT JOIN old_issues USING (borrowernumber)
626 LEFT JOIN issues USING (borrowernumber)|;
627 if ( $filterpatronlist ){
628 $query .= q| LEFT JOIN patron_list_patrons USING (borrowernumber)|;
630 $query .= q| WHERE category_type <> 'S'
631 AND tmp.guarantorid IS NULL
634 if ( $filterbranch && $filterbranch ne "" ) {
635 $query.= " AND borrowers.branchcode = ? ";
636 push( @query_params, $filterbranch );
638 if ( $filterexpiry ) {
639 $query .= " AND dateexpiry < ? ";
640 push( @query_params, $filterexpiry );
642 if ( $filterlastseen ) {
643 $query .= ' AND lastseen < ? ';
644 push @query_params, $filterlastseen;
646 if ( $filtercategory ) {
647 $query .= " AND categorycode = ? ";
648 push( @query_params, $filtercategory );
650 if ( $filterpatronlist ){
651 $query.=" AND patron_list_id = ? ";
652 push( @query_params, $filterpatronlist );
654 $query .= " GROUP BY borrowers.borrowernumber";
656 ) xxx WHERE currentissue IS NULL|;
658 $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
659 push @query_params,$filterdate;
662 warn $query if $debug;
664 my $sth = $dbh->prepare($query);
665 if (scalar(@query_params)>0){
666 $sth->execute(@query_params);
673 while ( my $data = $sth->fetchrow_hashref ) {
674 push @results, $data;
681 IssueSlip($branchcode, $borrowernumber, $quickslip)
683 Returns letter hash ( see C4::Letters::GetPreparedLetter )
685 $quickslip is boolean, to indicate whether we want a quick slip
687 IssueSlip populates ISSUESLIP and ISSUEQSLIP, and will make the following expansions:
723 NOTE: Fields from tables issues, items, biblio and biblioitems are available
728 my ($branch, $borrowernumber, $quickslip) = @_;
730 # FIXME Check callers before removing this statement
731 #return unless $borrowernumber;
733 my $patron = Koha::Patrons->find( $borrowernumber );
734 return unless $patron;
736 my $pending_checkouts = $patron->pending_checkouts; # Should be $patron->checkouts->pending?
738 my ($letter_code, %repeat, %loops);
740 my $today_start = dt_from_string->set( hour => 0, minute => 0, second => 0 );
741 my $today_end = dt_from_string->set( hour => 23, minute => 59, second => 0 );
742 $today_start = Koha::Database->new->schema->storage->datetime_parser->format_datetime( $today_start );
743 $today_end = Koha::Database->new->schema->storage->datetime_parser->format_datetime( $today_end );
744 $letter_code = 'ISSUEQSLIP';
746 # issue date or lastreneweddate is today
747 my $todays_checkouts = $pending_checkouts->search(
751 '>=' => $today_start,
755 { '>=' => $today_start, '<=' => $today_end, }
760 while ( my $c = $todays_checkouts->next ) {
761 my $all = $c->unblessed_all_relateds;
771 checkedout => \@checkouts, # Historical syntax
774 issues => [ map { $_->{issues}{itemnumber} } @checkouts ], # TT syntax
778 my $today = Koha::Database->new->schema->storage->datetime_parser->format_datetime( dt_from_string );
779 # Checkouts due in the future
780 my $checkouts = $pending_checkouts->search({ date_due => { '>' => $today } });
781 my @checkouts; my @overdues;
782 while ( my $c = $checkouts->next ) {
783 my $all = $c->unblessed_all_relateds;
792 # Checkouts due in the past are overdues
793 my $overdues = $pending_checkouts->search({ date_due => { '<=' => $today } });
794 while ( my $o = $overdues->next ) {
795 my $all = $o->unblessed_all_relateds;
803 my $news = GetNewsToDisplay( "slip", $branch );
805 $_->{'timestamp'} = $_->{'newdate'};
808 $letter_code = 'ISSUESLIP';
810 checkedout => \@checkouts,
811 overdue => \@overdues,
815 issues => [ map { $_->{issues}{itemnumber} } @checkouts ],
816 overdues => [ map { $_->{issues}{itemnumber} } @overdues ],
817 opac_news => [ map { $_->{opac_news}{idnew} } @news ],
821 return C4::Letters::GetPreparedLetter (
822 module => 'circulation',
823 letter_code => $letter_code,
824 branchcode => $branch,
825 lang => $patron->lang,
827 'branches' => $branch,
828 'borrowers' => $borrowernumber,
835 =head2 AddMember_Auto
840 my ( %borrower ) = @_;
842 $borrower{'borrowernumber'} = AddMember(%borrower);
843 my $patron = Koha::Patrons->find( $borrower{borrowernumber} )->unblessed;
844 $patron->{password} = $borrower{password};
848 =head2 AddMember_Opac
853 my ( %borrower ) = @_;
855 $borrower{'categorycode'} //= C4::Context->preference('PatronSelfRegistrationDefaultCategory');
856 if (not defined $borrower{'password'}){
857 my $sr = new String::Random;
858 $sr->{'A'} = [ 'A'..'Z', 'a'..'z' ];
859 my $password = $sr->randpattern("AAAAAAAAAA");
860 $borrower{'password'} = $password;
863 %borrower = AddMember_Auto(%borrower);
865 return ( $borrower{'borrowernumber'}, $borrower{'password'} );
868 =head2 DeleteExpiredOpacRegistrations
870 Delete accounts that haven't been upgraded from the 'temporary' category
871 Returns the number of removed patrons
875 sub DeleteExpiredOpacRegistrations {
877 my $delay = C4::Context->preference('PatronSelfRegistrationExpireTemporaryAccountsDelay');
878 my $category_code = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
880 return 0 if not $category_code or not defined $delay or $delay eq q||;
883 SELECT borrowernumber
885 WHERE categorycode = ? AND DATEDIFF( NOW(), dateenrolled ) > ? |;
887 my $dbh = C4::Context->dbh;
888 my $sth = $dbh->prepare($query);
889 $sth->execute( $category_code, $delay );
891 while ( my ($borrowernumber) = $sth->fetchrow_array() ) {
892 Koha::Patrons->find($borrowernumber)->delete;
898 =head2 DeleteUnverifiedOpacRegistrations
900 Delete all unverified self registrations in borrower_modifications,
901 older than the specified number of days.
905 sub DeleteUnverifiedOpacRegistrations {
907 my $dbh = C4::Context->dbh;
909 DELETE FROM borrower_modifications
910 WHERE borrowernumber = 0 AND DATEDIFF( NOW(), timestamp ) > ?|;
911 my $cnt=$dbh->do($sql, undef, ($days) );
912 return $cnt eq '0E0'? 0: $cnt;
915 END { } # module clean-up code here (global destructor)