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 C4
::Log
; # logaction
35 use C4
::Members
::Attributes
qw(SearchIdMatchingAttribute UpdateBorrowerAttribute);
36 use C4
::NewsChannels
; #get slip news
40 use Text
::Unaccent
qw( unac_string );
41 use Koha
::AuthUtils
qw(hash_password);
44 use Koha
::List
::Patron
;
46 use Koha
::Patron
::Categories
;
49 our (@ISA,@EXPORT,@EXPORT_OK,$debug);
51 use Module
::Load
::Conditional
qw( can_load );
52 if ( ! can_load
( modules
=> { 'Koha::NorwegianPatronDB' => undef } ) ) {
53 $debug && warn "Unable to load Koha::NorwegianPatronDB";
58 $debug = $ENV{DEBUG
} || 0;
67 &GetMemberAccountRecords
69 &GetBorrowersToExpunge
101 C4::Members - Perl Module containing convenience functions for member handling
109 This module contains routines for adding, modifying and deleting members/patrons/borrowers
115 $flags = &patronflags($patron);
117 This function is not exported.
119 The following will be set where applicable:
120 $flags->{CHARGES}->{amount} Amount of debt
121 $flags->{CHARGES}->{noissues} Set if debt amount >$5.00 (or syspref noissuescharge)
122 $flags->{CHARGES}->{message} Message -- deprecated
124 $flags->{CREDITS}->{amount} Amount of credit
125 $flags->{CREDITS}->{message} Message -- deprecated
127 $flags->{ GNA } Patron has no valid address
128 $flags->{ GNA }->{noissues} Set for each GNA
129 $flags->{ GNA }->{message} "Borrower has no valid address" -- deprecated
131 $flags->{ LOST } Patron's card reported lost
132 $flags->{ LOST }->{noissues} Set for each LOST
133 $flags->{ LOST }->{message} Message -- deprecated
135 $flags->{DBARRED} Set if patron debarred, no access
136 $flags->{DBARRED}->{noissues} Set for each DBARRED
137 $flags->{DBARRED}->{message} Message -- deprecated
140 $flags->{ NOTES }->{message} The note itself. NOT deprecated
142 $flags->{ ODUES } Set if patron has overdue books.
143 $flags->{ ODUES }->{message} "Yes" -- deprecated
144 $flags->{ ODUES }->{itemlist} ref-to-array: list of overdue books
145 $flags->{ ODUES }->{itemlisttext} Text list of overdue items -- deprecated
147 $flags->{WAITING} Set if any of patron's reserves are available
148 $flags->{WAITING}->{message} Message -- deprecated
149 $flags->{WAITING}->{itemlist} ref-to-array: list of available items
153 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the
154 overdue items. Its elements are references-to-hash, each describing an
155 overdue item. The keys are selected fields from the issues, biblio,
156 biblioitems, and items tables of the Koha database.
158 =item C<$flags-E<gt>{ODUES}-E<gt>{itemlisttext}> is a string giving a text listing of
159 the overdue items, one per line. Deprecated.
161 =item C<$flags-E<gt>{WAITING}-E<gt>{itemlist}> is a reference-to-array listing the
162 available items. Each element is a reference-to-hash whose keys are
163 fields from the reserves table of the Koha database.
167 All the "message" fields that include language generated in this function are deprecated,
168 because such strings belong properly in the display layer.
170 The "message" field that comes from the DB is OK.
174 # TODO: use {anonymous => hashes} instead of a dozen %flaginfo
175 # FIXME rename this function.
178 my ( $patroninformation) = @_;
179 my $dbh=C4
::Context
->dbh;
180 my ($balance, $owing) = GetMemberAccountBalance
( $patroninformation->{'borrowernumber'});
183 my $noissuescharge = C4
::Context
->preference("noissuescharge") || 5;
184 $flaginfo{'message'} = sprintf 'Patron owes %.02f', $owing;
185 $flaginfo{'amount'} = sprintf "%.02f", $owing;
186 if ( $owing > $noissuescharge && !C4
::Context
->preference("AllowFineOverride") ) {
187 $flaginfo{'noissues'} = 1;
189 $flags{'CHARGES'} = \
%flaginfo;
191 elsif ( $balance < 0 ) {
193 $flaginfo{'message'} = sprintf 'Patron has credit of %.02f', -$balance;
194 $flaginfo{'amount'} = sprintf "%.02f", $balance;
195 $flags{'CREDITS'} = \
%flaginfo;
198 # Check the debt of the guarntees of this patron
199 my $no_issues_charge_guarantees = C4
::Context
->preference("NoIssuesChargeGuarantees");
200 $no_issues_charge_guarantees = undef unless looks_like_number
( $no_issues_charge_guarantees );
201 if ( defined $no_issues_charge_guarantees ) {
202 my $p = Koha
::Patrons
->find( $patroninformation->{borrowernumber
} );
203 my @guarantees = $p->guarantees();
204 my $guarantees_non_issues_charges;
205 foreach my $g ( @guarantees ) {
206 my ( $b, $n, $o ) = C4
::Members
::GetMemberAccountBalance
( $g->id );
207 $guarantees_non_issues_charges += $n;
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 $patron = Koha
::Patrons
->find( $patroninformation->{borrowernumber
} );
265 my $waiting_holds = $patron->holds->search({ found
=> 'W' });
266 my $nowaiting = $waiting_holds->count;
267 if ( $nowaiting > 0 ) {
269 $flaginfo{'message'} = "Reserved items available";
270 $flaginfo{'itemlist'} = $waiting_holds->unblessed;
271 $flags{'WAITING'} = \
%flaginfo;
279 my $success = ModMember(borrowernumber => $borrowernumber,
280 [ field => value ]... );
282 Modify borrower's data. All date fields should ALREADY be in ISO format.
285 true on success, or false on failure
292 # trim whitespace from data which has some non-whitespace in it.
293 foreach my $field_name (keys(%data)) {
294 if ( defined $data{$field_name} && $data{$field_name} =~ /\S/ ) {
295 $data{$field_name} =~ s/^\s*|\s*$//g;
299 # test to know if you must update or not the borrower password
300 if (exists $data{password
}) {
301 if ($data{password
} eq '****' or $data{password
} eq '') {
302 delete $data{password
};
304 if ( C4
::Context
->preference('NorwegianPatronDBEnable') && C4
::Context
->preference('NorwegianPatronDBEnable') == 1 ) {
305 # Update the hashed PIN in borrower_sync.hashed_pin, before Koha hashes it
306 Koha
::NorwegianPatronDB
::NLUpdateHashedPIN
( $data{'borrowernumber'}, $data{password
} );
308 $data{password
} = hash_password
($data{password
});
312 my $old_categorycode = Koha
::Patrons
->find( $data{borrowernumber
} )->categorycode;
314 # get only the columns of a borrower
315 my $schema = Koha
::Database
->new()->schema;
316 my @columns = $schema->source('Borrower')->columns;
317 my $new_borrower = { map { join(' ', @columns) =~ /$_/ ?
( $_ => $data{$_} ) : () } keys(%data) };
319 $new_borrower->{dateofbirth
} ||= undef if exists $new_borrower->{dateofbirth
};
320 $new_borrower->{dateenrolled
} ||= undef if exists $new_borrower->{dateenrolled
};
321 $new_borrower->{dateexpiry
} ||= undef if exists $new_borrower->{dateexpiry
};
322 $new_borrower->{debarred
} ||= undef if exists $new_borrower->{debarred
};
323 $new_borrower->{sms_provider_id
} ||= undef if exists $new_borrower->{sms_provider_id
};
324 $new_borrower->{guarantorid
} ||= undef if exists $new_borrower->{guarantorid
};
326 my $patron = Koha
::Patrons
->find( $new_borrower->{borrowernumber
} );
328 delete $new_borrower->{userid
} if exists $new_borrower->{userid
} and not $new_borrower->{userid
};
330 my $execute_success = $patron->store if $patron->set($new_borrower);
332 if ($execute_success) { # only proceed if the update was a success
333 # If the patron changes to a category with enrollment fee, we add a fee
334 if ( $data{categorycode
} and $data{categorycode
} ne $old_categorycode ) {
335 if ( C4
::Context
->preference('FeeOnChangePatronCategory') ) {
336 $patron->add_enrolment_fee_if_needed;
340 # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
341 # cronjob will use for syncing with NL
342 if ( C4
::Context
->preference('NorwegianPatronDBEnable') && C4
::Context
->preference('NorwegianPatronDBEnable') == 1 ) {
343 my $borrowersync = Koha
::Database
->new->schema->resultset('BorrowerSync')->find({
344 'synctype' => 'norwegianpatrondb',
345 'borrowernumber' => $data{'borrowernumber'}
347 # Do not set to "edited" if syncstatus is "new". We need to sync as new before
348 # we can sync as changed. And the "new sync" will pick up all changes since
349 # the patron was created anyway.
350 if ( $borrowersync->syncstatus ne 'new' && $borrowersync->syncstatus ne 'delete' ) {
351 $borrowersync->update( { 'syncstatus' => 'edited' } );
353 # Set the value of 'sync'
354 $borrowersync->update( { 'sync' => $data{'sync'} } );
355 # Try to do the live sync
356 Koha
::NorwegianPatronDB
::NLSync
({ 'borrowernumber' => $data{'borrowernumber'} });
359 logaction
("MEMBERS", "MODIFY", $data{'borrowernumber'}, "UPDATE (executed w/ arg: $data{'borrowernumber'})") if C4
::Context
->preference("BorrowersLog");
361 return $execute_success;
366 $borrowernumber = &AddMember(%borrower);
368 insert new borrower into table
370 (%borrower keys are database columns. Database columns could be
371 different in different versions. Please look into database for correct
374 Returns the borrowernumber upon success
376 Returns as undef upon any db error without further processing
383 my $dbh = C4
::Context
->dbh;
384 my $schema = Koha
::Database
->new()->schema;
386 my $category = Koha
::Patron
::Categories
->find( $data{categorycode
} );
388 Koha
::Exceptions
::BadParameter
->throw(
389 error
=> 'Invalid parameter passed',
390 parameter
=> 'categorycode'
394 # trim whitespace from data which has some non-whitespace in it.
395 foreach my $field_name (keys(%data)) {
396 if ( defined $data{$field_name} && $data{$field_name} =~ /\S/ ) {
397 $data{$field_name} =~ s/^\s*|\s*$//g;
401 # generate a proper login if none provided
402 $data{'userid'} = Generate_Userid
( $data{'borrowernumber'}, $data{'firstname'}, $data{'surname'} )
403 if ( $data{'userid'} eq '' || !Check_Userid
( $data{'userid'} ) );
405 # add expiration date if it isn't already there
406 $data{dateexpiry
} ||= $category->get_expiry_date;
408 # add enrollment date if it isn't already there
409 unless ( $data{'dateenrolled'} ) {
410 $data{'dateenrolled'} = output_pref
( { dt
=> dt_from_string
, dateonly
=> 1, dateformat
=> 'iso' } );
413 if ( C4
::Context
->preference("autoMemberNum") ) {
414 if ( not exists $data{cardnumber
} or not defined $data{cardnumber
} or $data{cardnumber
} eq '' ) {
415 $data{cardnumber
} = fixup_cardnumber
( $data{cardnumber
} );
420 $category->default_privacy() eq 'default' ?
1
421 : $category->default_privacy() eq 'never' ?
2
422 : $category->default_privacy() eq 'forever' ?
0
425 $data{'privacy_guarantor_checkouts'} = 0 unless defined( $data{'privacy_guarantor_checkouts'} );
427 # Make a copy of the plain text password for later use
428 my $plain_text_password = $data{'password'};
430 # create a disabled account if no password provided
431 $data{'password'} = ($data{'password'})? hash_password
($data{'password'}) : '!';
433 # we don't want invalid dates in the db (mysql has a bad habit of inserting 0000-00-00
434 $data{'dateofbirth'} = undef if ( not $data{'dateofbirth'} );
435 $data{'debarred'} = undef if ( not $data{'debarred'} );
436 $data{'sms_provider_id'} = undef if ( not $data{'sms_provider_id'} );
437 $data{'guarantorid'} = undef if ( not $data{'guarantorid'} );
439 # get only the columns of Borrower
440 # FIXME Do we really need this check?
441 my @columns = $schema->source('Borrower')->columns;
442 my $new_member = { map { join(' ',@columns) =~ /$_/ ?
( $_ => $data{$_} ) : () } keys(%data) } ;
444 delete $new_member->{borrowernumber
};
446 my $patron = Koha
::Patron
->new( $new_member )->store;
447 $data{borrowernumber
} = $patron->borrowernumber;
449 # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a
450 # cronjob will use for syncing with NL
451 if ( exists $data{'borrowernumber'} && C4
::Context
->preference('NorwegianPatronDBEnable') && C4
::Context
->preference('NorwegianPatronDBEnable') == 1 ) {
452 Koha
::Database
->new->schema->resultset('BorrowerSync')->create({
453 'borrowernumber' => $data{'borrowernumber'},
454 'synctype' => 'norwegianpatrondb',
456 'syncstatus' => 'new',
457 'hashed_pin' => Koha
::NorwegianPatronDB
::NLEncryptPIN
( $plain_text_password ),
461 logaction
("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4
::Context
->preference("BorrowersLog");
463 $patron->add_enrolment_fee_if_needed;
465 return $data{borrowernumber
};
470 my $uniqueness = Check_Userid($userid,$borrowernumber);
472 $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 != '').
474 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.
477 0 for not unique (i.e. this $userid already exists)
478 1 for unique (i.e. this $userid does not exist, or this $userid/$borrowernumber combination already exists)
483 my ( $uid, $borrowernumber ) = @_;
485 return 0 unless ($uid); # userid is a unique column, we should assume NULL is not unique
487 return 0 if ( $uid eq C4
::Context
->config('user') );
489 my $rs = Koha
::Database
->new()->schema()->resultset('Borrower');
492 $params->{userid
} = $uid;
493 $params->{borrowernumber
} = { '!=' => $borrowernumber } if ($borrowernumber);
495 my $count = $rs->count( $params );
497 return $count ?
0 : 1;
500 =head2 Generate_Userid
502 my $newuid = Generate_Userid($borrowernumber, $firstname, $surname);
504 Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
506 $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.
509 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).
513 sub Generate_Userid
{
514 my ($borrowernumber, $firstname, $surname) = @_;
517 #The script will "do" the following code and increment the $offset until Check_Userid = 1 (i.e. until $newuid comes back as unique)
519 $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
520 $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
521 $newuid = lc(($firstname)?
"$firstname.$surname" : $surname);
522 $newuid = unac_string
('utf-8',$newuid);
523 $newuid .= $offset unless $offset == 0;
526 } while (!Check_Userid
($newuid,$borrowernumber));
531 =head2 fixup_cardnumber
533 Warning: The caller is responsible for locking the members table in write
534 mode, to avoid database corruption.
538 use vars
qw( @weightings );
539 my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
541 sub fixup_cardnumber {
542 my ($cardnumber) = @_;
543 my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0;
545 # Find out whether member numbers should be generated
546 # automatically. Should be either "1" or something else.
547 # Defaults to "0", which is interpreted as "no".
549 # if ($cardnumber !~ /\S/ && $autonumber_members) {
550 ($autonumber_members) or return $cardnumber;
551 my $checkdigit = C4::Context->preference('checkdigit');
552 my $dbh = C4::Context->dbh;
553 if ( $checkdigit and $checkdigit eq 'katipo' ) {
555 # if checkdigit is selected, calculate katipo-style cardnumber.
556 # otherwise, just use the max()
557 # purpose: generate checksum'd member numbers.
558 # We'll assume we just got the max value of digits 2-8 of member #'s
559 # from the database and our job is to increment that by one,
560 # determine the 1st and 9th digits and return the full string.
561 my $sth = $dbh->prepare(
562 "select max(substring(borrowers.cardnumber,2,7)) as new_num from borrowers"
565 my $data = $sth->fetchrow_hashref;
566 $cardnumber = $data->{new_num};
567 if ( !$cardnumber ) { # If DB has no values,
568 $cardnumber = 1000000; # start at 1000000
574 for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
575 # read weightings, left to right, 1 char at a time
576 my $temp1 = $weightings[$i];
578 # sequence left to right, 1 char at a time
579 my $temp2 = substr( $cardnumber, $i, 1 );
581 # mult each char 1-7 by its corresponding weighting
582 $sum += $temp1 * $temp2;
585 my $rem = ( $sum % 11 );
586 $rem = 'X' if $rem == 10;
588 return "V$cardnumber$rem";
591 my $sth = $dbh->prepare(
592 'SELECT MAX( CAST( cardnumber AS SIGNED ) ) FROM borrowers WHERE cardnumber REGEXP "^-?[0-9]+$"'
595 my ($result) = $sth->fetchrow;
598 return $cardnumber; # just here as a fallback/reminder
601 =head2 GetPendingIssues
603 my $issues = &GetPendingIssues(@borrowernumber);
605 Looks up what the patron with the given borrowernumber has borrowed.
607 C<&GetPendingIssues> returns a
608 reference-to-array where each element is a reference-to-hash; the
609 keys are the fields from the C<issues>, C<biblio>, and C<items> tables.
610 The keys include C<biblioitems> fields.
614 sub GetPendingIssues {
615 my @borrowernumbers = @_;
617 unless (@borrowernumbers ) { # return a ref_to_array
618 return \@borrowernumbers; # to not cause surprise to caller
621 # Borrowers part of the query
623 for (my $i = 0; $i < @borrowernumbers; $i++) {
624 $bquery .= ' issues.borrowernumber = ?';
625 if ($i < $#borrowernumbers ) {
630 # FIXME: namespace collision: each table has "timestamp" fields. Which one is "timestamp" ?
631 # FIXME: circ/ciculation.pl tries to sort by timestamp!
632 # FIXME: namespace collision: other collisions possible.
633 # FIXME: most of this data isn't really being used by callers.
640 biblioitems.itemtype,
643 biblioitems.publicationyear,
644 biblioitems.publishercode,
645 biblioitems.volumedate,
646 biblioitems.volumedesc,
651 borrowers.cardnumber,
652 issues.timestamp AS timestamp,
653 issues.renewals AS renewals,
654 issues.borrowernumber AS borrowernumber,
655 items.renewals AS totalrenewals
657 LEFT JOIN items ON items.itemnumber = issues.itemnumber
658 LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
659 LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
660 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
663 ORDER BY issues.issuedate"
666 my $sth = C4::Context->dbh->prepare($query);
667 $sth->execute(@borrowernumbers);
668 my $data = $sth->fetchall_arrayref({});
669 my $today = dt_from_string;
671 if ($_->{issuedate}) {
672 $_->{issuedate} = dt_from_string($_->{issuedate}, 'sql');
674 $_->{date_due_sql} = $_->{date_due};
675 # FIXME no need to have this value
676 $_->{date_due} or next;
677 $_->{date_due_sql} = $_->{date_due};
678 # FIXME no need to have this value
679 $_->{date_due} = dt_from_string($_->{date_due}, 'sql');
680 if ( DateTime->compare($_->{date_due}, $today) == -1 ) {
689 $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);
691 Looks up what the patron with the given borrowernumber has borrowed,
692 and sorts the results.
694 C<$sortkey> is the name of a field on which to sort the results. This
695 should be the name of a field in the C<issues>, C<biblio>,
696 C<biblioitems>, or C<items> table in the Koha database.
698 C<$limit> is the maximum number of results to return.
700 C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
701 are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
702 C<items> tables of the Koha database.
708 my ( $borrowernumber, $order, $limit ) = @_;
710 return unless $borrowernumber;
711 $order = 'date_due desc' unless $order;
713 my $dbh = C4::Context->dbh;
715 'SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
717 LEFT JOIN items on items.itemnumber=issues.itemnumber
718 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
719 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
720 WHERE borrowernumber=?
722 SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
724 LEFT JOIN items on items.itemnumber=old_issues.itemnumber
725 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
726 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
727 WHERE borrowernumber=? AND old_issues.itemnumber IS NOT NULL
730 $query .= " limit $limit";
733 my $sth = $dbh->prepare($query);
734 $sth->execute( $borrowernumber, $borrowernumber );
735 return $sth->fetchall_arrayref( {} );
739 =head2 GetMemberAccountRecords
741 ($total, $acctlines, $count) = &GetMemberAccountRecords($borrowernumber);
743 Looks up accounting data for the patron with the given borrowernumber.
745 C<&GetMemberAccountRecords> returns a three-element array. C<$acctlines> is a
746 reference-to-array, where each element is a reference-to-hash; the
747 keys are the fields of the C<accountlines> table in the Koha database.
748 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
749 total amount outstanding for all of the account lines.
753 sub GetMemberAccountRecords {
754 my ($borrowernumber) = @_;
755 my $dbh = C4::Context->dbh;
761 WHERE borrowernumber=?);
762 $strsth.=" ORDER BY accountlines_id desc";
763 my $sth= $dbh->prepare( $strsth );
764 $sth->execute( $borrowernumber );
767 while ( my $data = $sth->fetchrow_hashref ) {
768 if ( $data->{itemnumber} ) {
769 my $item = Koha::Items->find( $data->{itemnumber} );
770 my $biblio = $item->biblio;
771 $data->{biblionumber} = $biblio->biblionumber;
772 $data->{title} = $biblio->title;
774 $acctlines[$numlines] = $data;
776 $total += sprintf "%.0f", 1000*$data->{amountoutstanding}; # convert float to integer to avoid round-off errors
779 return ( $total, \@acctlines,$numlines);
782 =head2 GetMemberAccountBalance
784 ($total_balance, $non_issue_balance, $other_charges) = &GetMemberAccountBalance($borrowernumber);
786 Calculates amount immediately owing by the patron - non-issue charges.
787 Based on GetMemberAccountRecords.
788 Charges exempt from non-issue are:
790 * Rent (rental) if RentalsInNoissuesCharge syspref is set to false
791 * Manual invoices if ManInvInNoissuesCharge syspref is set to false
795 sub GetMemberAccountBalance {
796 my ($borrowernumber) = @_;
798 my $ACCOUNT_TYPE_LENGTH = 5; # this is plain ridiculous...
801 push @not_fines, 'Res' unless C4::Context->preference('HoldsInNoissuesCharge');
802 push @not_fines, 'Rent' unless C4::Context->preference('RentalsInNoissuesCharge');
803 unless ( C4::Context->preference('ManInvInNoissuesCharge') ) {
804 my $dbh = C4::Context->dbh;
805 my $man_inv_types = $dbh->selectcol_arrayref(qq{SELECT authorised_value FROM authorised_values WHERE category = 'MANUAL_INV'});
806 push @not_fines, map substr($_, 0, $ACCOUNT_TYPE_LENGTH), @$man_inv_types;
808 my %not_fine = map {$_ => 1} @not_fines;
810 my ($total, $acctlines) = GetMemberAccountRecords($borrowernumber);
811 my $other_charges = 0;
812 foreach (@$acctlines) {
813 $other_charges += $_->{amountoutstanding} if $not_fine{ substr($_->{accounttype}, 0, $ACCOUNT_TYPE_LENGTH) };
816 return ( $total, $total - $other_charges, $other_charges);
819 sub checkcardnumber {
820 my ( $cardnumber, $borrowernumber ) = @_;
822 # If cardnumber is null, we assume they're allowed.
823 return 0 unless defined $cardnumber;
825 my $dbh = C4::Context->dbh;
826 my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
827 $query .= " AND borrowernumber <> ?" if ($borrowernumber);
828 my $sth = $dbh->prepare($query);
831 ( $borrowernumber ? $borrowernumber : () )
834 return 1 if $sth->fetchrow_hashref;
836 my ( $min_length, $max_length ) = get_cardnumber_length();
838 if length $cardnumber > $max_length
839 or length $cardnumber < $min_length;
844 =head2 get_cardnumber_length
846 my ($min, $max) = C4::Members::get_cardnumber_length()
848 Returns the minimum and maximum length for patron cardnumbers as
849 determined by the CardnumberLength system preference, the
850 BorrowerMandatoryField system preference, and the width of the
855 sub get_cardnumber_length {
856 my $borrower = Koha::Schema->resultset('Borrower');
857 my $field_size = $borrower->result_source->column_info('cardnumber')->{size};
858 my ( $min, $max ) = ( 0, $field_size ); # borrowers.cardnumber is a nullable varchar(20)
859 $min = 1 if C4::Context->preference('BorrowerMandatoryField') =~ /cardnumber/;
860 if ( my $cardnumber_length = C4::Context->preference('CardnumberLength') ) {
861 # Is integer and length match
862 if ( $cardnumber_length =~ m|^\d+$| ) {
863 $min = $max = $cardnumber_length
864 if $cardnumber_length >= $min
865 and $cardnumber_length <= $max;
867 # Else assuming it is a range
868 elsif ( $cardnumber_length =~ m|(\d*),(\d*)| ) {
869 $min = $1 if $1 and $min < $1;
870 $max = $2 if $2 and $max > $2;
874 $min = $max if $min > $max;
875 return ( $min, $max );
878 =head2 GetBorrowersToExpunge
880 $borrowers = &GetBorrowersToExpunge(
881 not_borrowed_since => $not_borrowed_since,
882 expired_before => $expired_before,
883 category_code => $category_code,
884 patron_list_id => $patron_list_id,
885 branchcode => $branchcode
888 This function get all borrowers based on the given criteria.
892 sub GetBorrowersToExpunge {
895 my $filterdate = $params->{'not_borrowed_since'};
896 my $filterexpiry = $params->{'expired_before'};
897 my $filterlastseen = $params->{'last_seen'};
898 my $filtercategory = $params->{'category_code'};
899 my $filterbranch = $params->{'branchcode'} ||
900 ((C4::Context->preference('IndependentBranches')
901 && C4::Context->userenv
902 && !C4::Context->IsSuperLibrarian()
903 && C4::Context->userenv->{branch})
904 ? C4::Context->userenv->{branch}
906 my $filterpatronlist = $params->{'patron_list_id'};
908 my $dbh = C4::Context->dbh;
910 SELECT borrowers.borrowernumber,
911 MAX(old_issues.timestamp) AS latestissue,
912 MAX(issues.timestamp) AS currentissue
914 JOIN categories USING (categorycode)
918 WHERE guarantorid IS NOT NULL
920 ) as tmp ON borrowers.borrowernumber=tmp.guarantorid
921 LEFT JOIN old_issues USING (borrowernumber)
922 LEFT JOIN issues USING (borrowernumber)|;
923 if ( $filterpatronlist ){
924 $query .= q| LEFT JOIN patron_list_patrons USING (borrowernumber)|;
926 $query .= q| WHERE category_type <> 'S'
927 AND tmp.guarantorid IS NULL
930 if ( $filterbranch && $filterbranch ne "" ) {
931 $query.= " AND borrowers.branchcode = ? ";
932 push( @query_params, $filterbranch );
934 if ( $filterexpiry ) {
935 $query .= " AND dateexpiry < ? ";
936 push( @query_params, $filterexpiry );
938 if ( $filterlastseen ) {
939 $query .= ' AND lastseen < ? ';
940 push @query_params, $filterlastseen;
942 if ( $filtercategory ) {
943 $query .= " AND categorycode = ? ";
944 push( @query_params, $filtercategory );
946 if ( $filterpatronlist ){
947 $query.=" AND patron_list_id = ? ";
948 push( @query_params, $filterpatronlist );
950 $query.=" GROUP BY borrowers.borrowernumber HAVING currentissue IS NULL ";
952 $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
953 push @query_params,$filterdate;
955 warn $query if $debug;
957 my $sth = $dbh->prepare($query);
958 if (scalar(@query_params)>0){
959 $sth->execute(@query_params);
966 while ( my $data = $sth->fetchrow_hashref ) {
967 push @results, $data;
974 IssueSlip($branchcode, $borrowernumber, $quickslip)
976 Returns letter hash ( see C4::Letters::GetPreparedLetter )
978 $quickslip is boolean, to indicate whether we want a quick slip
980 IssueSlip populates ISSUESLIP and ISSUEQSLIP, and will make the following expansions:
1016 NOTE: Not all table fields are available, pleasee see GetPendingIssues for a list of available fields.
1021 my ($branch, $borrowernumber, $quickslip) = @_;
1023 # FIXME Check callers before removing this statement
1024 #return unless $borrowernumber;
1026 my $patron = Koha::Patrons->find( $borrowernumber );
1027 return unless $patron;
1029 my @issues = @{ GetPendingIssues($borrowernumber) };
1031 for my $issue (@issues) {
1032 $issue->{date_due} = $issue->{date_due_sql};
1034 my $today = output_pref({ dt => dt_from_string, dateformat => 'iso', dateonly => 1 });
1035 if ( substr( $issue->{issuedate}, 0, 10 ) eq $today
1036 or substr( $issue->{lastreneweddate}, 0, 10 ) eq $today ) {
1042 # Sort on timestamp then on issuedate then on issue_id
1043 # useful for tests and could be if modified in a batch
1045 $b->{timestamp} <=> $a->{timestamp}
1046 or $b->{issuedate} <=> $a->{issuedate}
1047 or $b->{issue_id} <=> $a->{issue_id}
1050 my ($letter_code, %repeat, %loops);
1052 $letter_code = 'ISSUEQSLIP';
1053 my @checkouts = map {
1056 'biblioitems' => $_,
1058 }, grep { $_->{'now
'} } @issues;
1060 checkedout => \@checkouts, # History syntax
1063 issues => [ map { $_->{issues}{itemnumber} } @checkouts ], # TT syntax
1067 my @checkouts = map {
1070 'biblioitems
' => $_,
1072 }, grep { !$_->{'overdue
'} } @issues;
1073 my @overdues = map {
1076 'biblioitems
' => $_,
1078 }, grep { $_->{'overdue
'} } @issues;
1079 my $news = GetNewsToDisplay( "slip", $branch );
1081 $_->{'timestamp
'} = $_->{'newdate
'};
1084 $letter_code = 'ISSUESLIP
';
1086 checkedout => \@checkouts,
1087 overdue => \@overdues,
1091 issues => [ map { $_->{issues}{itemnumber} } @checkouts ],
1092 overdues => [ map { $_->{issues}{itemnumber} } @overdues ],
1093 opac_news => [ map { $_->{opac_news}{idnew} } @news ],
1097 return C4::Letters::GetPreparedLetter (
1098 module => 'circulation
',
1099 letter_code => $letter_code,
1100 branchcode => $branch,
1101 lang => $patron->lang,
1103 'branches
' => $branch,
1104 'borrowers
' => $borrowernumber,
1111 =head2 AddMember_Auto
1115 sub AddMember_Auto {
1116 my ( %borrower ) = @_;
1118 $borrower{'cardnumber
'} ||= fixup_cardnumber();
1120 $borrower{'borrowernumber
'} = AddMember(%borrower);
1122 return ( %borrower );
1125 =head2 AddMember_Opac
1129 sub AddMember_Opac {
1130 my ( %borrower ) = @_;
1132 $borrower{'categorycode
'} //= C4::Context->preference('PatronSelfRegistrationDefaultCategory
');
1133 if (not defined $borrower{'password
'}){
1134 my $sr = new String::Random;
1135 $sr->{'A
'} = [ 'A
'..'Z
', 'a
'..'z
' ];
1136 my $password = $sr->randpattern("AAAAAAAAAA");
1137 $borrower{'password
'} = $password;
1140 %borrower = AddMember_Auto(%borrower);
1142 return ( $borrower{'borrowernumber
'}, $borrower{'password
'} );
1145 =head2 DeleteExpiredOpacRegistrations
1147 Delete accounts that haven't been upgraded from the
'temporary' category
1148 Returns the number of removed patrons
1152 sub DeleteExpiredOpacRegistrations
{
1154 my $delay = C4
::Context
->preference('PatronSelfRegistrationExpireTemporaryAccountsDelay');
1155 my $category_code = C4
::Context
->preference('PatronSelfRegistrationDefaultCategory');
1157 return 0 if not $category_code or not defined $delay or $delay eq q
||;
1160 SELECT borrowernumber
1162 WHERE categorycode
= ? AND DATEDIFF
( NOW
(), dateenrolled
) > ?
|;
1164 my $dbh = C4
::Context
->dbh;
1165 my $sth = $dbh->prepare($query);
1166 $sth->execute( $category_code, $delay );
1168 while ( my ($borrowernumber) = $sth->fetchrow_array() ) {
1169 Koha
::Patrons
->find($borrowernumber)->delete;
1175 =head2 DeleteUnverifiedOpacRegistrations
1177 Delete all unverified self registrations in borrower_modifications,
1178 older than the specified number of days.
1182 sub DeleteUnverifiedOpacRegistrations
{
1184 my $dbh = C4
::Context
->dbh;
1186 DELETE FROM borrower_modifications
1187 WHERE borrowernumber
= 0 AND DATEDIFF
( NOW
(), timestamp
) > ?
|;
1188 my $cnt=$dbh->do($sql, undef, ($days) );
1189 return $cnt eq '0E0'?
0: $cnt;
1192 sub GetOverduesForPatron
{
1193 my ( $borrowernumber ) = @_;
1197 FROM issues, items, biblio, biblioitems
1198 WHERE items.itemnumber=issues.itemnumber
1199 AND biblio.biblionumber = items.biblionumber
1200 AND biblio.biblionumber = biblioitems.biblionumber
1201 AND issues.borrowernumber = ?
1202 AND date_due < NOW()
1205 my $sth = C4
::Context
->dbh->prepare( $sql );
1206 $sth->execute( $borrowernumber );
1208 return $sth->fetchall_arrayref({});
1211 END { } # module clean-up code here (global destructor)