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;
69 &GetBorrowersToExpunge
99 C4::Members - Perl Module containing convenience functions for member handling
107 This module contains routines for adding, modifying and deleting members/patrons/borrowers
113 $flags = &patronflags($patron);
115 This function is not exported.
117 The following will be set where applicable:
118 $flags->{CHARGES}->{amount} Amount of debt
119 $flags->{CHARGES}->{noissues} Set if debt amount >$5.00 (or syspref noissuescharge)
120 $flags->{CHARGES}->{message} Message -- deprecated
122 $flags->{CREDITS}->{amount} Amount of credit
123 $flags->{CREDITS}->{message} Message -- deprecated
125 $flags->{ GNA } Patron has no valid address
126 $flags->{ GNA }->{noissues} Set for each GNA
127 $flags->{ GNA }->{message} "Borrower has no valid address" -- deprecated
129 $flags->{ LOST } Patron's card reported lost
130 $flags->{ LOST }->{noissues} Set for each LOST
131 $flags->{ LOST }->{message} Message -- deprecated
133 $flags->{DBARRED} Set if patron debarred, no access
134 $flags->{DBARRED}->{noissues} Set for each DBARRED
135 $flags->{DBARRED}->{message} Message -- deprecated
138 $flags->{ NOTES }->{message} The note itself. NOT deprecated
140 $flags->{ ODUES } Set if patron has overdue books.
141 $flags->{ ODUES }->{message} "Yes" -- deprecated
142 $flags->{ ODUES }->{itemlist} ref-to-array: list of overdue books
143 $flags->{ ODUES }->{itemlisttext} Text list of overdue items -- deprecated
145 $flags->{WAITING} Set if any of patron's reserves are available
146 $flags->{WAITING}->{message} Message -- deprecated
147 $flags->{WAITING}->{itemlist} ref-to-array: list of available items
151 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the
152 overdue items. Its elements are references-to-hash, each describing an
153 overdue item. The keys are selected fields from the issues, biblio,
154 biblioitems, and items tables of the Koha database.
156 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlisttext}> is a string giving a text listing of
157 the overdue items, one per line. Deprecated.
159 =item C<$flags-E<gt>{WAITING}-E<gt>{itemlist}> is a reference-to-array listing the
160 available items. Each element is a reference-to-hash whose keys are
161 fields from the reserves table of the Koha database.
165 All the "message" fields that include language generated in this function are deprecated,
166 because such strings belong properly in the display layer.
168 The "message" field that comes from the DB is OK.
172 # TODO: use {anonymous => hashes} instead of a dozen %flaginfo
173 # FIXME rename this function.
174 # DEPRECATED Do not use this subroutine!
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 my $borrowers_log = C4::Context->preference("BorrowersLog");
328 if ( $borrowers_log && $patron->cardnumber ne $new_borrower->{cardnumber} )
333 $data{'borrowernumber'},
336 cardnumber_replaced => {
337 previous_cardnumber => $patron->cardnumber,
338 new_cardnumber => $new_borrower->{cardnumber},
341 { utf8 => 1, pretty => 1 }
346 delete $new_borrower->{userid} if exists $new_borrower->{userid} and not $new_borrower->{userid};
348 my $execute_success = $patron->store if $patron->set($new_borrower);
350 if ($execute_success) { # only proceed if the update was a success
351 # If the patron changes to a category with enrollment fee, we add a fee
352 if ( $data{categorycode} and $data{categorycode} ne $old_categorycode ) {
353 if ( C4::Context->preference('FeeOnChangePatronCategory') ) {
354 $patron->add_enrolment_fee_if_needed;
358 # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
359 # cronjob will use for syncing with NL
360 if ( C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
361 my $borrowersync = Koha::Database->new->schema->resultset('BorrowerSync')->find({
362 'synctype' => 'norwegianpatrondb',
363 'borrowernumber' => $data{'borrowernumber'}
365 # Do not set to "edited" if syncstatus is "new". We need to sync as new before
366 # we can sync as changed. And the "new sync" will pick up all changes since
367 # the patron was created anyway.
368 if ( $borrowersync->syncstatus ne 'new' && $borrowersync->syncstatus ne 'delete' ) {
369 $borrowersync->update( { 'syncstatus' => 'edited' } );
371 # Set the value of 'sync'
372 $borrowersync->update( { 'sync' => $data{'sync'} } );
373 # Try to do the live sync
374 Koha::NorwegianPatronDB::NLSync({ 'borrowernumber' => $data{'borrowernumber'} });
377 logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "UPDATE (executed w/ arg: $data{'borrowernumber'})") if $borrowers_log;
379 return $execute_success;
384 $borrowernumber = &AddMember(%borrower);
386 insert new borrower into table
388 (%borrower keys are database columns. Database columns could be
389 different in different versions. Please look into database for correct
392 Returns the borrowernumber upon success
394 Returns as undef upon any db error without further processing
401 my $dbh = C4::Context->dbh;
402 my $schema = Koha::Database->new()->schema;
404 my $category = Koha::Patron::Categories->find( $data{categorycode} );
406 Koha::Exceptions::BadParameter->throw(
407 error => 'Invalid parameter passed',
408 parameter => 'categorycode'
412 # trim whitespace from data which has some non-whitespace in it.
413 foreach my $field_name (keys(%data)) {
414 if ( defined $data{$field_name} && $data{$field_name} =~ /\S/ ) {
415 $data{$field_name} =~ s/^\s*|\s*$//g;
419 # generate a proper login if none provided
420 $data{'userid'} = Generate_Userid( $data{'borrowernumber'}, $data{'firstname'}, $data{'surname'} )
421 if ( $data{'userid'} eq '' || !Check_Userid( $data{'userid'} ) );
423 # add expiration date if it isn't already there
424 $data{dateexpiry} ||= $category->get_expiry_date;
426 # add enrollment date if it isn't already there
427 unless ( $data{'dateenrolled'} ) {
428 $data{'dateenrolled'} = output_pref( { dt => dt_from_string, dateonly => 1, dateformat => 'iso' } );
431 if ( C4::Context->preference("autoMemberNum") ) {
432 if ( not exists $data{cardnumber} or not defined $data{cardnumber} or $data{cardnumber} eq '' ) {
433 $data{cardnumber} = fixup_cardnumber( $data{cardnumber} );
438 $category->default_privacy() eq 'default' ? 1
439 : $category->default_privacy() eq 'never' ? 2
440 : $category->default_privacy() eq 'forever' ? 0
443 $data{'privacy_guarantor_checkouts'} = 0 unless defined( $data{'privacy_guarantor_checkouts'} );
445 # Make a copy of the plain text password for later use
446 my $plain_text_password = $data{'password'};
448 # create a disabled account if no password provided
449 $data{'password'} = ($data{'password'})? hash_password($data{'password'}) : '!';
451 # we don't want invalid dates in the db (mysql has a bad habit of inserting 0000-00-00
452 $data{'dateofbirth'} = undef if ( not $data{'dateofbirth'} );
453 $data{'debarred'} = undef if ( not $data{'debarred'} );
454 $data{'sms_provider_id'} = undef if ( not $data{'sms_provider_id'} );
455 $data{'guarantorid'} = undef if ( not $data{'guarantorid'} );
457 # get only the columns of Borrower
458 # FIXME Do we really need this check?
459 my @columns = $schema->source('Borrower')->columns;
460 my $new_member = { map { join(' ',@columns) =~ /$_/ ? ( $_ => $data{$_} ) : () } keys(%data) } ;
462 delete $new_member->{borrowernumber};
464 my $patron = Koha::Patron->new( $new_member )->store;
465 $data{borrowernumber} = $patron->borrowernumber;
467 # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
468 # cronjob will use for syncing with NL
469 if ( exists $data{'borrowernumber'} && C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) {
470 Koha::Database->new->schema->resultset('BorrowerSync')->create({
471 'borrowernumber' => $data{'borrowernumber'},
472 'synctype' => 'norwegianpatrondb',
474 'syncstatus' => 'new',
475 'hashed_pin' => Koha::NorwegianPatronDB::NLEncryptPIN( $plain_text_password ),
479 logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");
481 $patron->add_enrolment_fee_if_needed;
483 return $data{borrowernumber};
488 my $uniqueness = Check_Userid($userid,$borrowernumber);
490 $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 != '').
492 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.
495 0 for not unique (i.e. this $userid already exists)
496 1 for unique (i.e. this $userid does not exist, or this $userid/$borrowernumber combination already exists)
501 my ( $uid, $borrowernumber ) = @_;
503 return 0 unless ($uid); # userid is a unique column, we should assume NULL is not unique
505 return 0 if ( $uid eq C4::Context->config('user') );
507 my $rs = Koha::Database->new()->schema()->resultset('Borrower');
510 $params->{userid} = $uid;
511 $params->{borrowernumber} = { '!=' => $borrowernumber } if ($borrowernumber);
513 my $count = $rs->count( $params );
515 return $count ? 0 : 1;
518 =head2 Generate_Userid
520 my $newuid = Generate_Userid($borrowernumber, $firstname, $surname);
522 Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
524 $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.
527 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).
531 sub Generate_Userid {
532 my ($borrowernumber, $firstname, $surname) = @_;
535 #The script will "do" the following code and increment the $offset until Check_Userid = 1 (i.e. until $newuid comes back as unique)
537 $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
538 $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
539 $newuid = lc(($firstname)? "$firstname.$surname" : $surname);
540 $newuid = unac_string('utf-8',$newuid);
541 $newuid .= $offset unless $offset == 0;
544 } while (!Check_Userid($newuid,$borrowernumber));
549 =head2 fixup_cardnumber
551 Warning: The caller is responsible for locking the members table in write
552 mode, to avoid database corruption.
556 sub fixup_cardnumber {
557 my ($cardnumber) = @_;
558 my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0;
560 # Find out whether member numbers should be generated
561 # automatically. Should be either "1" or something else.
562 # Defaults to "0", which is interpreted as "no".
564 ($autonumber_members) or return $cardnumber;
565 my $dbh = C4::Context->dbh;
567 my $sth = $dbh->prepare(
568 'SELECT MAX( CAST( cardnumber AS SIGNED ) ) FROM borrowers WHERE cardnumber REGEXP "^-?[0-9]+$"'
571 my ($result) = $sth->fetchrow;
575 =head2 GetPendingIssues
577 my $issues = &GetPendingIssues(@borrowernumber);
579 Looks up what the patron with the given borrowernumber has borrowed.
581 C<&GetPendingIssues> returns a
582 reference-to-array where each element is a reference-to-hash; the
583 keys are the fields from the C<issues>, C<biblio>, and C<items> tables.
584 The keys include C<biblioitems> fields.
588 sub GetPendingIssues {
589 my @borrowernumbers = @_;
591 unless (@borrowernumbers ) { # return a ref_to_array
592 return \@borrowernumbers; # to not cause surprise to caller
595 # Borrowers part of the query
597 for (my $i = 0; $i < @borrowernumbers; $i++) {
598 $bquery .= ' issues.borrowernumber = ?';
599 if ($i < $#borrowernumbers ) {
604 # FIXME: namespace collision: each table has "timestamp" fields. Which one is "timestamp" ?
605 # FIXME: circ/ciculation.pl tries to sort by timestamp!
606 # FIXME: namespace collision: other collisions possible.
607 # FIXME: most of this data isn't really being used by callers.
614 biblioitems.itemtype,
617 biblioitems.publicationyear,
618 biblioitems.publishercode,
619 biblioitems.volumedate,
620 biblioitems.volumedesc,
625 borrowers.cardnumber,
626 issues.timestamp AS timestamp,
627 issues.renewals AS renewals,
628 issues.borrowernumber AS borrowernumber,
629 items.renewals AS totalrenewals
631 LEFT JOIN items ON items.itemnumber = issues.itemnumber
632 LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
633 LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
634 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
637 ORDER BY issues.issuedate"
640 my $sth = C4::Context->dbh->prepare($query);
641 $sth->execute(@borrowernumbers);
642 my $data = $sth->fetchall_arrayref({});
643 my $today = dt_from_string;
645 if ($_->{issuedate}) {
646 $_->{issuedate} = dt_from_string($_->{issuedate}, 'sql');
648 $_->{date_due_sql} = $_->{date_due};
649 # FIXME no need to have this value
650 $_->{date_due} or next;
651 $_->{date_due_sql} = $_->{date_due};
652 # FIXME no need to have this value
653 $_->{date_due} = dt_from_string($_->{date_due}, 'sql');
654 if ( DateTime->compare($_->{date_due}, $today) == -1 ) {
663 $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
665 Looks up what the patron with the given borrowernumber has borrowed,
666 and sorts the results.
668 C<$sortkey> is the name of a field on which to sort the results. This
669 should be the name of a field in the C<issues>, C<biblio>,
670 C<biblioitems>, or C<items> table in the Koha database.
672 C<$limit> is the maximum number of results to return.
674 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
675 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
676 C<items> tables of the Koha database.
682 my ( $borrowernumber, $order, $limit ) = @_;
684 return unless $borrowernumber;
685 $order = 'date_due desc' unless $order;
687 my $dbh = C4::Context->dbh;
689 'SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
691 LEFT JOIN items on items.itemnumber=issues.itemnumber
692 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
693 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
694 WHERE borrowernumber=?
696 SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
698 LEFT JOIN items on items.itemnumber=old_issues.itemnumber
699 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
700 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
701 WHERE borrowernumber=? AND old_issues.itemnumber IS NOT NULL
704 $query .= " limit $limit";
707 my $sth = $dbh->prepare($query);
708 $sth->execute( $borrowernumber, $borrowernumber );
709 return $sth->fetchall_arrayref( {} );
712 sub checkcardnumber {
713 my ( $cardnumber, $borrowernumber ) = @_;
715 # If cardnumber is null, we assume they're allowed.
716 return 0 unless defined $cardnumber;
718 my $dbh = C4::Context->dbh;
719 my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
720 $query .= " AND borrowernumber <> ?" if ($borrowernumber);
721 my $sth = $dbh->prepare($query);
724 ( $borrowernumber ? $borrowernumber : () )
727 return 1 if $sth->fetchrow_hashref;
729 my ( $min_length, $max_length ) = get_cardnumber_length();
731 if length $cardnumber > $max_length
732 or length $cardnumber < $min_length;
737 =head2 get_cardnumber_length
739 my ($min, $max) = C4::Members::get_cardnumber_length()
741 Returns the minimum and maximum length for patron cardnumbers as
742 determined by the CardnumberLength system preference, the
743 BorrowerMandatoryField system preference, and the width of the
748 sub get_cardnumber_length {
749 my $borrower = Koha::Schema->resultset('Borrower');
750 my $field_size = $borrower->result_source->column_info('cardnumber')->{size};
751 my ( $min, $max ) = ( 0, $field_size ); # borrowers.cardnumber is a nullable varchar(20)
752 $min = 1 if C4::Context->preference('BorrowerMandatoryField') =~ /cardnumber/;
753 if ( my $cardnumber_length = C4::Context->preference('CardnumberLength') ) {
754 # Is integer and length match
755 if ( $cardnumber_length =~ m|^\d+$| ) {
756 $min = $max = $cardnumber_length
757 if $cardnumber_length >= $min
758 and $cardnumber_length <= $max;
760 # Else assuming it is a range
761 elsif ( $cardnumber_length =~ m|(\d*),(\d*)| ) {
762 $min = $1 if $1 and $min < $1;
763 $max = $2 if $2 and $max > $2;
767 $min = $max if $min > $max;
768 return ( $min, $max );
771 =head2 GetBorrowersToExpunge
773 $borrowers = &GetBorrowersToExpunge(
774 not_borrowed_since => $not_borrowed_since,
775 expired_before => $expired_before,
776 category_code => $category_code,
777 patron_list_id => $patron_list_id,
778 branchcode => $branchcode
781 This function get all borrowers based on the given criteria.
785 sub GetBorrowersToExpunge {
788 my $filterdate = $params->{'not_borrowed_since'};
789 my $filterexpiry = $params->{'expired_before'};
790 my $filterlastseen = $params->{'last_seen'};
791 my $filtercategory = $params->{'category_code'};
792 my $filterbranch = $params->{'branchcode'} ||
793 ((C4::Context->preference('IndependentBranches')
794 && C4::Context->userenv
795 && !C4::Context->IsSuperLibrarian()
796 && C4::Context->userenv->{branch})
797 ? C4::Context->userenv->{branch}
799 my $filterpatronlist = $params->{'patron_list_id'};
801 my $dbh = C4::Context->dbh;
805 SELECT borrowers.borrowernumber,
806 MAX(old_issues.timestamp) AS latestissue,
807 MAX(issues.timestamp) AS currentissue
809 JOIN categories USING (categorycode)
813 WHERE guarantorid IS NOT NULL
815 ) as tmp ON borrowers.borrowernumber=tmp.guarantorid
816 LEFT JOIN old_issues USING (borrowernumber)
817 LEFT JOIN issues USING (borrowernumber)|;
818 if ( $filterpatronlist ){
819 $query .= q| LEFT JOIN patron_list_patrons USING (borrowernumber)|;
821 $query .= q| WHERE category_type <> 'S'
822 AND tmp.guarantorid IS NULL
825 if ( $filterbranch && $filterbranch ne "" ) {
826 $query.= " AND borrowers.branchcode = ? ";
827 push( @query_params, $filterbranch );
829 if ( $filterexpiry ) {
830 $query .= " AND dateexpiry < ? ";
831 push( @query_params, $filterexpiry );
833 if ( $filterlastseen ) {
834 $query .= ' AND lastseen < ? ';
835 push @query_params, $filterlastseen;
837 if ( $filtercategory ) {
838 $query .= " AND categorycode = ? ";
839 push( @query_params, $filtercategory );
841 if ( $filterpatronlist ){
842 $query.=" AND patron_list_id = ? ";
843 push( @query_params, $filterpatronlist );
845 $query .= " GROUP BY borrowers.borrowernumber";
847 ) xxx WHERE currentissue IS NULL|;
849 $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
850 push @query_params,$filterdate;
853 warn $query if $debug;
855 my $sth = $dbh->prepare($query);
856 if (scalar(@query_params)>0){
857 $sth->execute(@query_params);
864 while ( my $data = $sth->fetchrow_hashref ) {
865 push @results, $data;
872 IssueSlip($branchcode, $borrowernumber, $quickslip)
874 Returns letter hash ( see C4::Letters::GetPreparedLetter )
876 $quickslip is boolean, to indicate whether we want a quick slip
878 IssueSlip populates ISSUESLIP and ISSUEQSLIP, and will make the following expansions:
914 NOTE: Not all table fields are available, pleasee see GetPendingIssues for a list of available fields.
919 my ($branch, $borrowernumber, $quickslip) = @_;
921 # FIXME Check callers before removing this statement
922 #return unless $borrowernumber;
924 my $patron = Koha::Patrons->find( $borrowernumber );
925 return unless $patron;
927 my $pending_checkouts = $patron->pending_checkouts; # Should be $patron->checkouts->pending?
929 my ($letter_code, %repeat, %loops);
931 my $today_start = dt_from_string->set( hour => 0, minute => 0, second => 0 );
932 my $today_end = dt_from_string->set( hour => 23, minute => 59, second => 0 );
933 $today_start = Koha::Database->new->schema->storage->datetime_parser->format_datetime( $today_start );
934 $today_end = Koha::Database->new->schema->storage->datetime_parser->format_datetime( $today_end );
935 $letter_code = 'ISSUEQSLIP';
937 # issue date or lastreneweddate is today
938 my $todays_checkouts = $pending_checkouts->search(
942 '>=' => $today_start,
946 { '>=' => $today_start, '<=' => $today_end, }
951 while ( my $c = $todays_checkouts->next ) {
952 my $all = $c->unblessed_all_relateds;
962 checkedout => \@checkouts, # Historical syntax
965 issues => [ map { $_->{issues}{itemnumber} } @checkouts ], # TT syntax
969 my $today = Koha::Database->new->schema->storage->datetime_parser->format_datetime( dt_from_string );
970 # Checkouts due in the future
971 my $checkouts = $pending_checkouts->search({ date_due => { '>' => $today } });
972 my @checkouts; my @overdues;
973 while ( my $c = $checkouts->next ) {
974 my $all = $c->unblessed_all_relateds;
983 # Checkouts due in the past are overdues
984 my $overdues = $pending_checkouts->search({ date_due => { '<=' => $today } });
985 while ( my $o = $overdues->next ) {
986 my $all = $o->unblessed_all_relateds;
994 my $news = GetNewsToDisplay( "slip", $branch );
996 $_->{'timestamp'} = $_->{'newdate'};
999 $letter_code = 'ISSUESLIP';
1001 checkedout => \@checkouts,
1002 overdue => \@overdues,
1006 issues => [ map { $_->{issues}{itemnumber} } @checkouts ],
1007 overdues => [ map { $_->{issues}{itemnumber} } @overdues ],
1008 opac_news => [ map { $_->{opac_news}{idnew} } @news ],
1012 return C4::Letters::GetPreparedLetter (
1013 module => 'circulation',
1014 letter_code => $letter_code,
1015 branchcode => $branch,
1016 lang => $patron->lang,
1018 'branches' => $branch,
1019 'borrowers' => $borrowernumber,
1026 =head2 AddMember_Auto
1030 sub AddMember_Auto {
1031 my ( %borrower ) = @_;
1033 $borrower{'cardnumber'} ||= fixup_cardnumber();
1035 $borrower{'borrowernumber'} = AddMember(%borrower);
1037 return ( %borrower );
1040 =head2 AddMember_Opac
1044 sub AddMember_Opac {
1045 my ( %borrower ) = @_;
1047 $borrower{'categorycode'} //= C4::Context->preference('PatronSelfRegistrationDefaultCategory');
1048 if (not defined $borrower{'password'}){
1049 my $sr = new String::Random;
1050 $sr->{'A'} = [ 'A'..'Z', 'a'..'z' ];
1051 my $password = $sr->randpattern("AAAAAAAAAA");
1052 $borrower{'password'} = $password;
1055 %borrower = AddMember_Auto(%borrower);
1057 return ( $borrower{'borrowernumber'}, $borrower{'password'} );
1060 =head2 DeleteExpiredOpacRegistrations
1062 Delete accounts that haven't been upgraded from the 'temporary' category
1063 Returns the number of removed patrons
1067 sub DeleteExpiredOpacRegistrations {
1069 my $delay = C4::Context->preference('PatronSelfRegistrationExpireTemporaryAccountsDelay');
1070 my $category_code = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
1072 return 0 if not $category_code or not defined $delay or $delay eq q||;
1075 SELECT borrowernumber
1077 WHERE categorycode = ? AND DATEDIFF( NOW(), dateenrolled ) > ? |;
1079 my $dbh = C4::Context->dbh;
1080 my $sth = $dbh->prepare($query);
1081 $sth->execute( $category_code, $delay );
1083 while ( my ($borrowernumber) = $sth->fetchrow_array() ) {
1084 Koha::Patrons->find($borrowernumber)->delete;
1090 =head2 DeleteUnverifiedOpacRegistrations
1092 Delete all unverified self registrations in borrower_modifications,
1093 older than the specified number of days.
1097 sub DeleteUnverifiedOpacRegistrations {
1099 my $dbh = C4::Context->dbh;
1101 DELETE FROM borrower_modifications
1102 WHERE borrowernumber = 0 AND DATEDIFF( NOW(), timestamp ) > ?|;
1103 my $cnt=$dbh->do($sql, undef, ($days) );
1104 return $cnt eq '0E0'? 0: $cnt;
1107 END { } # module clean-up code here (global destructor)