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 );
30 use C4::Log; # logaction
36 use C4::Members::Attributes qw(SearchIdMatchingAttribute UpdateBorrowerAttribute);
37 use C4::NewsChannels; #get slip news
41 use Text::Unaccent qw( unac_string );
42 use Koha::AuthUtils qw(hash_password);
45 use Koha::List::Patron;
47 use Koha::Patron::Categories;
50 our (@ISA,@EXPORT,@EXPORT_OK,$debug);
52 use Module::Load::Conditional qw( can_load );
53 if ( ! can_load( modules => { 'Koha::NorwegianPatronDB' => undef } ) ) {
54 $debug && warn "Unable to load Koha::NorwegianPatronDB";
59 $debug = $ENV{DEBUG} || 0;
68 &GetBorrowersToExpunge
100 C4::Members - Perl Module containing convenience functions for member handling
108 This module contains routines for adding, modifying and deleting members/patrons/borrowers
114 $flags = &patronflags($patron);
116 This function is not exported.
118 The following will be set where applicable:
119 $flags->{CHARGES}->{amount} Amount of debt
120 $flags->{CHARGES}->{noissues} Set if debt amount >$5.00 (or syspref noissuescharge)
121 $flags->{CHARGES}->{message} Message -- deprecated
123 $flags->{CREDITS}->{amount} Amount of credit
124 $flags->{CREDITS}->{message} Message -- deprecated
126 $flags->{ GNA } Patron has no valid address
127 $flags->{ GNA }->{noissues} Set for each GNA
128 $flags->{ GNA }->{message} "Borrower has no valid address" -- deprecated
130 $flags->{ LOST } Patron's card reported lost
131 $flags->{ LOST }->{noissues} Set for each LOST
132 $flags->{ LOST }->{message} Message -- deprecated
134 $flags->{DBARRED} Set if patron debarred, no access
135 $flags->{DBARRED}->{noissues} Set for each DBARRED
136 $flags->{DBARRED}->{message} Message -- deprecated
139 $flags->{ NOTES }->{message} The note itself. NOT deprecated
141 $flags->{ ODUES } Set if patron has overdue books.
142 $flags->{ ODUES }->{message} "Yes" -- deprecated
143 $flags->{ ODUES }->{itemlist} ref-to-array: list of overdue books
144 $flags->{ ODUES }->{itemlisttext} Text list of overdue items -- deprecated
146 $flags->{WAITING} Set if any of patron's reserves are available
147 $flags->{WAITING}->{message} Message -- deprecated
148 $flags->{WAITING}->{itemlist} ref-to-array: list of available items
152 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the
153 overdue items. Its elements are references-to-hash, each describing an
154 overdue item. The keys are selected fields from the issues, biblio,
155 biblioitems, and items tables of the Koha database.
157 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlisttext}> is a string giving a text listing of
158 the overdue items, one per line. Deprecated.
160 =item C<$flags-E<gt>{WAITING}-E<gt>{itemlist}> is a reference-to-array listing the
161 available items. Each element is a reference-to-hash whose keys are
162 fields from the reserves table of the Koha database.
166 All the "message" fields that include language generated in this function are deprecated,
167 because such strings belong properly in the display layer.
169 The "message" field that comes from the DB is OK.
173 # TODO: use {anonymous => hashes} instead of a dozen %flaginfo
174 # FIXME rename this function.
177 my ( $patroninformation) = @_;
178 my $dbh=C4::Context->dbh;
179 my $patron = Koha::Patrons->find( $patroninformation->{borrowernumber} );
180 my $account = $patron->account;
181 my $owing = $account->non_issues_charges;
184 my $noissuescharge = C4::Context->preference("noissuescharge") || 5;
185 $flaginfo{'message'} = sprintf 'Patron owes %.02f', $owing;
186 $flaginfo{'amount'} = sprintf "%.02f", $owing;
187 if ( $owing > $noissuescharge && !C4::Context->preference("AllowFineOverride") ) {
188 $flaginfo{'noissues'} = 1;
190 $flags{'CHARGES'} = \%flaginfo;
192 elsif ( ( my $balance = $account->balance ) < 0 ) {
194 $flaginfo{'message'} = sprintf 'Patron has credit of %.02f', -$balance;
195 $flaginfo{'amount'} = sprintf "%.02f", $balance;
196 $flags{'CREDITS'} = \%flaginfo;
199 # Check the debt of the guarntees of this patron
200 my $no_issues_charge_guarantees = C4::Context->preference("NoIssuesChargeGuarantees");
201 $no_issues_charge_guarantees = undef unless looks_like_number( $no_issues_charge_guarantees );
202 if ( defined $no_issues_charge_guarantees ) {
203 my $p = Koha::Patrons->find( $patroninformation->{borrowernumber} );
204 my @guarantees = $p->guarantees();
205 my $guarantees_non_issues_charges;
206 foreach my $g ( @guarantees ) {
207 $guarantees_non_issues_charges += $g->account->non_issues_charges;
210 if ( $guarantees_non_issues_charges > $no_issues_charge_guarantees ) {
212 $flaginfo{'message'} = sprintf 'patron guarantees owe %.02f', $guarantees_non_issues_charges;
213 $flaginfo{'amount'} = $guarantees_non_issues_charges;
214 $flaginfo{'noissues'} = 1 unless C4::Context->preference("allowfineoverride");
215 $flags{'CHARGES_GUARANTEES'} = \%flaginfo;
219 if ( $patroninformation->{'gonenoaddress'}
220 && $patroninformation->{'gonenoaddress'} == 1 )
223 $flaginfo{'message'} = 'Borrower has no valid address.';
224 $flaginfo{'noissues'} = 1;
225 $flags{'GNA'} = \%flaginfo;
227 if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
229 $flaginfo{'message'} = 'Borrower\'s card reported lost.';
230 $flaginfo{'noissues'} = 1;
231 $flags{'LOST'} = \%flaginfo;
233 if ( $patroninformation->{'debarred'} && check_date( split( /-/, $patroninformation->{'debarred'} ) ) ) {
234 if ( Date_to_Days(Date::Calc::Today) < Date_to_Days( split( /-/, $patroninformation->{'debarred'} ) ) ) {
236 $flaginfo{'debarredcomment'} = $patroninformation->{'debarredcomment'};
237 $flaginfo{'message'} = $patroninformation->{'debarredcomment'};
238 $flaginfo{'noissues'} = 1;
239 $flaginfo{'dateend'} = $patroninformation->{'debarred'};
240 $flags{'DBARRED'} = \%flaginfo;
243 if ( $patroninformation->{'borrowernotes'}
244 && $patroninformation->{'borrowernotes'} )
247 $flaginfo{'message'} = $patroninformation->{'borrowernotes'};
248 $flags{'NOTES'} = \%flaginfo;
250 my ( $odues, $itemsoverdue ) = C4::Overdues::checkoverdues($patroninformation->{'borrowernumber'});
251 if ( $odues && $odues > 0 ) {
253 $flaginfo{'message'} = "Yes";
254 $flaginfo{'itemlist'} = $itemsoverdue;
255 foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
258 $flaginfo{'itemlisttext'} .=
259 "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n"; # newline is display layer
261 $flags{'ODUES'} = \%flaginfo;
264 my $waiting_holds = $patron->holds->search({ found => 'W' });
265 my $nowaiting = $waiting_holds->count;
266 if ( $nowaiting > 0 ) {
268 $flaginfo{'message'} = "Reserved items available";
269 $flaginfo{'itemlist'} = $waiting_holds->unblessed;
270 $flags{'WAITING'} = \%flaginfo;
278 my $success = ModMember(borrowernumber => $borrowernumber,
279 [ field => value ]... );
281 Modify borrower's data. All date fields should ALREADY be in ISO format.
284 true on success, or false on failure
291 # trim whitespace from data which has some non-whitespace in it.
292 foreach my $field_name (keys(%data)) {
293 if ( defined $data{$field_name} && $data{$field_name} =~ /\S/ ) {
294 $data{$field_name} =~ s/^\s*|\s*$//g;
298 # test to know if you must update or not the borrower password
299 if (exists $data{password}) {
300 if ($data{password} eq '****' or $data{password} eq '') {
301 delete $data{password};
303 if ( C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
304 # Update the hashed PIN in borrower_sync.hashed_pin, before Koha hashes it
305 Koha::NorwegianPatronDB::NLUpdateHashedPIN( $data{'borrowernumber'}, $data{password} );
307 $data{password} = hash_password($data{password});
311 my $old_categorycode = Koha::Patrons->find( $data{borrowernumber} )->categorycode;
313 # get only the columns of a borrower
314 my $schema = Koha::Database->new()->schema;
315 my @columns = $schema->source('Borrower')->columns;
316 my $new_borrower = { map { join(' ', @columns) =~ /$_/ ? ( $_ => $data{$_} ) : () } keys(%data) };
318 $new_borrower->{dateofbirth} ||= undef if exists $new_borrower->{dateofbirth};
319 $new_borrower->{dateenrolled} ||= undef if exists $new_borrower->{dateenrolled};
320 $new_borrower->{dateexpiry} ||= undef if exists $new_borrower->{dateexpiry};
321 $new_borrower->{debarred} ||= undef if exists $new_borrower->{debarred};
322 $new_borrower->{sms_provider_id} ||= undef if exists $new_borrower->{sms_provider_id};
323 $new_borrower->{guarantorid} ||= undef if exists $new_borrower->{guarantorid};
325 my $patron = Koha::Patrons->find( $new_borrower->{borrowernumber} );
327 delete $new_borrower->{userid} if exists $new_borrower->{userid} and not $new_borrower->{userid};
329 my $execute_success = $patron->store if $patron->set($new_borrower);
331 if ($execute_success) { # only proceed if the update was a success
332 # If the patron changes to a category with enrollment fee, we add a fee
333 if ( $data{categorycode} and $data{categorycode} ne $old_categorycode ) {
334 if ( C4::Context->preference('FeeOnChangePatronCategory') ) {
335 $patron->add_enrolment_fee_if_needed;
339 # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
340 # cronjob will use for syncing with NL
341 if ( C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
342 my $borrowersync = Koha::Database->new->schema->resultset('BorrowerSync')->find({
343 'synctype' => 'norwegianpatrondb',
344 'borrowernumber' => $data{'borrowernumber'}
346 # Do not set to "edited" if syncstatus is "new". We need to sync as new before
347 # we can sync as changed. And the "new sync" will pick up all changes since
348 # the patron was created anyway.
349 if ( $borrowersync->syncstatus ne 'new' && $borrowersync->syncstatus ne 'delete' ) {
350 $borrowersync->update( { 'syncstatus' => 'edited' } );
352 # Set the value of 'sync'
353 $borrowersync->update( { 'sync' => $data{'sync'} } );
354 # Try to do the live sync
355 Koha::NorwegianPatronDB::NLSync({ 'borrowernumber' => $data{'borrowernumber'} });
358 logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "UPDATE (executed w/ arg: $data{'borrowernumber'})") if C4::Context->preference("BorrowersLog");
360 return $execute_success;
365 $borrowernumber = &AddMember(%borrower);
367 insert new borrower into table
369 (%borrower keys are database columns. Database columns could be
370 different in different versions. Please look into database for correct
373 Returns the borrowernumber upon success
375 Returns as undef upon any db error without further processing
382 my $dbh = C4::Context->dbh;
383 my $schema = Koha::Database->new()->schema;
385 my $category = Koha::Patron::Categories->find( $data{categorycode} );
387 Koha::Exceptions::BadParameter->throw(
388 error => 'Invalid parameter passed',
389 parameter => 'categorycode'
393 # trim whitespace from data which has some non-whitespace in it.
394 foreach my $field_name (keys(%data)) {
395 if ( defined $data{$field_name} && $data{$field_name} =~ /\S/ ) {
396 $data{$field_name} =~ s/^\s*|\s*$//g;
400 # generate a proper login if none provided
401 $data{'userid'} = Generate_Userid( $data{'borrowernumber'}, $data{'firstname'}, $data{'surname'} )
402 if ( $data{'userid'} eq '' || !Check_Userid( $data{'userid'} ) );
404 # add expiration date if it isn't already there
405 $data{dateexpiry} ||= $category->get_expiry_date;
407 # add enrollment date if it isn't already there
408 unless ( $data{'dateenrolled'} ) {
409 $data{'dateenrolled'} = output_pref( { dt => dt_from_string, dateonly => 1, dateformat => 'iso' } );
412 if ( C4::Context->preference("autoMemberNum") ) {
413 if ( not exists $data{cardnumber} or not defined $data{cardnumber} or $data{cardnumber} eq '' ) {
414 $data{cardnumber} = fixup_cardnumber( $data{cardnumber} );
419 $category->default_privacy() eq 'default' ? 1
420 : $category->default_privacy() eq 'never' ? 2
421 : $category->default_privacy() eq 'forever' ? 0
424 $data{'privacy_guarantor_checkouts'} = 0 unless defined( $data{'privacy_guarantor_checkouts'} );
426 # Make a copy of the plain text password for later use
427 my $plain_text_password = $data{'password'};
429 # create a disabled account if no password provided
430 $data{'password'} = ($data{'password'})? hash_password($data{'password'}) : '!';
432 # we don't want invalid dates in the db (mysql has a bad habit of inserting 0000-00-00
433 $data{'dateofbirth'} = undef if ( not $data{'dateofbirth'} );
434 $data{'debarred'} = undef if ( not $data{'debarred'} );
435 $data{'sms_provider_id'} = undef if ( not $data{'sms_provider_id'} );
436 $data{'guarantorid'} = undef if ( not $data{'guarantorid'} );
438 # get only the columns of Borrower
439 # FIXME Do we really need this check?
440 my @columns = $schema->source('Borrower')->columns;
441 my $new_member = { map { join(' ',@columns) =~ /$_/ ? ( $_ => $data{$_} ) : () } keys(%data) } ;
443 delete $new_member->{borrowernumber};
445 my $patron = Koha::Patron->new( $new_member )->store;
446 $data{borrowernumber} = $patron->borrowernumber;
448 # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
449 # cronjob will use for syncing with NL
450 if ( exists $data{'borrowernumber'} && C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
451 Koha::Database->new->schema->resultset('BorrowerSync')->create({
452 'borrowernumber' => $data{'borrowernumber'},
453 'synctype' => 'norwegianpatrondb',
455 'syncstatus' => 'new',
456 'hashed_pin' => Koha::NorwegianPatronDB::NLEncryptPIN( $plain_text_password ),
460 logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");
462 $patron->add_enrolment_fee_if_needed;
464 return $data{borrowernumber};
469 my $uniqueness = Check_Userid($userid,$borrowernumber);
471 $borrowernumber is optional (i.e. it can contain a blank value). If $userid is passed with a blank $borrowernumber variable, the database will be checked for all instances of that userid (i.e. userid=? AND borrowernumber != '').
473 If $borrowernumber is provided, the database will be checked for every instance of that userid coupled with a different borrower(number) than the one provided.
476 0 for not unique (i.e. this $userid already exists)
477 1 for unique (i.e. this $userid does not exist, or this $userid/$borrowernumber combination already exists)
482 my ( $uid, $borrowernumber ) = @_;
484 return 0 unless ($uid); # userid is a unique column, we should assume NULL is not unique
486 return 0 if ( $uid eq C4::Context->config('user') );
488 my $rs = Koha::Database->new()->schema()->resultset('Borrower');
491 $params->{userid} = $uid;
492 $params->{borrowernumber} = { '!=' => $borrowernumber } if ($borrowernumber);
494 my $count = $rs->count( $params );
496 return $count ? 0 : 1;
499 =head2 Generate_Userid
501 my $newuid = Generate_Userid($borrowernumber, $firstname, $surname);
503 Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
505 $borrowernumber is optional (i.e. it can contain a blank value). A value is passed when generating a new userid for an existing borrower. When a new userid is created for a new borrower, a blank value is passed to this sub.
508 new userid ($firstname.$surname if there is a $firstname, or $surname if there is no value in $firstname) plus offset (0 if the $newuid is unique, or a higher numeric value if Check_Userid finds an existing match for the $newuid in the database).
512 sub Generate_Userid {
513 my ($borrowernumber, $firstname, $surname) = @_;
516 #The script will "do" the following code and increment the $offset until Check_Userid = 1 (i.e. until $newuid comes back as unique)
518 $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
519 $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
520 $newuid = lc(($firstname)? "$firstname.$surname" : $surname);
521 $newuid = unac_string('utf-8',$newuid);
522 $newuid .= $offset unless $offset == 0;
525 } while (!Check_Userid($newuid,$borrowernumber));
530 =head2 fixup_cardnumber
532 Warning: The caller is responsible for locking the members table in write
533 mode, to avoid database corruption.
537 sub fixup_cardnumber {
538 my ($cardnumber) = @_;
539 my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0;
541 # Find out whether member numbers should be generated
542 # automatically. Should be either "1" or something else.
543 # Defaults to "0", which is interpreted as "no".
545 ($autonumber_members) or return $cardnumber;
546 my $dbh = C4::Context->dbh;
548 my $sth = $dbh->prepare(
549 'SELECT MAX( CAST( cardnumber AS SIGNED ) ) FROM borrowers WHERE cardnumber REGEXP "^-?[0-9]+$"'
552 my ($result) = $sth->fetchrow;
556 =head2 GetPendingIssues
558 my $issues = &GetPendingIssues(@borrowernumber);
560 Looks up what the patron with the given borrowernumber has borrowed.
562 C<&GetPendingIssues> returns a
563 reference-to-array where each element is a reference-to-hash; the
564 keys are the fields from the C<issues>, C<biblio>, and C<items> tables.
565 The keys include C<biblioitems> fields.
569 sub GetPendingIssues {
570 my @borrowernumbers = @_;
572 unless (@borrowernumbers ) { # return a ref_to_array
573 return \@borrowernumbers; # to not cause surprise to caller
576 # Borrowers part of the query
578 for (my $i = 0; $i < @borrowernumbers; $i++) {
579 $bquery .= ' issues.borrowernumber = ?';
580 if ($i < $#borrowernumbers ) {
585 # FIXME: namespace collision: each table has "timestamp" fields. Which one is "timestamp" ?
586 # FIXME: circ/ciculation.pl tries to sort by timestamp!
587 # FIXME: namespace collision: other collisions possible.
588 # FIXME: most of this data isn't really being used by callers.
595 biblioitems.itemtype,
598 biblioitems.publicationyear,
599 biblioitems.publishercode,
600 biblioitems.volumedate,
601 biblioitems.volumedesc,
606 borrowers.cardnumber,
607 issues.timestamp AS timestamp,
608 issues.renewals AS renewals,
609 issues.borrowernumber AS borrowernumber,
610 items.renewals AS totalrenewals
612 LEFT JOIN items ON items.itemnumber = issues.itemnumber
613 LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
614 LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
615 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
618 ORDER BY issues.issuedate"
621 my $sth = C4::Context->dbh->prepare($query);
622 $sth->execute(@borrowernumbers);
623 my $data = $sth->fetchall_arrayref({});
624 my $today = dt_from_string;
626 if ($_->{issuedate}) {
627 $_->{issuedate} = dt_from_string($_->{issuedate}, 'sql');
629 $_->{date_due_sql} = $_->{date_due};
630 # FIXME no need to have this value
631 $_->{date_due} or next;
632 $_->{date_due_sql} = $_->{date_due};
633 # FIXME no need to have this value
634 $_->{date_due} = dt_from_string($_->{date_due}, 'sql');
635 if ( DateTime->compare($_->{date_due}, $today) == -1 ) {
644 $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
646 Looks up what the patron with the given borrowernumber has borrowed,
647 and sorts the results.
649 C<$sortkey> is the name of a field on which to sort the results. This
650 should be the name of a field in the C<issues>, C<biblio>,
651 C<biblioitems>, or C<items> table in the Koha database.
653 C<$limit> is the maximum number of results to return.
655 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
656 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
657 C<items> tables of the Koha database.
663 my ( $borrowernumber, $order, $limit ) = @_;
665 return unless $borrowernumber;
666 $order = 'date_due desc' unless $order;
668 my $dbh = C4::Context->dbh;
670 'SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
672 LEFT JOIN items on items.itemnumber=issues.itemnumber
673 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
674 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
675 WHERE borrowernumber=?
677 SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
679 LEFT JOIN items on items.itemnumber=old_issues.itemnumber
680 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
681 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
682 WHERE borrowernumber=? AND old_issues.itemnumber IS NOT NULL
685 $query .= " limit $limit";
688 my $sth = $dbh->prepare($query);
689 $sth->execute( $borrowernumber, $borrowernumber );
690 return $sth->fetchall_arrayref( {} );
693 sub checkcardnumber {
694 my ( $cardnumber, $borrowernumber ) = @_;
696 # If cardnumber is null, we assume they're allowed.
697 return 0 unless defined $cardnumber;
699 my $dbh = C4::Context->dbh;
700 my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
701 $query .= " AND borrowernumber <> ?" if ($borrowernumber);
702 my $sth = $dbh->prepare($query);
705 ( $borrowernumber ? $borrowernumber : () )
708 return 1 if $sth->fetchrow_hashref;
710 my ( $min_length, $max_length ) = get_cardnumber_length();
712 if length $cardnumber > $max_length
713 or length $cardnumber < $min_length;
718 =head2 get_cardnumber_length
720 my ($min, $max) = C4::Members::get_cardnumber_length()
722 Returns the minimum and maximum length for patron cardnumbers as
723 determined by the CardnumberLength system preference, the
724 BorrowerMandatoryField system preference, and the width of the
729 sub get_cardnumber_length {
730 my $borrower = Koha::Schema->resultset('Borrower');
731 my $field_size = $borrower->result_source->column_info('cardnumber')->{size};
732 my ( $min, $max ) = ( 0, $field_size ); # borrowers.cardnumber is a nullable varchar(20)
733 $min = 1 if C4::Context->preference('BorrowerMandatoryField') =~ /cardnumber/;
734 if ( my $cardnumber_length = C4::Context->preference('CardnumberLength') ) {
735 # Is integer and length match
736 if ( $cardnumber_length =~ m|^\d+$| ) {
737 $min = $max = $cardnumber_length
738 if $cardnumber_length >= $min
739 and $cardnumber_length <= $max;
741 # Else assuming it is a range
742 elsif ( $cardnumber_length =~ m|(\d*),(\d*)| ) {
743 $min = $1 if $1 and $min < $1;
744 $max = $2 if $2 and $max > $2;
748 $min = $max if $min > $max;
749 return ( $min, $max );
752 =head2 GetBorrowersToExpunge
754 $borrowers = &GetBorrowersToExpunge(
755 not_borrowed_since => $not_borrowed_since,
756 expired_before => $expired_before,
757 category_code => $category_code,
758 patron_list_id => $patron_list_id,
759 branchcode => $branchcode
762 This function get all borrowers based on the given criteria.
766 sub GetBorrowersToExpunge {
769 my $filterdate = $params->{'not_borrowed_since'};
770 my $filterexpiry = $params->{'expired_before'};
771 my $filterlastseen = $params->{'last_seen'};
772 my $filtercategory = $params->{'category_code'};
773 my $filterbranch = $params->{'branchcode'} ||
774 ((C4::Context->preference('IndependentBranches')
775 && C4::Context->userenv
776 && !C4::Context->IsSuperLibrarian()
777 && C4::Context->userenv->{branch})
778 ? C4::Context->userenv->{branch}
780 my $filterpatronlist = $params->{'patron_list_id'};
782 my $dbh = C4::Context->dbh;
786 SELECT borrowers.borrowernumber,
787 MAX(old_issues.timestamp) AS latestissue,
788 MAX(issues.timestamp) AS currentissue
790 JOIN categories USING (categorycode)
794 WHERE guarantorid IS NOT NULL
796 ) as tmp ON borrowers.borrowernumber=tmp.guarantorid
797 LEFT JOIN old_issues USING (borrowernumber)
798 LEFT JOIN issues USING (borrowernumber)|;
799 if ( $filterpatronlist ){
800 $query .= q| LEFT JOIN patron_list_patrons USING (borrowernumber)|;
802 $query .= q| WHERE category_type <> 'S'
803 AND tmp.guarantorid IS NULL
806 if ( $filterbranch && $filterbranch ne "" ) {
807 $query.= " AND borrowers.branchcode = ? ";
808 push( @query_params, $filterbranch );
810 if ( $filterexpiry ) {
811 $query .= " AND dateexpiry < ? ";
812 push( @query_params, $filterexpiry );
814 if ( $filterlastseen ) {
815 $query .= ' AND lastseen < ? ';
816 push @query_params, $filterlastseen;
818 if ( $filtercategory ) {
819 $query .= " AND categorycode = ? ";
820 push( @query_params, $filtercategory );
822 if ( $filterpatronlist ){
823 $query.=" AND patron_list_id = ? ";
824 push( @query_params, $filterpatronlist );
826 $query .= " GROUP BY borrowers.borrowernumber";
828 ) xxx WHERE currentissue IS NULL|;
830 $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
831 push @query_params,$filterdate;
834 warn $query if $debug;
836 my $sth = $dbh->prepare($query);
837 if (scalar(@query_params)>0){
838 $sth->execute(@query_params);
845 while ( my $data = $sth->fetchrow_hashref ) {
846 push @results, $data;
853 IssueSlip($branchcode, $borrowernumber, $quickslip)
855 Returns letter hash ( see C4::Letters::GetPreparedLetter )
857 $quickslip is boolean, to indicate whether we want a quick slip
859 IssueSlip populates ISSUESLIP and ISSUEQSLIP, and will make the following expansions:
895 NOTE: Not all table fields are available, pleasee see GetPendingIssues for a list of available fields.
900 my ($branch, $borrowernumber, $quickslip) = @_;
902 # FIXME Check callers before removing this statement
903 #return unless $borrowernumber;
905 my $patron = Koha::Patrons->find( $borrowernumber );
906 return unless $patron;
908 my @issues = @{ GetPendingIssues($borrowernumber) };
910 for my $issue (@issues) {
911 $issue->{date_due} = $issue->{date_due_sql};
913 my $today = output_pref({ dt => dt_from_string, dateformat => 'iso', dateonly => 1 });
914 if ( substr( $issue->{issuedate}, 0, 10 ) eq $today
915 or substr( $issue->{lastreneweddate}, 0, 10 ) eq $today ) {
921 # Sort on timestamp then on issuedate then on issue_id
922 # useful for tests and could be if modified in a batch
924 $b->{timestamp} <=> $a->{timestamp}
925 or $b->{issuedate} <=> $a->{issuedate}
926 or $b->{issue_id} <=> $a->{issue_id}
929 my ($letter_code, %repeat, %loops);
931 $letter_code = 'ISSUEQSLIP';
932 my @checkouts = map {
937 }, grep { $_->{'now'} } @issues;
939 checkedout => \@checkouts, # History syntax
942 issues => [ map { $_->{issues}{itemnumber} } @checkouts ], # TT syntax
946 my @checkouts = map {
951 }, grep { !$_->{'overdue'} } @issues;
957 }, grep { $_->{'overdue'} } @issues;
958 my $news = GetNewsToDisplay( "slip", $branch );
960 $_->{'timestamp'} = $_->{'newdate'};
963 $letter_code = 'ISSUESLIP';
965 checkedout => \@checkouts,
966 overdue => \@overdues,
970 issues => [ map { $_->{issues}{itemnumber} } @checkouts ],
971 overdues => [ map { $_->{issues}{itemnumber} } @overdues ],
972 opac_news => [ map { $_->{opac_news}{idnew} } @news ],
976 return C4::Letters::GetPreparedLetter (
977 module => 'circulation',
978 letter_code => $letter_code,
979 branchcode => $branch,
980 lang => $patron->lang,
982 'branches' => $branch,
983 'borrowers' => $borrowernumber,
990 =head2 AddMember_Auto
995 my ( %borrower ) = @_;
997 $borrower{'cardnumber'} ||= fixup_cardnumber();
999 $borrower{'borrowernumber'} = AddMember(%borrower);
1001 return ( %borrower );
1004 =head2 AddMember_Opac
1008 sub AddMember_Opac {
1009 my ( %borrower ) = @_;
1011 $borrower{'categorycode'} //= C4::Context->preference('PatronSelfRegistrationDefaultCategory');
1012 if (not defined $borrower{'password'}){
1013 my $sr = new String::Random;
1014 $sr->{'A'} = [ 'A'..'Z', 'a'..'z' ];
1015 my $password = $sr->randpattern("AAAAAAAAAA");
1016 $borrower{'password'} = $password;
1019 %borrower = AddMember_Auto(%borrower);
1021 return ( $borrower{'borrowernumber'}, $borrower{'password'} );
1024 =head2 DeleteExpiredOpacRegistrations
1026 Delete accounts that haven't been upgraded from the 'temporary' category
1027 Returns the number of removed patrons
1031 sub DeleteExpiredOpacRegistrations {
1033 my $delay = C4::Context->preference('PatronSelfRegistrationExpireTemporaryAccountsDelay');
1034 my $category_code = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
1036 return 0 if not $category_code or not defined $delay or $delay eq q||;
1039 SELECT borrowernumber
1041 WHERE categorycode = ? AND DATEDIFF( NOW(), dateenrolled ) > ? |;
1043 my $dbh = C4::Context->dbh;
1044 my $sth = $dbh->prepare($query);
1045 $sth->execute( $category_code, $delay );
1047 while ( my ($borrowernumber) = $sth->fetchrow_array() ) {
1048 Koha::Patrons->find($borrowernumber)->delete;
1054 =head2 DeleteUnverifiedOpacRegistrations
1056 Delete all unverified self registrations in borrower_modifications,
1057 older than the specified number of days.
1061 sub DeleteUnverifiedOpacRegistrations {
1063 my $dbh = C4::Context->dbh;
1065 DELETE FROM borrower_modifications
1066 WHERE borrowernumber = 0 AND DATEDIFF( NOW(), timestamp ) > ?|;
1067 my $cnt=$dbh->do($sql, undef, ($days) );
1068 return $cnt eq '0E0'? 0: $cnt;
1071 sub GetOverduesForPatron {
1072 my ( $borrowernumber ) = @_;
1076 FROM issues, items, biblio, biblioitems
1077 WHERE items.itemnumber=issues.itemnumber
1078 AND biblio.biblionumber = items.biblionumber
1079 AND biblio.biblionumber = biblioitems.biblionumber
1080 AND issues.borrowernumber = ?
1081 AND date_due < NOW()
1084 my $sth = C4::Context->dbh->prepare( $sql );
1085 $sth->execute( $borrowernumber );
1087 return $sth->fetchall_arrayref({});
1090 END { } # module clean-up code here (global destructor)