Bug 19730: (follow-up bug 17196) Use biblio_metadata.timestamp in export_records.pl
[koha.git] / C4 / Members.pm
blob2729d360e5b68bf59c66cdbb191c2e1c355c4d13
1 package C4::Members;
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>.
23 use strict;
24 #use warnings; FIXME - Bug 2505
25 use C4::Context;
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
30 use C4::Overdues;
31 use C4::Reserves;
32 use C4::Accounts;
33 use C4::Biblio;
34 use C4::Letters;
35 use C4::Members::Attributes qw(SearchIdMatchingAttribute UpdateBorrowerAttribute);
36 use C4::NewsChannels; #get slip news
37 use DateTime;
38 use Koha::Database;
39 use Koha::DateUtils;
40 use Text::Unaccent qw( unac_string );
41 use Koha::AuthUtils qw(hash_password);
42 use Koha::Database;
43 use Koha::Holds;
44 use Koha::List::Patron;
45 use Koha::Patrons;
46 use Koha::Patron::Categories;
47 use Koha::Schema;
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";
57 BEGIN {
58 $debug = $ENV{DEBUG} || 0;
59 require Exporter;
60 @ISA = qw(Exporter);
61 #Get data
62 push @EXPORT, qw(
64 &GetPendingIssues
65 &GetAllIssues
67 &GetMemberAccountRecords
69 &GetBorrowersToExpunge
71 &IssueSlip
73 GetOverduesForPatron
76 #Modify data
77 push @EXPORT, qw(
78 &ModMember
79 &changepassword
82 #Insert data
83 push @EXPORT, qw(
84 &AddMember
85 &AddMember_Auto
86 &AddMember_Opac
89 #Check data
90 push @EXPORT, qw(
91 &checkuserpassword
92 &Check_Userid
93 &Generate_Userid
94 &fixup_cardnumber
95 &checkcardnumber
99 =head1 NAME
101 C4::Members - Perl Module containing convenience functions for member handling
103 =head1 SYNOPSIS
105 use C4::Members;
107 =head1 DESCRIPTION
109 This module contains routines for adding, modifying and deleting members/patrons/borrowers
111 =head1 FUNCTIONS
113 =head2 patronflags
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
139 $flags->{ NOTES }
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
151 =over
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.
165 =back
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.
172 =cut
174 # TODO: use {anonymous => hashes} instead of a dozen %flaginfo
175 # FIXME rename this function.
176 sub patronflags {
177 my %flags;
178 my ( $patroninformation) = @_;
179 my $dbh=C4::Context->dbh;
180 my ($balance, $owing) = GetMemberAccountBalance( $patroninformation->{'borrowernumber'});
181 if ( $owing > 0 ) {
182 my %flaginfo;
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 ) {
192 my %flaginfo;
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 ) {
211 my %flaginfo;
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 )
222 my %flaginfo;
223 $flaginfo{'message'} = 'Borrower has no valid address.';
224 $flaginfo{'noissues'} = 1;
225 $flags{'GNA'} = \%flaginfo;
227 if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
228 my %flaginfo;
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'} ) ) ) {
235 my %flaginfo;
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'} )
246 my %flaginfo;
247 $flaginfo{'message'} = $patroninformation->{'borrowernotes'};
248 $flags{'NOTES'} = \%flaginfo;
250 my ( $odues, $itemsoverdue ) = C4::Overdues::checkoverdues($patroninformation->{'borrowernumber'});
251 if ( $odues && $odues > 0 ) {
252 my %flaginfo;
253 $flaginfo{'message'} = "Yes";
254 $flaginfo{'itemlist'} = $itemsoverdue;
255 foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
256 @$itemsoverdue )
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 ) {
268 my %flaginfo;
269 $flaginfo{'message'} = "Reserved items available";
270 $flaginfo{'itemlist'} = $waiting_holds->unblessed;
271 $flags{'WAITING'} = \%flaginfo;
273 return ( \%flags );
277 =head2 ModMember
279 my $success = ModMember(borrowernumber => $borrowernumber,
280 [ field => value ]... );
282 Modify borrower's data. All date fields should ALREADY be in ISO format.
284 return :
285 true on success, or false on failure
287 =cut
289 sub ModMember {
290 my (%data) = @_;
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};
303 } else {
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;
364 =head2 AddMember
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
372 column names.)
374 Returns the borrowernumber upon success
376 Returns as undef upon any db error without further processing
378 =cut
381 sub AddMember {
382 my (%data) = @_;
383 my $dbh = C4::Context->dbh;
384 my $schema = Koha::Database->new()->schema;
386 my $category = Koha::Patron::Categories->find( $data{categorycode} );
387 unless ($category) {
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} );
419 $data{'privacy'} =
420 $category->default_privacy() eq 'default' ? 1
421 : $category->default_privacy() eq 'never' ? 2
422 : $category->default_privacy() eq 'forever' ? 0
423 : undef;
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',
455 'sync' => 1,
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};
468 =head2 Check_Userid
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.
476 return :
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)
480 =cut
482 sub Check_Userid {
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');
491 my $params;
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.
508 return :
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).
511 =cut
513 sub Generate_Userid {
514 my ($borrowernumber, $firstname, $surname) = @_;
515 my $newuid;
516 my $offset = 0;
517 #The script will "do" the following code and increment the $offset until Check_Userid = 1 (i.e. until $newuid comes back as unique)
518 do {
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;
524 $offset++;
526 } while (!Check_Userid($newuid,$borrowernumber));
528 return $newuid;
531 =head2 fixup_cardnumber
533 Warning: The caller is responsible for locking the members table in write
534 mode, to avoid database corruption.
536 =cut
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"
564 $sth->execute;
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
569 } else {
570 $cardnumber += 1;
573 my $sum = 0;
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";
589 } else {
591 my $sth = $dbh->prepare(
592 'SELECT MAX( CAST( cardnumber AS SIGNED ) ) FROM borrowers WHERE cardnumber REGEXP "^-?[0-9]+$"'
594 $sth->execute;
595 my ($result) = $sth->fetchrow;
596 return $result + 1;
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.
612 =cut
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
622 my $bquery = '';
623 for (my $i = 0; $i < @borrowernumbers; $i++) {
624 $bquery .= ' issues.borrowernumber = ?';
625 if ($i < $#borrowernumbers ) {
626 $bquery .= ' OR';
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.
634 my $query =
635 "SELECT issues.*,
636 items.*,
637 biblio.*,
638 biblioitems.volume,
639 biblioitems.number,
640 biblioitems.itemtype,
641 biblioitems.isbn,
642 biblioitems.issn,
643 biblioitems.publicationyear,
644 biblioitems.publishercode,
645 biblioitems.volumedate,
646 biblioitems.volumedesc,
647 biblioitems.lccn,
648 biblioitems.url,
649 borrowers.firstname,
650 borrowers.surname,
651 borrowers.cardnumber,
652 issues.timestamp AS timestamp,
653 issues.renewals AS renewals,
654 issues.borrowernumber AS borrowernumber,
655 items.renewals AS totalrenewals
656 FROM issues
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
661 WHERE
662 $bquery
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;
670 foreach (@{$data}) {
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 ) {
681 $_->{overdue} = 1;
684 return $data;
687 =head2 GetAllIssues
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.
704 =cut
707 sub GetAllIssues {
708 my ( $borrowernumber, $order, $limit ) = @_;
710 return unless $borrowernumber;
711 $order = 'date_due desc' unless $order;
713 my $dbh = C4::Context->dbh;
714 my $query =
715 'SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
716 FROM issues
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=?
721 UNION ALL
722 SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
723 FROM old_issues
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
728 order by ' . $order;
729 if ($limit) {
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.
751 =cut
753 sub GetMemberAccountRecords {
754 my ($borrowernumber) = @_;
755 my $dbh = C4::Context->dbh;
756 my @acctlines;
757 my $numlines = 0;
758 my $strsth = qq(
759 SELECT *
760 FROM accountlines
761 WHERE borrowernumber=?);
762 $strsth.=" ORDER BY accountlines_id desc";
763 my $sth= $dbh->prepare( $strsth );
764 $sth->execute( $borrowernumber );
766 my $total = 0;
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;
775 $numlines++;
776 $total += sprintf "%.0f", 1000*$data->{amountoutstanding}; # convert float to integer to avoid round-off errors
778 $total /= 1000;
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:
789 * Res (reserves)
790 * Rent (rental) if RentalsInNoissuesCharge syspref is set to false
791 * Manual invoices if ManInvInNoissuesCharge syspref is set to false
793 =cut
795 sub GetMemberAccountBalance {
796 my ($borrowernumber) = @_;
798 my $ACCOUNT_TYPE_LENGTH = 5; # this is plain ridiculous...
800 my @not_fines;
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);
829 $sth->execute(
830 $cardnumber,
831 ( $borrowernumber ? $borrowernumber : () )
834 return 1 if $sth->fetchrow_hashref;
836 my ( $min_length, $max_length ) = get_cardnumber_length();
837 return 2
838 if length $cardnumber > $max_length
839 or length $cardnumber < $min_length;
841 return 0;
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
851 database column.
853 =cut
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.
890 =cut
892 sub GetBorrowersToExpunge {
894 my $params = shift;
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}
905 : "");
906 my $filterpatronlist = $params->{'patron_list_id'};
908 my $dbh = C4::Context->dbh;
909 my $query = q|
910 SELECT borrowers.borrowernumber,
911 MAX(old_issues.timestamp) AS latestissue,
912 MAX(issues.timestamp) AS currentissue
913 FROM borrowers
914 JOIN categories USING (categorycode)
915 LEFT JOIN (
916 SELECT guarantorid
917 FROM borrowers
918 WHERE guarantorid IS NOT NULL
919 AND guarantorid <> 0
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
929 my @query_params;
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 ";
951 if ( $filterdate ) {
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);
961 else {
962 $sth->execute;
965 my @results;
966 while ( my $data = $sth->fetchrow_hashref ) {
967 push @results, $data;
969 return \@results;
972 =head2 IssueSlip
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:
982 Both slips:
984 <<branches.*>>
985 <<borrowers.*>>
987 ISSUESLIP:
989 <checkedout>
990 <<biblio.*>>
991 <<items.*>>
992 <<biblioitems.*>>
993 <<issues.*>>
994 </checkedout>
996 <overdue>
997 <<biblio.*>>
998 <<items.*>>
999 <<biblioitems.*>>
1000 <<issues.*>>
1001 </overdue>
1003 <news>
1004 <<opac_news.*>>
1005 </news>
1007 ISSUEQSLIP:
1009 <checkedout>
1010 <<biblio.*>>
1011 <<items.*>>
1012 <<biblioitems.*>>
1013 <<issues.*>>
1014 </checkedout>
1016 NOTE: Not all table fields are available, pleasee see GetPendingIssues for a list of available fields.
1018 =cut
1020 sub IssueSlip {
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};
1033 if ($quickslip) {
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 ) {
1037 $issue->{now} = 1;
1042 # Sort on timestamp then on issuedate then on issue_id
1043 # useful for tests and could be if modified in a batch
1044 @issues = sort {
1045 $b->{timestamp} <=> $a->{timestamp}
1046 or $b->{issuedate} <=> $a->{issuedate}
1047 or $b->{issue_id} <=> $a->{issue_id}
1048 } @issues;
1050 my ($letter_code, %repeat, %loops);
1051 if ( $quickslip ) {
1052 $letter_code = 'ISSUEQSLIP';
1053 my @checkouts = map {
1054 'biblio' => $_,
1055 'items' => $_,
1056 'biblioitems' => $_,
1057 'issues' => $_,
1058 }, grep { $_->{'now'} } @issues;
1059 %repeat = (
1060 checkedout => \@checkouts, # History syntax
1062 %loops = (
1063 issues => [ map { $_->{issues}{itemnumber} } @checkouts ], # TT syntax
1066 else {
1067 my @checkouts = map {
1068 'biblio' => $_,
1069 'items' => $_,
1070 'biblioitems' => $_,
1071 'issues' => $_,
1072 }, grep { !$_->{'overdue'} } @issues;
1073 my @overdues = map {
1074 'biblio' => $_,
1075 'items' => $_,
1076 'biblioitems' => $_,
1077 'issues' => $_,
1078 }, grep { $_->{'overdue'} } @issues;
1079 my $news = GetNewsToDisplay( "slip", $branch );
1080 my @news = map {
1081 $_->{'timestamp'} = $_->{'newdate'};
1082 { opac_news => $_ }
1083 } @$news;
1084 $letter_code = 'ISSUESLIP';
1085 %repeat = (
1086 checkedout => \@checkouts,
1087 overdue => \@overdues,
1088 news => \@news,
1090 %loops = (
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,
1102 tables => {
1103 'branches' => $branch,
1104 'borrowers' => $borrowernumber,
1106 repeat => \%repeat,
1107 loops => \%loops,
1111 =head2 AddMember_Auto
1113 =cut
1115 sub AddMember_Auto {
1116 my ( %borrower ) = @_;
1118 $borrower{'cardnumber'} ||= fixup_cardnumber();
1120 $borrower{'borrowernumber'} = AddMember(%borrower);
1122 return ( %borrower );
1125 =head2 AddMember_Opac
1127 =cut
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
1150 =cut
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||;
1159 my $query = qq|
1160 SELECT borrowernumber
1161 FROM borrowers
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 );
1167 my $cnt=0;
1168 while ( my ($borrowernumber) = $sth->fetchrow_array() ) {
1169 Koha::Patrons->find($borrowernumber)->delete;
1170 $cnt++;
1172 return $cnt;
1175 =head2 DeleteUnverifiedOpacRegistrations
1177 Delete all unverified self registrations in borrower_modifications,
1178 older than the specified number of days.
1180 =cut
1182 sub DeleteUnverifiedOpacRegistrations {
1183 my ( $days ) = @_;
1184 my $dbh = C4::Context->dbh;
1185 my $sql=qq|
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 ) = @_;
1195 my $sql = "
1196 SELECT *
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)
1215 __END__
1217 =head1 AUTHOR
1219 Koha Team
1221 =cut