← Index
NYTProf Performance Profile   « block view • line view • sub view »
For /usr/share/koha/opac/cgi-bin/opac/opac-search.pl
  Run on Tue Oct 15 11:58:52 2013
Reported on Tue Oct 15 12:01:04 2013

Filename/usr/share/koha/lib/C4/Members.pm
StatementsExecuted 73 statements in 14.1ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1114.02ms528msC4::Members::::BEGIN@31C4::Members::BEGIN@31
1112.29ms2.50msC4::Members::::BEGIN@28C4::Members::BEGIN@28
1111.17ms1.55msC4::Members::::BEGIN@30C4::Members::BEGIN@30
1111.03ms1.41msC4::Members::::BEGIN@38C4::Members::BEGIN@38
111419µs1.36msC4::Members::::BEGIN@42C4::Members::BEGIN@42
11163µs63µsC4::Members::::BEGIN@46C4::Members::BEGIN@46
11120µs133µsC4::Members::::BEGIN@41C4::Members::BEGIN@41
11120µs100µsC4::Members::::BEGIN@36C4::Members::BEGIN@36
11118µs84µsC4::Members::::BEGIN@29C4::Members::BEGIN@29
11117µs21µsC4::Members::::BEGIN@23C4::Members::BEGIN@23
11117µs580µsC4::Members::::BEGIN@34C4::Members::BEGIN@34
11115µs366µsC4::Members::::BEGIN@32C4::Members::BEGIN@32
11115µs58µsC4::Members::::BEGIN@891C4::Members::BEGIN@891
11114µs223µsC4::Members::::BEGIN@35C4::Members::BEGIN@35
11114µs14µsC4::Members::::BEGIN@39C4::Members::BEGIN@39
11114µs51µsC4::Members::::BEGIN@37C4::Members::BEGIN@37
11114µs235µsC4::Members::::BEGIN@33C4::Members::BEGIN@33
11113µs57µsC4::Members::::BEGIN@26C4::Members::BEGIN@26
11112µs12µsC4::Members::::BEGIN@40C4::Members::BEGIN@40
11110µs12µsC4::Members::::BEGIN@25C4::Members::BEGIN@25
1119µs40µsC4::Members::::BEGIN@27C4::Members::BEGIN@27
1114µs4µsC4::Members::::ENDC4::Members::END
0000s0sC4::Members::::AddMemberC4::Members::AddMember
0000s0sC4::Members::::AddMember_OpacC4::Members::AddMember_Opac
0000s0sC4::Members::::AddMessageC4::Members::AddMessage
0000s0sC4::Members::::Check_UseridC4::Members::Check_Userid
0000s0sC4::Members::::DebarMemberC4::Members::DebarMember
0000s0sC4::Members::::DelMemberC4::Members::DelMember
0000s0sC4::Members::::DeleteMessageC4::Members::DeleteMessage
0000s0sC4::Members::::ExtendMemberSubscriptionToC4::Members::ExtendMemberSubscriptionTo
0000s0sC4::Members::::Generate_UseridC4::Members::Generate_Userid
0000s0sC4::Members::::GetAgeC4::Members::GetAge
0000s0sC4::Members::::GetAllIssuesC4::Members::GetAllIssues
0000s0sC4::Members::::GetBorNotifyAcctRecordC4::Members::GetBorNotifyAcctRecord
0000s0sC4::Members::::GetBorrowerCategorycodeC4::Members::GetBorrowerCategorycode
0000s0sC4::Members::::GetBorrowercategoryC4::Members::GetBorrowercategory
0000s0sC4::Members::::GetBorrowercategoryListC4::Members::GetBorrowercategoryList
0000s0sC4::Members::::GetBorrowersNamesAndLatestIssueC4::Members::GetBorrowersNamesAndLatestIssue
0000s0sC4::Members::::GetBorrowersToExpungeC4::Members::GetBorrowersToExpunge
0000s0sC4::Members::::GetBorrowersWhoHaveNeverBorrowedC4::Members::GetBorrowersWhoHaveNeverBorrowed
0000s0sC4::Members::::GetBorrowersWithEmailC4::Members::GetBorrowersWithEmail
0000s0sC4::Members::::GetBorrowersWithIssuesHistoryOlderThanC4::Members::GetBorrowersWithIssuesHistoryOlderThan
0000s0sC4::Members::::GetCitiesC4::Members::GetCities
0000s0sC4::Members::::GetExpiryDateC4::Members::GetExpiryDate
0000s0sC4::Members::::GetFirstValidEmailAddressC4::Members::GetFirstValidEmailAddress
0000s0sC4::Members::::GetGuaranteesC4::Members::GetGuarantees
0000s0sC4::Members::::GetHideLostItemsPreferenceC4::Members::GetHideLostItemsPreference
0000s0sC4::Members::::GetMemberC4::Members::GetMember
0000s0sC4::Members::::GetMemberAccountBalanceC4::Members::GetMemberAccountBalance
0000s0sC4::Members::::GetMemberAccountRecordsC4::Members::GetMemberAccountRecords
0000s0sC4::Members::::GetMemberDetailsC4::Members::GetMemberDetails
0000s0sC4::Members::::GetMemberIssuesAndFinesC4::Members::GetMemberIssuesAndFines
0000s0sC4::Members::::GetMemberRelativesC4::Members::GetMemberRelatives
0000s0sC4::Members::::GetMessagesC4::Members::GetMessages
0000s0sC4::Members::::GetMessagesCountC4::Members::GetMessagesCount
0000s0sC4::Members::::GetNoticeEmailAddressC4::Members::GetNoticeEmailAddress
0000s0sC4::Members::::GetPatronImageC4::Members::GetPatronImage
0000s0sC4::Members::::GetPendingIssuesC4::Members::GetPendingIssues
0000s0sC4::Members::::GetRoadTypeDetailsC4::Members::GetRoadTypeDetails
0000s0sC4::Members::::GetRoadTypesC4::Members::GetRoadTypes
0000s0sC4::Members::::GetSortDetailsC4::Members::GetSortDetails
0000s0sC4::Members::::GetTitlesC4::Members::GetTitles
0000s0sC4::Members::::GetborCatFromCatTypeC4::Members::GetborCatFromCatType
0000s0sC4::Members::::IsMemberBlockedC4::Members::IsMemberBlocked
0000s0sC4::Members::::IssueSlipC4::Members::IssueSlip
0000s0sC4::Members::::ModMemberC4::Members::ModMember
0000s0sC4::Members::::ModPrivacyC4::Members::ModPrivacy
0000s0sC4::Members::::MoveMemberToDeletedC4::Members::MoveMemberToDeleted
0000s0sC4::Members::::PutPatronImageC4::Members::PutPatronImage
0000s0sC4::Members::::RmPatronImageC4::Members::RmPatronImage
0000s0sC4::Members::::SearchC4::Members::Search
0000s0sC4::Members::::UpdateGuaranteesC4::Members::UpdateGuarantees
0000s0sC4::Members::::_express_member_findC4::Members::_express_member_find
0000s0sC4::Members::::add_member_orgsC4::Members::add_member_orgs
0000s0sC4::Members::::changepasswordC4::Members::changepassword
0000s0sC4::Members::::checkcardnumberC4::Members::checkcardnumber
0000s0sC4::Members::::checkuniquememberC4::Members::checkuniquemember
0000s0sC4::Members::::checkuserpasswordC4::Members::checkuserpassword
0000s0sC4::Members::::columnsC4::Members::columns
0000s0sC4::Members::::ethnicitycategoriesC4::Members::ethnicitycategories
0000s0sC4::Members::::fixEthnicityC4::Members::fixEthnicity
0000s0sC4::Members::::fixup_cardnumberC4::Members::fixup_cardnumber
0000s0sC4::Members::::get_institutionsC4::Members::get_institutions
0000s0sC4::Members::::getidcityC4::Members::getidcity
0000s0sC4::Members::::getzipnamecityC4::Members::getzipnamecity
0000s0sC4::Members::::patronflagsC4::Members::patronflags
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package C4::Members;
2
3# Copyright 2000-2003 Katipo Communications
4# Copyright 2010 BibLibre
5# Parts Copyright 2010 Catalyst IT
6#
7# This file is part of Koha.
8#
9# Koha is free software; you can redistribute it and/or modify it under the
10# terms of the GNU General Public License as published by the Free Software
11# Foundation; either version 2 of the License, or (at your option) any later
12# version.
13#
14# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
15# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
16# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
17#
18# You should have received a copy of the GNU General Public License along
19# with Koha; if not, write to the Free Software Foundation, Inc.,
20# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
21
22
23329µs225µs
# spent 21µs (17+4) within C4::Members::BEGIN@23 which was called: # once (17µs+4µs) by C4::Auth_with_ldap::BEGIN@26 at line 23
use strict;
# spent 21µs making 1 call to C4::Members::BEGIN@23 # spent 4µs making 1 call to strict::import
24#use warnings; FIXME - Bug 2505
25328µs213µs
# spent 12µs (10+2) within C4::Members::BEGIN@25 which was called: # once (10µs+2µs) by C4::Auth_with_ldap::BEGIN@26 at line 25
use C4::Context;
# spent 12µs making 1 call to C4::Members::BEGIN@25 # spent 2µs making 1 call to C4::Context::import
26335µs2101µs
# spent 57µs (13+44) within C4::Members::BEGIN@26 which was called: # once (13µs+44µs) by C4::Auth_with_ldap::BEGIN@26 at line 26
use C4::Dates qw(format_date_in_iso format_date);
# spent 57µs making 1 call to C4::Members::BEGIN@26 # spent 44µs making 1 call to Exporter::import
27329µs271µs
# spent 40µs (9+31) within C4::Members::BEGIN@27 which was called: # once (9µs+31µs) by C4::Auth_with_ldap::BEGIN@26 at line 27
use Digest::MD5 qw(md5_base64);
# spent 40µs making 1 call to C4::Members::BEGIN@27 # spent 31µs making 1 call to Exporter::import
283149µs22.57ms
# spent 2.50ms (2.29+211µs) within C4::Members::BEGIN@28 which was called: # once (2.29ms+211µs) by C4::Auth_with_ldap::BEGIN@26 at line 28
use String::Random qw( random_string );
# spent 2.50ms making 1 call to C4::Members::BEGIN@28 # spent 62µs making 1 call to Exporter::import
29338µs2150µs
# spent 84µs (18+66) within C4::Members::BEGIN@29 which was called: # once (18µs+66µs) by C4::Auth_with_ldap::BEGIN@26 at line 29
use Date::Calc qw/Today Add_Delta_YM check_date Date_to_Days/;
# spent 84µs making 1 call to C4::Members::BEGIN@29 # spent 66µs making 1 call to Exporter::import
303138µs21.69ms
# spent 1.55ms (1.17+374µs) within C4::Members::BEGIN@30 which was called: # once (1.17ms+374µs) by C4::Auth_with_ldap::BEGIN@26 at line 30
use C4::Log; # logaction
# spent 1.55ms making 1 call to C4::Members::BEGIN@30 # spent 146µs making 1 call to Exporter::import
313195µs2529ms
# spent 528ms (4.02+524) within C4::Members::BEGIN@31 which was called: # once (4.02ms+524ms) by C4::Auth_with_ldap::BEGIN@26 at line 31
use C4::Overdues;
# spent 528ms making 1 call to C4::Members::BEGIN@31 # spent 372µs making 1 call to Exporter::import
32337µs2717µs
# spent 366µs (15+351) within C4::Members::BEGIN@32 which was called: # once (15µs+351µs) by C4::Auth_with_ldap::BEGIN@26 at line 32
use C4::Reserves;
# spent 366µs making 1 call to C4::Members::BEGIN@32 # spent 351µs making 1 call to Exporter::import
33338µs2457µs
# spent 235µs (14+222) within C4::Members::BEGIN@33 which was called: # once (14µs+222µs) by C4::Auth_with_ldap::BEGIN@26 at line 33
use C4::Accounts;
# spent 235µs making 1 call to C4::Members::BEGIN@33 # spent 222µs making 1 call to Exporter::import
34339µs21.14ms
# spent 580µs (17+563) within C4::Members::BEGIN@34 which was called: # once (17µs+563µs) by C4::Auth_with_ldap::BEGIN@26 at line 34
use C4::Biblio;
# spent 580µs making 1 call to C4::Members::BEGIN@34 # spent 563µs making 1 call to Exporter::import
35343µs2432µs
# spent 223µs (14+209) within C4::Members::BEGIN@35 which was called: # once (14µs+209µs) by C4::Auth_with_ldap::BEGIN@26 at line 35
use C4::Letters;
# spent 223µs making 1 call to C4::Members::BEGIN@35 # spent 209µs making 1 call to Exporter::import
36345µs2180µs
# spent 100µs (20+80) within C4::Members::BEGIN@36 which was called: # once (20µs+80µs) by C4::Auth_with_ldap::BEGIN@26 at line 36
use C4::SQLHelper qw(InsertInTable UpdateInTable SearchInTable);
# spent 100µs making 1 call to C4::Members::BEGIN@36 # spent 80µs making 1 call to Exporter::import
37332µs289µs
# spent 51µs (14+37) within C4::Members::BEGIN@37 which was called: # once (14µs+37µs) by C4::Auth_with_ldap::BEGIN@26 at line 37
use C4::Members::Attributes qw(SearchIdMatchingAttribute);
# spent 51µs making 1 call to C4::Members::BEGIN@37 # spent 38µs making 1 call to Exporter::import
383167µs21.54ms
# spent 1.41ms (1.03+382µs) within C4::Members::BEGIN@38 which was called: # once (1.03ms+382µs) by C4::Auth_with_ldap::BEGIN@26 at line 38
use C4::NewsChannels; #get slip news
# spent 1.41ms making 1 call to C4::Members::BEGIN@38 # spent 126µs making 1 call to Exporter::import
39356µs114µs
# spent 14µs within C4::Members::BEGIN@39 which was called: # once (14µs+0s) by C4::Auth_with_ldap::BEGIN@26 at line 39
use DateTime;
# spent 14µs making 1 call to C4::Members::BEGIN@39
40346µs112µs
# spent 12µs within C4::Members::BEGIN@40 which was called: # once (12µs+0s) by C4::Auth_with_ldap::BEGIN@26 at line 40
use DateTime::Format::DateParse;
# spent 12µs making 1 call to C4::Members::BEGIN@40
41363µs2245µs
# spent 133µs (20+112) within C4::Members::BEGIN@41 which was called: # once (20µs+112µs) by C4::Auth_with_ldap::BEGIN@26 at line 41
use Koha::DateUtils;
# spent 133µs making 1 call to C4::Members::BEGIN@41 # spent 112µs making 1 call to Exporter::import
423548µs21.47ms
# spent 1.36ms (419µs+937µs) within C4::Members::BEGIN@42 which was called: # once (419µs+937µs) by C4::Auth_with_ldap::BEGIN@26 at line 42
use Text::Unaccent qw( unac_string );
# spent 1.36ms making 1 call to C4::Members::BEGIN@42 # spent 108µs making 1 call to Exporter::import
43
4413µsour ($VERSION,@ISA,@EXPORT,@EXPORT_OK,$debug);
45
46
# spent 63µs within C4::Members::BEGIN@46 which was called: # once (63µs+0s) by C4::Auth_with_ldap::BEGIN@26 at line 140
BEGIN {
47965µs $VERSION = 3.07.00.049;
48 $debug = $ENV{DEBUG} || 0;
49 require Exporter;
50 @ISA = qw(Exporter);
51 #Get data
52 push @EXPORT, qw(
53 &Search
54 &GetMemberDetails
55 &GetMemberRelatives
56 &GetMember
57
58 &GetGuarantees
59
60 &GetMemberIssuesAndFines
61 &GetPendingIssues
62 &GetAllIssues
63
64 &get_institutions
65 &getzipnamecity
66 &getidcity
67
68 &GetFirstValidEmailAddress
69 &GetNoticeEmailAddress
70
71 &GetAge
72 &GetCities
73 &GetRoadTypes
74 &GetRoadTypeDetails
75 &GetSortDetails
76 &GetTitles
77
78 &GetPatronImage
79 &PutPatronImage
80 &RmPatronImage
81
82 &GetHideLostItemsPreference
83
84 &IsMemberBlocked
85 &GetMemberAccountRecords
86 &GetBorNotifyAcctRecord
87
88 &GetborCatFromCatType
89 &GetBorrowercategory
90 GetBorrowerCategorycode
91 &GetBorrowercategoryList
92
93 &GetBorrowersToExpunge
94 &GetBorrowersWhoHaveNeverBorrowed
95 &GetBorrowersWithIssuesHistoryOlderThan
96
97 &GetExpiryDate
98
99 &AddMessage
100 &DeleteMessage
101 &GetMessages
102 &GetMessagesCount
103
104 &IssueSlip
105 GetBorrowersWithEmail
106 );
107
108 #Modify data
109 push @EXPORT, qw(
110 &ModMember
111 &changepassword
112 &ModPrivacy
113 );
114
115 #Delete data
116 push @EXPORT, qw(
117 &DelMember
118 );
119
120 #Insert data
121 push @EXPORT, qw(
122 &AddMember
123 &AddMember_Opac
124 &add_member_orgs
125 &MoveMemberToDeleted
126 &ExtendMemberSubscriptionTo
127 );
128
129 #Check data
130 push @EXPORT, qw(
131 &checkuniquemember
132 &checkuserpassword
133 &Check_Userid
134 &Generate_Userid
135 &fixEthnicity
136 &ethnicitycategories
137 &fixup_cardnumber
138 &checkcardnumber
139 );
14013.37ms163µs}
# spent 63µs making 1 call to C4::Members::BEGIN@46
141
142=head1 NAME
143
- -
177sub _express_member_find {
178 my ($filter) = @_;
179
180 # this is used by circulation everytime a new borrowers cardnumber is scanned
181 # so we can check an exact match first, if that works return, otherwise do the rest
182 my $dbh = C4::Context->dbh;
183 my $query = "SELECT borrowernumber FROM borrowers WHERE cardnumber = ?";
184 if ( my $borrowernumber = $dbh->selectrow_array($query, undef, $filter) ) {
185 return( {"borrowernumber"=>$borrowernumber} );
186 }
187
188 my ($search_on_fields, $searchtype);
189 if ( length($filter) == 1 ) {
190 $search_on_fields = [ qw(surname) ];
191 $searchtype = 'start_with';
192 } else {
193 $search_on_fields = [ qw(surname firstname othernames cardnumber) ];
194 $searchtype = 'contain';
195 }
196
197 return (undef, $search_on_fields, $searchtype);
198}
199
200sub Search {
201 my ( $filter, $orderby, $limit, $columns_out, $search_on_fields, $searchtype ) = @_;
202
203 my $search_string;
204 my $found_borrower;
205
206 if ( my $fr = ref $filter ) {
207 if ( $fr eq "HASH" ) {
208 if ( my $search_string = $filter->{''} ) {
209 my ($member_filter, $member_search_on_fields, $member_searchtype) = _express_member_find($search_string);
210 if ($member_filter) {
211 $filter = $member_filter;
212 $found_borrower = 1;
213 } else {
214 $search_on_fields ||= $member_search_on_fields;
215 $searchtype ||= $member_searchtype;
216 }
217 }
218 }
219 else {
220 $search_string = $filter;
221 }
222 }
223 else {
224 $search_string = $filter;
225 my ($member_filter, $member_search_on_fields, $member_searchtype) = _express_member_find($search_string);
226 if ($member_filter) {
227 $filter = $member_filter;
228 $found_borrower = 1;
229 } else {
230 $search_on_fields ||= $member_search_on_fields;
231 $searchtype ||= $member_searchtype;
232 }
233 }
234
235 if ( !$found_borrower && C4::Context->preference('ExtendedPatronAttributes') && $search_string ) {
236 my $matching_records = C4::Members::Attributes::SearchIdMatchingAttribute($search_string);
237 if(scalar(@$matching_records)>0) {
238 if ( my $fr = ref $filter ) {
239 if ( $fr eq "HASH" ) {
240 my %f = %$filter;
241 $filter = [ $filter ];
242 delete $f{''};
243 push @$filter, { %f, "borrowernumber"=>$$matching_records };
244 }
245 else {
246 push @$filter, {"borrowernumber"=>$matching_records};
247 }
248 }
249 else {
250 $filter = [ $filter ];
251 push @$filter, {"borrowernumber"=>$matching_records};
252 }
253 }
254 }
255
256 # $showallbranches was not used at the time SearchMember() was mainstreamed into Search().
257 # Mentioning for the reference
258
259 if ( C4::Context->preference("IndependantBranches") ) { # && !$showallbranches){
260 if ( my $userenv = C4::Context->userenv ) {
261 my $branch = $userenv->{'branch'};
262 if ( ($userenv->{flags} % 2 !=1) && $branch ){
263 if (my $fr = ref $filter) {
264 if ( $fr eq "HASH" ) {
265 $filter->{branchcode} = $branch;
266 }
267 else {
268 foreach (@$filter) {
269 $_ = { '' => $_ } unless ref $_;
270 $_->{branchcode} = $branch;
271 }
272 }
273 }
274 else {
275 $filter = { '' => $filter, branchcode => $branch };
276 }
277 }
278 }
279 }
280
281 if ($found_borrower) {
282 $searchtype = "exact";
283 }
284 $searchtype ||= "start_with";
285
286 return SearchInTable( "borrowers", $filter, $orderby, $limit, $columns_out, $search_on_fields, $searchtype );
287}
288
289=head2 GetMemberDetails
290
- -
321sub GetMemberDetails {
322 my ( $borrowernumber, $cardnumber ) = @_;
323 my $dbh = C4::Context->dbh;
324 my $query;
325 my $sth;
326 if ($borrowernumber) {
327 $sth = $dbh->prepare("SELECT borrowers.*,category_type,categories.description,reservefee,enrolmentperiod FROM borrowers LEFT JOIN categories ON borrowers.categorycode=categories.categorycode WHERE borrowernumber=?");
328 $sth->execute($borrowernumber);
329 }
330 elsif ($cardnumber) {
331 $sth = $dbh->prepare("SELECT borrowers.*,category_type,categories.description,reservefee,enrolmentperiod FROM borrowers LEFT JOIN categories ON borrowers.categorycode=categories.categorycode WHERE cardnumber=?");
332 $sth->execute($cardnumber);
333 }
334 else {
335 return;
336 }
337 my $borrower = $sth->fetchrow_hashref;
338 my ($amount) = GetMemberAccountRecords( $borrowernumber);
339 $borrower->{'amountoutstanding'} = $amount;
340 # FIXME - patronflags calls GetMemberAccountRecords... just have patronflags return $amount
341 my $flags = patronflags( $borrower);
342 my $accessflagshash;
343
344 $sth = $dbh->prepare("select bit,flag from userflags");
345 $sth->execute;
346 while ( my ( $bit, $flag ) = $sth->fetchrow ) {
347 if ( $borrower->{'flags'} && $borrower->{'flags'} & 2**$bit ) {
348 $accessflagshash->{$flag} = 1;
349 }
350 }
351 $borrower->{'flags'} = $flags;
352 $borrower->{'authflags'} = $accessflagshash;
353
354 # For the purposes of making templates easier, we'll define a
355 # 'showname' which is the alternate form the user's first name if
356 # 'other name' is defined.
357 if ($borrower->{category_type} eq 'I') {
358 $borrower->{'showname'} = $borrower->{'othernames'};
359 $borrower->{'showname'} .= " $borrower->{'firstname'}" if $borrower->{'firstname'};
360 } else {
361 $borrower->{'showname'} = $borrower->{'firstname'};
362 }
363
364 return ($borrower); #, $flags, $accessflagshash);
365}
366
367=head2 patronflags
368
- -
428# TODO: use {anonymous => hashes} instead of a dozen %flaginfo
429# FIXME rename this function.
430sub patronflags {
431 my %flags;
432 my ( $patroninformation) = @_;
433 my $dbh=C4::Context->dbh;
434 my ($balance, $owing) = GetMemberAccountBalance( $patroninformation->{'borrowernumber'});
435 if ( $owing > 0 ) {
436 my %flaginfo;
437 my $noissuescharge = C4::Context->preference("noissuescharge") || 5;
438 $flaginfo{'message'} = sprintf 'Patron owes %.02f', $owing;
439 $flaginfo{'amount'} = sprintf "%.02f", $owing;
440 if ( $owing > $noissuescharge && !C4::Context->preference("AllowFineOverride") ) {
441 $flaginfo{'noissues'} = 1;
442 }
443 $flags{'CHARGES'} = \%flaginfo;
444 }
445 elsif ( $balance < 0 ) {
446 my %flaginfo;
447 $flaginfo{'message'} = sprintf 'Patron has credit of %.02f', -$balance;
448 $flaginfo{'amount'} = sprintf "%.02f", $balance;
449 $flags{'CREDITS'} = \%flaginfo;
450 }
451 if ( $patroninformation->{'gonenoaddress'}
452 && $patroninformation->{'gonenoaddress'} == 1 )
453 {
454 my %flaginfo;
455 $flaginfo{'message'} = 'Borrower has no valid address.';
456 $flaginfo{'noissues'} = 1;
457 $flags{'GNA'} = \%flaginfo;
458 }
459 if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
460 my %flaginfo;
461 $flaginfo{'message'} = 'Borrower\'s card reported lost.';
462 $flaginfo{'noissues'} = 1;
463 $flags{'LOST'} = \%flaginfo;
464 }
465 if ( $patroninformation->{'debarred'} && check_date( split( /-/, $patroninformation->{'debarred'} ) ) ) {
466 if ( Date_to_Days(Date::Calc::Today) < Date_to_Days( split( /-/, $patroninformation->{'debarred'} ) ) ) {
467 my %flaginfo;
468 $flaginfo{'debarredcomment'} = $patroninformation->{'debarredcomment'};
469 $flaginfo{'message'} = $patroninformation->{'debarredcomment'};
470 $flaginfo{'noissues'} = 1;
471 $flaginfo{'dateend'} = $patroninformation->{'debarred'};
472 $flags{'DBARRED'} = \%flaginfo;
473 }
474 }
475 if ( $patroninformation->{'borrowernotes'}
476 && $patroninformation->{'borrowernotes'} )
477 {
478 my %flaginfo;
479 $flaginfo{'message'} = $patroninformation->{'borrowernotes'};
480 $flags{'NOTES'} = \%flaginfo;
481 }
482 my ( $odues, $itemsoverdue ) = C4::Overdues::checkoverdues($patroninformation->{'borrowernumber'});
483 if ( $odues && $odues > 0 ) {
484 my %flaginfo;
485 $flaginfo{'message'} = "Yes";
486 $flaginfo{'itemlist'} = $itemsoverdue;
487 foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
488 @$itemsoverdue )
489 {
490 $flaginfo{'itemlisttext'} .=
491 "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n"; # newline is display layer
492 }
493 $flags{'ODUES'} = \%flaginfo;
494 }
495 my @itemswaiting = C4::Reserves::GetReservesFromBorrowernumber( $patroninformation->{'borrowernumber'},'W' );
496 my $nowaiting = scalar @itemswaiting;
497 if ( $nowaiting > 0 ) {
498 my %flaginfo;
499 $flaginfo{'message'} = "Reserved items available";
500 $flaginfo{'itemlist'} = \@itemswaiting;
501 $flags{'WAITING'} = \%flaginfo;
502 }
503 return ( \%flags );
504}
505
506
507=head2 GetMember
508
- -
526#'
527sub GetMember {
528 my ( %information ) = @_;
529 if (exists $information{borrowernumber} && !defined $information{borrowernumber}) {
530 #passing mysql's kohaadmin?? Makes no sense as a query
531 return;
532 }
533 my $dbh = C4::Context->dbh;
534 my $select =
535 q{SELECT borrowers.*, categories.category_type, categories.description
536 FROM borrowers
537 LEFT JOIN categories on borrowers.categorycode=categories.categorycode WHERE };
538 my $more_p = 0;
539 my @values = ();
540 for (keys %information ) {
541 if ($more_p) {
542 $select .= ' AND ';
543 }
544 else {
545 $more_p++;
546 }
547
548 if (defined $information{$_}) {
549 $select .= "$_ = ?";
550 push @values, $information{$_};
551 }
552 else {
553 $select .= "$_ IS NULL";
554 }
555 }
556 $debug && warn $select, " ",values %information;
557 my $sth = $dbh->prepare("$select");
558 $sth->execute(map{$information{$_}} keys %information);
559 my $data = $sth->fetchall_arrayref({});
560 #FIXME interface to this routine now allows generation of a result set
561 #so whole array should be returned but bowhere in the current code expects this
562 if (@{$data} ) {
563 my $user = $data->[0];
564 $user->{showname} = $user->{othernames} || $user->{firstname};
565 return $user;
566 }
567
568 return;
569}
570
571=head2 GetMemberRelatives
572
- -
578sub GetMemberRelatives {
579 my $borrowernumber = shift;
580 my $dbh = C4::Context->dbh;
581 my @glist;
582
583 # Getting guarantor
584 my $query = "SELECT guarantorid FROM borrowers WHERE borrowernumber=?";
585 my $sth = $dbh->prepare($query);
586 $sth->execute($borrowernumber);
587 my $data = $sth->fetchrow_arrayref();
588 push @glist, $data->[0] if $data->[0];
589 my $guarantor = $data->[0] ? $data->[0] : undef;
590
591 # Getting guarantees
592 $query = "SELECT borrowernumber FROM borrowers WHERE guarantorid=?";
593 $sth = $dbh->prepare($query);
594 $sth->execute($borrowernumber);
595 while ($data = $sth->fetchrow_arrayref()) {
596 push @glist, $data->[0];
597 }
598
599 # Getting sibling guarantees
600 if ($guarantor) {
601 $query = "SELECT borrowernumber FROM borrowers WHERE guarantorid=?";
602 $sth = $dbh->prepare($query);
603 $sth->execute($guarantor);
604 while ($data = $sth->fetchrow_arrayref()) {
605 push @glist, $data->[0] if ($data->[0] != $borrowernumber);
606 }
607 }
608
609 return @glist;
610}
611
612=head2 IsMemberBlocked
613
- -
637sub IsMemberBlocked {
638 my $borrowernumber = shift;
639 my $dbh = C4::Context->dbh;
640
641 my $blockeddate = CheckBorrowerDebarred($borrowernumber);
642
643 return ( 1, $blockeddate ) if $blockeddate;
644
645 # if he have late issues
646 my $sth = $dbh->prepare(
647 "SELECT COUNT(*) as latedocs
648 FROM issues
649 WHERE borrowernumber = ?
650 AND date_due < now()"
651 );
652 $sth->execute($borrowernumber);
653 my $latedocs = $sth->fetchrow_hashref->{'latedocs'};
654
655 return ( -1, $latedocs ) if $latedocs > 0;
656
657 return ( 0, 0 );
658}
659
660=head2 GetMemberIssuesAndFines
661
- -
674#'
675sub GetMemberIssuesAndFines {
676 my ( $borrowernumber ) = @_;
677 my $dbh = C4::Context->dbh;
678 my $query = "SELECT COUNT(*) FROM issues WHERE borrowernumber = ?";
679
680 $debug and warn $query."\n";
681 my $sth = $dbh->prepare($query);
682 $sth->execute($borrowernumber);
683 my $issue_count = $sth->fetchrow_arrayref->[0];
684
685 $sth = $dbh->prepare(
686 "SELECT COUNT(*) FROM issues
687 WHERE borrowernumber = ?
688 AND date_due < now()"
689 );
690 $sth->execute($borrowernumber);
691 my $overdue_count = $sth->fetchrow_arrayref->[0];
692
693 $sth = $dbh->prepare("SELECT SUM(amountoutstanding) FROM accountlines WHERE borrowernumber = ?");
694 $sth->execute($borrowernumber);
695 my $total_fines = $sth->fetchrow_arrayref->[0];
696
697 return ($overdue_count, $issue_count, $total_fines);
698}
699
700sub columns(;$) {
701 return @{C4::Context->dbh->selectcol_arrayref("SHOW columns from borrowers")};
702}
703
704=head2 ModMember
705
- -
716sub ModMember {
717 my (%data) = @_;
718 # test to know if you must update or not the borrower password
719 if (exists $data{password}) {
720 if ($data{password} eq '****' or $data{password} eq '') {
721 delete $data{password};
722 } else {
723 $data{password} = md5_base64($data{password});
724 }
725 }
726 my $execute_success=UpdateInTable("borrowers",\%data);
727 if ($execute_success) { # only proceed if the update was a success
728 # ok if its an adult (type) it may have borrowers that depend on it as a guarantor
729 # so when we update information for an adult we should check for guarantees and update the relevant part
730 # of their records, ie addresses and phone numbers
731 my $borrowercategory= GetBorrowercategory( $data{'category_type'} );
732 if ( exists $borrowercategory->{'category_type'} && $borrowercategory->{'category_type'} eq ('A' || 'S') ) {
733 # is adult check guarantees;
734 UpdateGuarantees(%data);
735 }
736 logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "UPDATE (executed w/ arg: $data{'borrowernumber'})") if C4::Context->preference("BorrowersLog");
737 }
738 return $execute_success;
739}
740
741
742=head2 AddMember
743
- -
753#'
754sub AddMember {
755 my (%data) = @_;
756 my $dbh = C4::Context->dbh;
757
758 # generate a proper login if none provided
759 $data{'userid'} = Generate_Userid($data{'borrowernumber'}, $data{'firstname'}, $data{'surname'}) if $data{'userid'} eq '';
760
761 # add expiration date if it isn't already there
762 unless ( $data{'dateexpiry'} ) {
763 $data{'dateexpiry'} = GetExpiryDate( $data{'categorycode'}, C4::Dates->new()->output("iso") );
764 }
765
766 # add enrollment date if it isn't already there
767 unless ( $data{'dateenrolled'} ) {
768 $data{'dateenrolled'} = C4::Dates->new()->output("iso");
769 }
770
771 # create a disabled account if no password provided
772 $data{'password'} = ($data{'password'})? md5_base64($data{'password'}) : '!';
773 $data{'borrowernumber'}=InsertInTable("borrowers",\%data);
774
775
776 # mysql_insertid is probably bad. not necessarily accurate and mysql-specific at best.
777 logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");
778
779 # check for enrollment fee & add it if needed
780 my $sth = $dbh->prepare("SELECT enrolmentfee FROM categories WHERE categorycode=?");
781 $sth->execute($data{'categorycode'});
782 my ($enrolmentfee) = $sth->fetchrow;
783 if ($sth->err) {
784 warn sprintf('Database returned the following error: %s', $sth->errstr);
785 return;
786 }
787 if ($enrolmentfee && $enrolmentfee > 0) {
788 # insert fee in patron debts
789 manualinvoice($data{'borrowernumber'}, '', '', 'A', $enrolmentfee);
790 }
791
792 return $data{'borrowernumber'};
793}
794
795=head2 Check_Userid
796
- -
809sub Check_Userid {
810 my ($uid,$member) = @_;
811 my $dbh = C4::Context->dbh;
812 my $sth =
813 $dbh->prepare(
814 "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
815 $sth->execute( $uid, $member );
816 if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
817 return 0;
818 }
819 else {
820 return 1;
821 }
822}
823
824=head2 Generate_Userid
825
- -
837sub Generate_Userid {
838 my ($borrowernumber, $firstname, $surname) = @_;
839 my $newuid;
840 my $offset = 0;
841 #The script will "do" the following code and increment the $offset until Check_Userid = 1 (i.e. until $newuid comes back as unique)
842 do {
843 $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
844 $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
845 $newuid = lc(($firstname)? "$firstname.$surname" : $surname);
846 $newuid = unac_string('utf-8',$newuid);
847 $newuid .= $offset unless $offset == 0;
848 $offset++;
849
850 } while (!Check_Userid($newuid,$borrowernumber));
851
852 return $newuid;
853}
854
855sub changepassword {
856 my ( $uid, $member, $digest ) = @_;
857 my $dbh = C4::Context->dbh;
858
859#Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
860#Then we need to tell the user and have them create a new one.
861 my $resultcode;
862 my $sth =
863 $dbh->prepare(
864 "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
865 $sth->execute( $uid, $member );
866 if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
867 $resultcode=0;
868 }
869 else {
870 #Everything is good so we can update the information.
871 $sth =
872 $dbh->prepare(
873 "update borrowers set userid=?, password=? where borrowernumber=?");
874 $sth->execute( $uid, $digest, $member );
875 $resultcode=1;
876 }
877
878 logaction("MEMBERS", "CHANGE PASS", $member, "") if C4::Context->preference("BorrowersLog");
879 return $resultcode;
880}
881
- -
884=head2 fixup_cardnumber
885
- -
89138.92ms2101µs
# spent 58µs (15+43) within C4::Members::BEGIN@891 which was called: # once (15µs+43µs) by C4::Auth_with_ldap::BEGIN@26 at line 891
use vars qw( @weightings );
# spent 58µs making 1 call to C4::Members::BEGIN@891 # spent 43µs making 1 call to vars::import
89214µsmy @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
893
894sub fixup_cardnumber {
895 my ($cardnumber) = @_;
896 my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0;
897
898 # Find out whether member numbers should be generated
899 # automatically. Should be either "1" or something else.
900 # Defaults to "0", which is interpreted as "no".
901
902 # if ($cardnumber !~ /\S/ && $autonumber_members) {
903 ($autonumber_members) or return $cardnumber;
904 my $checkdigit = C4::Context->preference('checkdigit');
905 my $dbh = C4::Context->dbh;
906 if ( $checkdigit and $checkdigit eq 'katipo' ) {
907
908 # if checkdigit is selected, calculate katipo-style cardnumber.
909 # otherwise, just use the max()
910 # purpose: generate checksum'd member numbers.
911 # We'll assume we just got the max value of digits 2-8 of member #'s
912 # from the database and our job is to increment that by one,
913 # determine the 1st and 9th digits and return the full string.
914 my $sth = $dbh->prepare(
915 "select max(substring(borrowers.cardnumber,2,7)) as new_num from borrowers"
916 );
917 $sth->execute;
918 my $data = $sth->fetchrow_hashref;
919 $cardnumber = $data->{new_num};
920 if ( !$cardnumber ) { # If DB has no values,
921 $cardnumber = 1000000; # start at 1000000
922 } else {
923 $cardnumber += 1;
924 }
925
926 my $sum = 0;
927 for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
928 # read weightings, left to right, 1 char at a time
929 my $temp1 = $weightings[$i];
930
931 # sequence left to right, 1 char at a time
932 my $temp2 = substr( $cardnumber, $i, 1 );
933
934 # mult each char 1-7 by its corresponding weighting
935 $sum += $temp1 * $temp2;
936 }
937
938 my $rem = ( $sum % 11 );
939 $rem = 'X' if $rem == 10;
940
941 return "V$cardnumber$rem";
942 } else {
943
944 my $sth = $dbh->prepare(
945 'SELECT MAX( CAST( cardnumber AS SIGNED ) ) FROM borrowers WHERE cardnumber REGEXP "^-?[0-9]+$"'
946 );
947 $sth->execute;
948 my ($result) = $sth->fetchrow;
949 return $result + 1;
950 }
951 return $cardnumber; # just here as a fallback/reminder
952}
953
954=head2 GetGuarantees
955
- -
970#'
971sub GetGuarantees {
972 my ($borrowernumber) = @_;
973 my $dbh = C4::Context->dbh;
974 my $sth =
975 $dbh->prepare(
976"select cardnumber,borrowernumber, firstname, surname from borrowers where guarantorid=?"
977 );
978 $sth->execute($borrowernumber);
979
980 my @dat;
981 my $data = $sth->fetchall_arrayref({});
982 return ( scalar(@$data), $data );
983}
984
985=head2 UpdateGuarantees
986
- -
995#'
996sub UpdateGuarantees {
997 my %data = shift;
998 my $dbh = C4::Context->dbh;
999 my ( $count, $guarantees ) = GetGuarantees( $data{'borrowernumber'} );
1000 foreach my $guarantee (@$guarantees){
1001 my $guaquery = qq|UPDATE borrowers
1002 SET address=?,fax=?,B_city=?,mobile=?,city=?,phone=?
1003 WHERE borrowernumber=?
1004 |;
1005 my $sth = $dbh->prepare($guaquery);
1006 $sth->execute($data{'address'},$data{'fax'},$data{'B_city'},$data{'mobile'},$data{'city'},$data{'phone'},$guarantee->{'borrowernumber'});
1007 }
1008}
1009=head2 GetPendingIssues
1010
- -
1022#'
1023sub GetPendingIssues {
1024 my @borrowernumbers = @_;
1025
1026 unless (@borrowernumbers ) { # return a ref_to_array
1027 return \@borrowernumbers; # to not cause surprise to caller
1028 }
1029
1030 # Borrowers part of the query
1031 my $bquery = '';
1032 for (my $i = 0; $i < @borrowernumbers; $i++) {
1033 $bquery .= ' issues.borrowernumber = ?';
1034 if ($i < $#borrowernumbers ) {
1035 $bquery .= ' OR';
1036 }
1037 }
1038
1039 # must avoid biblioitems.* to prevent large marc and marcxml fields from killing performance
1040 # FIXME: namespace collision: each table has "timestamp" fields. Which one is "timestamp" ?
1041 # FIXME: circ/ciculation.pl tries to sort by timestamp!
1042 # FIXME: namespace collision: other collisions possible.
1043 # FIXME: most of this data isn't really being used by callers.
1044 my $query =
1045 "SELECT issues.*,
1046 items.*,
1047 biblio.*,
1048 biblioitems.volume,
1049 biblioitems.number,
1050 biblioitems.itemtype,
1051 biblioitems.isbn,
1052 biblioitems.issn,
1053 biblioitems.publicationyear,
1054 biblioitems.publishercode,
1055 biblioitems.volumedate,
1056 biblioitems.volumedesc,
1057 biblioitems.lccn,
1058 biblioitems.url,
1059 borrowers.firstname,
1060 borrowers.surname,
1061 borrowers.cardnumber,
1062 issues.timestamp AS timestamp,
1063 issues.renewals AS renewals,
1064 issues.borrowernumber AS borrowernumber,
1065 items.renewals AS totalrenewals
1066 FROM issues
1067 LEFT JOIN items ON items.itemnumber = issues.itemnumber
1068 LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
1069 LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
1070 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
1071 WHERE
1072 $bquery
1073 ORDER BY issues.issuedate"
1074 ;
1075
1076 my $sth = C4::Context->dbh->prepare($query);
1077 $sth->execute(@borrowernumbers);
1078 my $data = $sth->fetchall_arrayref({});
1079 my $tz = C4::Context->tz();
1080 my $today = DateTime->now( time_zone => $tz);
1081 foreach (@{$data}) {
1082 if ($_->{issuedate}) {
1083 $_->{issuedate} = dt_from_string($_->{issuedate}, 'sql');
1084 }
1085 $_->{date_due} or next;
1086 $_->{date_due} = DateTime::Format::DateParse->parse_datetime($_->{date_due}, $tz->name());
1087 if ( DateTime->compare($_->{date_due}, $today) == -1 ) {
1088 $_->{overdue} = 1;
1089 }
1090 }
1091 return $data;
1092}
1093
1094=head2 GetAllIssues
1095
- -
1113#'
1114sub GetAllIssues {
1115 my ( $borrowernumber, $order, $limit ) = @_;
1116
1117 my $dbh = C4::Context->dbh;
1118 my $query =
1119'SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1120 FROM issues
1121 LEFT JOIN items on items.itemnumber=issues.itemnumber
1122 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1123 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1124 WHERE borrowernumber=?
1125 UNION ALL
1126 SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1127 FROM old_issues
1128 LEFT JOIN items on items.itemnumber=old_issues.itemnumber
1129 LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1130 LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1131 WHERE borrowernumber=? AND old_issues.itemnumber IS NOT NULL
1132 order by ' . $order;
1133 if ($limit) {
1134 $query .= " limit $limit";
1135 }
1136
1137 my $sth = $dbh->prepare($query);
1138 $sth->execute( $borrowernumber, $borrowernumber );
1139 return $sth->fetchall_arrayref( {} );
1140}
1141
1142
1143=head2 GetMemberAccountRecords
1144
- -
1157sub GetMemberAccountRecords {
1158 my ($borrowernumber) = @_;
1159 my $dbh = C4::Context->dbh;
1160 my @acctlines;
1161 my $numlines = 0;
1162 my $strsth = qq(
1163 SELECT *
1164 FROM accountlines
1165 WHERE borrowernumber=?);
1166 $strsth.=" ORDER BY date desc,timestamp DESC";
1167 my $sth= $dbh->prepare( $strsth );
1168 $sth->execute( $borrowernumber );
1169
1170 my $total = 0;
1171 while ( my $data = $sth->fetchrow_hashref ) {
1172 if ( $data->{itemnumber} ) {
1173 my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
1174 $data->{biblionumber} = $biblio->{biblionumber};
1175 $data->{title} = $biblio->{title};
1176 }
1177 $acctlines[$numlines] = $data;
1178 $numlines++;
1179 $total += int(1000 * $data->{'amountoutstanding'}); # convert float to integer to avoid round-off errors
1180 }
1181 $total /= 1000;
1182 return ( $total, \@acctlines,$numlines);
1183}
1184
1185=head2 GetMemberAccountBalance
1186
- -
1198sub GetMemberAccountBalance {
1199 my ($borrowernumber) = @_;
1200
1201 my $ACCOUNT_TYPE_LENGTH = 5; # this is plain ridiculous...
1202
1203 my @not_fines = ('Res');
1204 push @not_fines, 'Rent' unless C4::Context->preference('RentalsInNoissuesCharge');
1205 unless ( C4::Context->preference('ManInvInNoissuesCharge') ) {
1206 my $dbh = C4::Context->dbh;
1207 my $man_inv_types = $dbh->selectcol_arrayref(qq{SELECT authorised_value FROM authorised_values WHERE category = 'MANUAL_INV'});
1208 push @not_fines, map substr($_, 0, $ACCOUNT_TYPE_LENGTH), @$man_inv_types;
1209 }
1210 my %not_fine = map {$_ => 1} @not_fines;
1211
1212 my ($total, $acctlines) = GetMemberAccountRecords($borrowernumber);
1213 my $other_charges = 0;
1214 foreach (@$acctlines) {
1215 $other_charges += $_->{amountoutstanding} if $not_fine{ substr($_->{accounttype}, 0, $ACCOUNT_TYPE_LENGTH) };
1216 }
1217
1218 return ( $total, $total - $other_charges, $other_charges);
1219}
1220
1221=head2 GetBorNotifyAcctRecord
1222
- -
1235sub GetBorNotifyAcctRecord {
1236 my ( $borrowernumber, $notifyid ) = @_;
1237 my $dbh = C4::Context->dbh;
1238 my @acctlines;
1239 my $numlines = 0;
1240 my $sth = $dbh->prepare(
1241 "SELECT *
1242 FROM accountlines
1243 WHERE borrowernumber=?
1244 AND notify_id=?
1245 AND amountoutstanding != '0'
1246 ORDER BY notify_id,accounttype
1247 ");
1248
1249 $sth->execute( $borrowernumber, $notifyid );
1250 my $total = 0;
1251 while ( my $data = $sth->fetchrow_hashref ) {
1252 if ( $data->{itemnumber} ) {
1253 my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
1254 $data->{biblionumber} = $biblio->{biblionumber};
1255 $data->{title} = $biblio->{title};
1256 }
1257 $acctlines[$numlines] = $data;
1258 $numlines++;
1259 $total += int(100 * $data->{'amountoutstanding'});
1260 }
1261 $total /= 100;
1262 return ( $total, \@acctlines, $numlines );
1263}
1264
1265=head2 checkuniquemember (OUEST-PROVENCE)
1266
- -
1280# FIXME: This function is not legitimate. Multiple patrons might have the same first/last name and birthdate.
1281# This is especially true since first name is not even a required field.
1282
1283sub checkuniquemember {
1284 my ( $collectivity, $surname, $firstname, $dateofbirth ) = @_;
1285 my $dbh = C4::Context->dbh;
1286 my $request = ($collectivity) ?
1287 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? " :
1288 ($dateofbirth) ?
1289 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=? and dateofbirth=?" :
1290 "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=?";
1291 my $sth = $dbh->prepare($request);
1292 if ($collectivity) {
1293 $sth->execute( uc($surname) );
1294 } elsif($dateofbirth){
1295 $sth->execute( uc($surname), ucfirst($firstname), $dateofbirth );
1296 }else{
1297 $sth->execute( uc($surname), ucfirst($firstname));
1298 }
1299 my @data = $sth->fetchrow;
1300 ( $data[0] ) and return $data[0], $data[1];
1301 return 0;
1302}
1303
1304sub checkcardnumber {
1305 my ($cardnumber,$borrowernumber) = @_;
1306 # If cardnumber is null, we assume they're allowed.
1307 return 0 if !defined($cardnumber);
1308 my $dbh = C4::Context->dbh;
1309 my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
1310 $query .= " AND borrowernumber <> ?" if ($borrowernumber);
1311 my $sth = $dbh->prepare($query);
1312 if ($borrowernumber) {
1313 $sth->execute($cardnumber,$borrowernumber);
1314 } else {
1315 $sth->execute($cardnumber);
1316 }
1317 if (my $data= $sth->fetchrow_hashref()){
1318 return 1;
1319 }
1320 else {
1321 return 0;
1322 }
1323}
1324
1325
1326=head2 getzipnamecity (OUEST-PROVENCE)
1327
- -
1333sub getzipnamecity {
1334 my ($cityid) = @_;
1335 my $dbh = C4::Context->dbh;
1336 my $sth =
1337 $dbh->prepare(
1338 "select city_name,city_state,city_zipcode,city_country from cities where cityid=? ");
1339 $sth->execute($cityid);
1340 my @data = $sth->fetchrow;
1341 return $data[0], $data[1], $data[2], $data[3];
1342}
1343
1344
1345=head2 getdcity (OUEST-PROVENCE)
1346
- -
1351sub getidcity {
1352 my ($city_name) = @_;
1353 my $dbh = C4::Context->dbh;
1354 my $sth = $dbh->prepare("select cityid from cities where city_name=? ");
1355 $sth->execute($city_name);
1356 my $data = $sth->fetchrow;
1357 return $data;
1358}
1359
1360=head2 GetFirstValidEmailAddress
1361
- -
1370sub GetFirstValidEmailAddress {
1371 my $borrowernumber = shift;
1372 my $dbh = C4::Context->dbh;
1373 my $sth = $dbh->prepare( "SELECT email, emailpro, B_email FROM borrowers where borrowernumber = ? ");
1374 $sth->execute( $borrowernumber );
1375 my $data = $sth->fetchrow_hashref;
1376
1377 if ($data->{'email'}) {
1378 return $data->{'email'};
1379 } elsif ($data->{'emailpro'}) {
1380 return $data->{'emailpro'};
1381 } elsif ($data->{'B_email'}) {
1382 return $data->{'B_email'};
1383 } else {
1384 return '';
1385 }
1386}
1387
1388=head2 GetNoticeEmailAddress
1389
- -
1397sub GetNoticeEmailAddress {
1398 my $borrowernumber = shift;
1399
1400 my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
1401 # if syspref is set to 'first valid' (value == OFF), look up email address
1402 if ( $which_address eq 'OFF' ) {
1403 return GetFirstValidEmailAddress($borrowernumber);
1404 }
1405 # specified email address field
1406 my $dbh = C4::Context->dbh;
1407 my $sth = $dbh->prepare( qq{
1408 SELECT $which_address AS primaryemail
1409 FROM borrowers
1410 WHERE borrowernumber=?
1411 } );
1412 $sth->execute($borrowernumber);
1413 my $data = $sth->fetchrow_hashref;
1414 return $data->{'primaryemail'} || '';
1415}
1416
1417=head2 GetExpiryDate
1418
- -
1426sub GetExpiryDate {
1427 my ( $categorycode, $dateenrolled ) = @_;
1428 my $enrolments;
1429 if ($categorycode) {
1430 my $dbh = C4::Context->dbh;
1431 my $sth = $dbh->prepare("SELECT enrolmentperiod,enrolmentperioddate FROM categories WHERE categorycode=?");
1432 $sth->execute($categorycode);
1433 $enrolments = $sth->fetchrow_hashref;
1434 }
1435 # die "GetExpiryDate: for enrollmentperiod $enrolmentperiod (category '$categorycode') starting $dateenrolled.\n";
1436 my @date = split (/-/,$dateenrolled);
1437 if($enrolments->{enrolmentperiod}){
1438 return sprintf("%04d-%02d-%02d", Add_Delta_YM(@date,0,$enrolments->{enrolmentperiod}));
1439 }else{
1440 return $enrolments->{enrolmentperioddate};
1441 }
1442}
1443
1444=head2 checkuserpassword (OUEST-PROVENCE)
1445
- -
1452sub checkuserpassword {
1453 my ( $borrowernumber, $userid, $password ) = @_;
1454 $password = md5_base64($password);
1455 my $dbh = C4::Context->dbh;
1456 my $sth =
1457 $dbh->prepare(
1458"Select count(*) from borrowers where borrowernumber !=? and userid =? and password=? "
1459 );
1460 $sth->execute( $borrowernumber, $userid, $password );
1461 my $number_rows = $sth->fetchrow;
1462 return $number_rows;
1463
1464}
1465
1466=head2 GetborCatFromCatType
1467
- -
1477#'
1478sub GetborCatFromCatType {
1479 my ( $category_type, $action, $no_branch_limit ) = @_;
1480
1481 my $branch_limit = $no_branch_limit
1482 ? 0
1483 : C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1484
1485 # FIXME - This API seems both limited and dangerous.
1486 my $dbh = C4::Context->dbh;
1487
1488 my $request = qq{
1489 SELECT categories.categorycode, categories.description
1490 FROM categories
1491 };
1492 $request .= qq{
1493 LEFT JOIN categories_branches ON categories.categorycode = categories_branches.categorycode
1494 } if $branch_limit;
1495 if($action) {
1496 $request .= " $action ";
1497 $request .= " AND (branchcode = ? OR branchcode IS NULL) GROUP BY description" if $branch_limit;
1498 } else {
1499 $request .= " WHERE branchcode = ? OR branchcode IS NULL GROUP BY description" if $branch_limit;
1500 }
1501 $request .= " ORDER BY categorycode";
1502
1503 my $sth = $dbh->prepare($request);
1504 $sth->execute(
1505 $action ? $category_type : (),
1506 $branch_limit ? $branch_limit : ()
1507 );
1508
1509 my %labels;
1510 my @codes;
1511
1512 while ( my $data = $sth->fetchrow_hashref ) {
1513 push @codes, $data->{'categorycode'};
1514 $labels{ $data->{'categorycode'} } = $data->{'description'};
1515 }
1516 $sth->finish;
1517 return ( \@codes, \%labels );
1518}
1519
1520=head2 GetBorrowercategory
1521
- -
1529sub GetBorrowercategory {
1530 my ($catcode) = @_;
1531 my $dbh = C4::Context->dbh;
1532 if ($catcode){
1533 my $sth =
1534 $dbh->prepare(
1535 "SELECT description,dateofbirthrequired,upperagelimit,category_type
1536 FROM categories
1537 WHERE categorycode = ?"
1538 );
1539 $sth->execute($catcode);
1540 my $data =
1541 $sth->fetchrow_hashref;
1542 return $data;
1543 }
1544 return;
1545} # sub getborrowercategory
1546
1547
1548=head2 GetBorrowerCategorycode
1549
- -
1555sub GetBorrowerCategorycode {
1556 my ( $borrowernumber ) = @_;
1557 my $dbh = C4::Context->dbh;
1558 my $sth = $dbh->prepare( qq{
1559 SELECT categorycode
1560 FROM borrowers
1561 WHERE borrowernumber = ?
1562 } );
1563 $sth->execute( $borrowernumber );
1564 return $sth->fetchrow;
1565}
1566
1567=head2 GetBorrowercategoryList
1568
- -
1574sub GetBorrowercategoryList {
1575 my $no_branch_limit = @_ ? shift : 0;
1576 my $branch_limit = $no_branch_limit
1577 ? 0
1578 : C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1579 my $dbh = C4::Context->dbh;
1580 my $query = "SELECT categories.* FROM categories";
1581 $query .= qq{
1582 LEFT JOIN categories_branches ON categories.categorycode = categories_branches.categorycode
1583 WHERE branchcode = ? OR branchcode IS NULL GROUP BY description
1584 } if $branch_limit;
1585 $query .= " ORDER BY description";
1586 my $sth = $dbh->prepare( $query );
1587 $sth->execute( $branch_limit ? $branch_limit : () );
1588 my $data = $sth->fetchall_arrayref( {} );
1589 $sth->finish;
1590 return $data;
1591} # sub getborrowercategory
1592
1593=head2 ethnicitycategories
1594
- -
1604#'
1605
1606sub ethnicitycategories {
1607 my $dbh = C4::Context->dbh;
1608 my $sth = $dbh->prepare("Select code,name from ethnicity order by name");
1609 $sth->execute;
1610 my %labels;
1611 my @codes;
1612 while ( my $data = $sth->fetchrow_hashref ) {
1613 push @codes, $data->{'code'};
1614 $labels{ $data->{'code'} } = $data->{'name'};
1615 }
1616 return ( \@codes, \%labels );
1617}
1618
1619=head2 fixEthnicity
1620
- -
1629#'
1630
1631sub fixEthnicity {
1632 my $ethnicity = shift;
1633 return unless $ethnicity;
1634 my $dbh = C4::Context->dbh;
1635 my $sth = $dbh->prepare("Select name from ethnicity where code = ?");
1636 $sth->execute($ethnicity);
1637 my $data = $sth->fetchrow_hashref;
1638 return $data->{'name'};
1639} # sub fixEthnicity
1640
1641=head2 GetAge
1642
- -
1649#'
1650sub GetAge{
1651 my ( $date, $date_ref ) = @_;
1652
1653 if ( not defined $date_ref ) {
1654 $date_ref = sprintf( '%04d-%02d-%02d', Today() );
1655 }
1656
1657 my ( $year1, $month1, $day1 ) = split /-/, $date;
1658 my ( $year2, $month2, $day2 ) = split /-/, $date_ref;
1659
1660 my $age = $year2 - $year1;
1661 if ( $month1 . $day1 > $month2 . $day2 ) {
1662 $age--;
1663 }
1664
1665 return $age;
1666} # sub get_age
1667
1668=head2 get_institutions
1669
- -
1676#'
1677sub get_institutions {
1678 my $dbh = C4::Context->dbh();
1679 my $sth =
1680 $dbh->prepare(
1681"SELECT borrowernumber,surname FROM borrowers WHERE categorycode=? ORDER BY surname"
1682 );
1683 $sth->execute('I');
1684 my %orgs;
1685 while ( my $data = $sth->fetchrow_hashref() ) {
1686 $orgs{ $data->{'borrowernumber'} } = $data;
1687 }
1688 return ( \%orgs );
1689
1690} # sub get_institutions
1691
1692=head2 add_member_orgs
1693
- -
1700#'
1701sub add_member_orgs {
1702 my ( $borrowernumber, $otherborrowers ) = @_;
1703 my $dbh = C4::Context->dbh();
1704 my $query =
1705 "INSERT INTO borrowers_to_borrowers (borrower1,borrower2) VALUES (?,?)";
1706 my $sth = $dbh->prepare($query);
1707 foreach my $otherborrowernumber (@$otherborrowers) {
1708 $sth->execute( $borrowernumber, $otherborrowernumber );
1709 }
1710
1711} # sub add_member_orgs
1712
1713=head2 GetCities
1714
- -
1723sub GetCities {
1724
1725 my $dbh = C4::Context->dbh;
1726 my $city_arr = $dbh->selectall_arrayref(
1727 q|SELECT cityid,city_zipcode,city_name,city_state,city_country FROM cities ORDER BY city_name|,
1728 { Slice => {} });
1729 if ( @{$city_arr} ) {
1730 unshift @{$city_arr}, {
1731 city_zipcode => q{},
1732 city_name => q{},
1733 cityid => q{},
1734 city_state => q{},
1735 city_country => q{},
1736 };
1737 }
1738
1739 return $city_arr;
1740}
1741
1742=head2 GetSortDetails (OUEST-PROVENCE)
1743
- -
1753sub GetSortDetails {
1754 my ( $category, $sortvalue ) = @_;
1755 my $dbh = C4::Context->dbh;
1756 my $query = qq|SELECT lib
1757 FROM authorised_values
1758 WHERE category=?
1759 AND authorised_value=? |;
1760 my $sth = $dbh->prepare($query);
1761 $sth->execute( $category, $sortvalue );
1762 my $lib = $sth->fetchrow;
1763 return ($lib) if ($lib);
1764 return ($sortvalue) unless ($lib);
1765}
1766
1767=head2 MoveMemberToDeleted
1768
- -
1775# FIXME: should do it in one SQL statement w/ subquery
1776# Otherwise, we should return the @data on success
1777
1778sub MoveMemberToDeleted {
1779 my ($member) = shift or return;
1780 my $dbh = C4::Context->dbh;
1781 my $query = qq|SELECT *
1782 FROM borrowers
1783 WHERE borrowernumber=?|;
1784 my $sth = $dbh->prepare($query);
1785 $sth->execute($member);
1786 my @data = $sth->fetchrow_array;
1787 (@data) or return; # if we got a bad borrowernumber, there's nothing to insert
1788 $sth =
1789 $dbh->prepare( "INSERT INTO deletedborrowers VALUES ("
1790 . ( "?," x ( scalar(@data) - 1 ) )
1791 . "?)" );
1792 $sth->execute(@data);
1793}
1794
1795=head2 DelMember
1796
- -
1804sub DelMember {
1805 my $dbh = C4::Context->dbh;
1806 my $borrowernumber = shift;
1807 #warn "in delmember with $borrowernumber";
1808 return unless $borrowernumber; # borrowernumber is mandatory.
1809
1810 my $query = qq|DELETE
1811 FROM reserves
1812 WHERE borrowernumber=?|;
1813 my $sth = $dbh->prepare($query);
1814 $sth->execute($borrowernumber);
1815 $query = "
1816 DELETE
1817 FROM borrowers
1818 WHERE borrowernumber = ?
1819 ";
1820 $sth = $dbh->prepare($query);
1821 $sth->execute($borrowernumber);
1822 logaction("MEMBERS", "DELETE", $borrowernumber, "") if C4::Context->preference("BorrowersLog");
1823 return $sth->rows;
1824}
1825
1826=head2 ExtendMemberSubscriptionTo (OUEST-PROVENCE)
1827
- -
1835sub ExtendMemberSubscriptionTo {
1836 my ( $borrowerid,$date) = @_;
1837 my $dbh = C4::Context->dbh;
1838 my $borrower = GetMember('borrowernumber'=>$borrowerid);
1839 unless ($date){
1840 $date = (C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry') ?
1841 C4::Dates->new($borrower->{'dateexpiry'}, 'iso')->output("iso") :
1842 C4::Dates->new()->output("iso");
1843 $date = GetExpiryDate( $borrower->{'categorycode'}, $date );
1844 }
1845 my $sth = $dbh->do(<<EOF);
1846UPDATE borrowers
1847SET dateexpiry='$date'
1848WHERE borrowernumber='$borrowerid'
1849EOF
1850 # add enrolmentfee if needed
1851 $sth = $dbh->prepare("SELECT enrolmentfee FROM categories WHERE categorycode=?");
1852 $sth->execute($borrower->{'categorycode'});
1853 my ($enrolmentfee) = $sth->fetchrow;
1854 if ($enrolmentfee && $enrolmentfee > 0) {
1855 # insert fee in patron debts
1856 manualinvoice($borrower->{'borrowernumber'}, '', '', 'A', $enrolmentfee);
1857 }
1858 logaction("MEMBERS", "RENEW", $borrower->{'borrowernumber'}, "Membership renewed")if C4::Context->preference("BorrowersLog");
1859 return $date if ($sth);
1860 return 0;
1861}
1862
1863=head2 GetRoadTypes (OUEST-PROVENCE)
1864
- -
1873sub GetRoadTypes {
1874 my $dbh = C4::Context->dbh;
1875 my $query = qq|
1876SELECT roadtypeid,road_type
1877FROM roadtype
1878ORDER BY road_type|;
1879 my $sth = $dbh->prepare($query);
1880 $sth->execute();
1881 my %roadtype;
1882 my @id;
1883
1884 # insert empty value to create a empty choice in cgi popup
1885
1886 while ( my $data = $sth->fetchrow_hashref ) {
1887
1888 push @id, $data->{'roadtypeid'};
1889 $roadtype{ $data->{'roadtypeid'} } = $data->{'road_type'};
1890 }
1891
1892#test to know if the table contain some records if no the function return nothing
1893 my $id = @id;
1894 if ( $id eq 0 ) {
1895 return ();
1896 }
1897 else {
1898 unshift( @id, "" );
1899 return ( \@id, \%roadtype );
1900 }
1901}
1902
- -
1905=head2 GetTitles (OUEST-PROVENCE)
1906
- -
1913sub GetTitles {
1914 my @borrowerTitle = split (/,|\|/,C4::Context->preference('BorrowersTitles'));
1915 unshift( @borrowerTitle, "" );
1916 my $count=@borrowerTitle;
1917 if ($count == 1){
1918 return ();
1919 }
1920 else {
1921 return ( \@borrowerTitle);
1922 }
1923}
1924
1925=head2 GetPatronImage
1926
- -
1933sub GetPatronImage {
1934 my ($cardnumber) = @_;
1935 warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1936 my $dbh = C4::Context->dbh;
1937 my $query = 'SELECT mimetype, imagefile FROM patronimage WHERE cardnumber = ?';
1938 my $sth = $dbh->prepare($query);
1939 $sth->execute($cardnumber);
1940 my $imagedata = $sth->fetchrow_hashref;
1941 warn "Database error!" if $sth->errstr;
1942 return $imagedata, $sth->errstr;
1943}
1944
1945=head2 PutPatronImage
1946
- -
1954sub PutPatronImage {
1955 my ($cardnumber, $mimetype, $imgfile) = @_;
1956 warn "Parameters passed in: Cardnumber=$cardnumber, Mimetype=$mimetype, " . ($imgfile ? "Imagefile" : "No Imagefile") if $debug;
1957 my $dbh = C4::Context->dbh;
1958 my $query = "INSERT INTO patronimage (cardnumber, mimetype, imagefile) VALUES (?,?,?) ON DUPLICATE KEY UPDATE imagefile = ?;";
1959 my $sth = $dbh->prepare($query);
1960 $sth->execute($cardnumber,$mimetype,$imgfile,$imgfile);
1961 warn "Error returned inserting $cardnumber.$mimetype." if $sth->errstr;
1962 return $sth->errstr;
1963}
1964
1965=head2 RmPatronImage
1966
- -
1973sub RmPatronImage {
1974 my ($cardnumber) = @_;
1975 warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1976 my $dbh = C4::Context->dbh;
1977 my $query = "DELETE FROM patronimage WHERE cardnumber = ?;";
1978 my $sth = $dbh->prepare($query);
1979 $sth->execute($cardnumber);
1980 my $dberror = $sth->errstr;
1981 warn "Database error!" if $sth->errstr;
1982 return $dberror;
1983}
1984
1985=head2 GetHideLostItemsPreference
1986
- -
1994sub GetHideLostItemsPreference {
1995 my ($borrowernumber) = @_;
1996 my $dbh = C4::Context->dbh;
1997 my $query = "SELECT hidelostitems FROM borrowers,categories WHERE borrowers.categorycode = categories.categorycode AND borrowernumber = ?";
1998 my $sth = $dbh->prepare($query);
1999 $sth->execute($borrowernumber);
2000 my $hidelostitems = $sth->fetchrow;
2001 return $hidelostitems;
2002}
2003
2004=head2 GetRoadTypeDetails (OUEST-PROVENCE)
2005
- -
2014sub GetRoadTypeDetails {
2015 my ($roadtypeid) = @_;
2016 my $dbh = C4::Context->dbh;
2017 my $query = qq|
2018SELECT road_type
2019FROM roadtype
2020WHERE roadtypeid=?|;
2021 my $sth = $dbh->prepare($query);
2022 $sth->execute($roadtypeid);
2023 my $roadtype = $sth->fetchrow;
2024 return ($roadtype);
2025}
2026
2027=head2 GetBorrowersToExpunge
2028
- -
2040sub GetBorrowersToExpunge {
2041 my $params = shift;
2042
2043 my $filterdate = $params->{'not_borrowered_since'};
2044 my $filterexpiry = $params->{'expired_before'};
2045 my $filtercategory = $params->{'category_code'};
2046 my $filterbranch = $params->{'branchcode'} ||
2047 ((C4::Context->preference('IndependantBranches')
2048 && C4::Context->userenv
2049 && C4::Context->userenv->{flags} % 2 !=1
2050 && C4::Context->userenv->{branch})
2051 ? C4::Context->userenv->{branch}
2052 : "");
2053
2054 my $dbh = C4::Context->dbh;
2055 my $query = "
2056 SELECT borrowers.borrowernumber,
2057 MAX(old_issues.timestamp) AS latestissue,
2058 MAX(issues.timestamp) AS currentissue
2059 FROM borrowers
2060 JOIN categories USING (categorycode)
2061 LEFT JOIN old_issues USING (borrowernumber)
2062 LEFT JOIN issues USING (borrowernumber)
2063 WHERE category_type <> 'S'
2064 AND borrowernumber NOT IN (SELECT guarantorid FROM borrowers WHERE guarantorid IS NOT NULL AND guarantorid <> 0)
2065 ";
2066 my @query_params;
2067 if ( $filterbranch && $filterbranch ne "" ) {
2068 $query.= " AND borrowers.branchcode = ? ";
2069 push( @query_params, $filterbranch );
2070 }
2071 if ( $filterexpiry ) {
2072 $query .= " AND dateexpiry < ? ";
2073 push( @query_params, $filterexpiry );
2074 }
2075 if ( $filtercategory ) {
2076 $query .= " AND categorycode = ? ";
2077 push( @query_params, $filtercategory );
2078 }
2079 $query.=" GROUP BY borrowers.borrowernumber HAVING currentissue IS NULL ";
2080 if ( $filterdate ) {
2081 $query.=" AND ( latestissue < ? OR latestissue IS NULL ) ";
2082 push @query_params,$filterdate;
2083 }
2084 warn $query if $debug;
2085
2086 my $sth = $dbh->prepare($query);
2087 if (scalar(@query_params)>0){
2088 $sth->execute(@query_params);
2089 }
2090 else {
2091 $sth->execute;
2092 }
2093
2094 my @results;
2095 while ( my $data = $sth->fetchrow_hashref ) {
2096 push @results, $data;
2097 }
2098 return \@results;
2099}
2100
2101=head2 GetBorrowersWhoHaveNeverBorrowed
2102
- -
2111sub GetBorrowersWhoHaveNeverBorrowed {
2112 my $filterbranch = shift ||
2113 ((C4::Context->preference('IndependantBranches')
2114 && C4::Context->userenv
2115 && C4::Context->userenv->{flags} % 2 !=1
2116 && C4::Context->userenv->{branch})
2117 ? C4::Context->userenv->{branch}
2118 : "");
2119 my $dbh = C4::Context->dbh;
2120 my $query = "
2121 SELECT borrowers.borrowernumber,max(timestamp) as latestissue
2122 FROM borrowers
2123 LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
2124 WHERE issues.borrowernumber IS NULL
2125 ";
2126 my @query_params;
2127 if ($filterbranch && $filterbranch ne ""){
2128 $query.=" AND borrowers.branchcode= ?";
2129 push @query_params,$filterbranch;
2130 }
2131 warn $query if $debug;
2132
2133 my $sth = $dbh->prepare($query);
2134 if (scalar(@query_params)>0){
2135 $sth->execute(@query_params);
2136 }
2137 else {
2138 $sth->execute;
2139 }
2140
2141 my @results;
2142 while ( my $data = $sth->fetchrow_hashref ) {
2143 push @results, $data;
2144 }
2145 return \@results;
2146}
2147
2148=head2 GetBorrowersWithIssuesHistoryOlderThan
2149
- -
2159sub GetBorrowersWithIssuesHistoryOlderThan {
2160 my $dbh = C4::Context->dbh;
2161 my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime());
2162 my $filterbranch = shift ||
2163 ((C4::Context->preference('IndependantBranches')
2164 && C4::Context->userenv
2165 && C4::Context->userenv->{flags} % 2 !=1
2166 && C4::Context->userenv->{branch})
2167 ? C4::Context->userenv->{branch}
2168 : "");
2169 my $query = "
2170 SELECT count(borrowernumber) as n,borrowernumber
2171 FROM old_issues
2172 WHERE returndate < ?
2173 AND borrowernumber IS NOT NULL
2174 ";
2175 my @query_params;
2176 push @query_params, $date;
2177 if ($filterbranch){
2178 $query.=" AND branchcode = ?";
2179 push @query_params, $filterbranch;
2180 }
2181 $query.=" GROUP BY borrowernumber ";
2182 warn $query if $debug;
2183 my $sth = $dbh->prepare($query);
2184 $sth->execute(@query_params);
2185 my @results;
2186
2187 while ( my $data = $sth->fetchrow_hashref ) {
2188 push @results, $data;
2189 }
2190 return \@results;
2191}
2192
2193=head2 GetBorrowersNamesAndLatestIssue
2194
- -
2204sub GetBorrowersNamesAndLatestIssue {
2205 my $dbh = C4::Context->dbh;
2206 my @borrowernumbers=@_;
2207 my $query = "
2208 SELECT surname,lastname, phone, email,max(timestamp)
2209 FROM borrowers
2210 LEFT JOIN issues ON borrowers.borrowernumber=issues.borrowernumber
2211 GROUP BY borrowernumber
2212 ";
2213 my $sth = $dbh->prepare($query);
2214 $sth->execute;
2215 my $results = $sth->fetchall_arrayref({});
2216 return $results;
2217}
2218
2219=head2 DebarMember
2220
- -
2231sub DebarMember {
2232 my $borrowernumber = shift;
2233 my $todate = shift;
2234
2235 return unless defined $borrowernumber;
2236 return unless $borrowernumber =~ /^\d+$/;
2237
2238 return ModMember(
2239 borrowernumber => $borrowernumber,
2240 debarred => $todate
2241 );
2242
2243}
2244
2245=head2 ModPrivacy
2246
- -
2260sub ModPrivacy {
2261 my $borrowernumber = shift;
2262 my $privacy = shift;
2263 return unless defined $borrowernumber;
2264 return unless $borrowernumber =~ /^\d+$/;
2265
2266 return ModMember( borrowernumber => $borrowernumber,
2267 privacy => $privacy );
2268}
2269
2270=head2 AddMessage
2271
- -
2282sub AddMessage {
2283 my ( $borrowernumber, $message_type, $message, $branchcode ) = @_;
2284
2285 my $dbh = C4::Context->dbh;
2286
2287 if ( ! ( $borrowernumber && $message_type && $message && $branchcode ) ) {
2288 return;
2289 }
2290
2291 my $query = "INSERT INTO messages ( borrowernumber, branchcode, message_type, message ) VALUES ( ?, ?, ?, ? )";
2292 my $sth = $dbh->prepare($query);
2293 $sth->execute( $borrowernumber, $branchcode, $message_type, $message );
2294 logaction("MEMBERS", "ADDCIRCMESSAGE", $borrowernumber, $message) if C4::Context->preference("BorrowersLog");
2295 return 1;
2296}
2297
2298=head2 GetMessages
2299
- -
2309sub GetMessages {
2310 my ( $borrowernumber, $type, $branchcode ) = @_;
2311
2312 if ( ! $type ) {
2313 $type = '%';
2314 }
2315
2316 my $dbh = C4::Context->dbh;
2317
2318 my $query = "SELECT
2319 branches.branchname,
2320 messages.*,
2321 message_date,
2322 messages.branchcode LIKE '$branchcode' AS can_delete
2323 FROM messages, branches
2324 WHERE borrowernumber = ?
2325 AND message_type LIKE ?
2326 AND messages.branchcode = branches.branchcode
2327 ORDER BY message_date DESC";
2328 my $sth = $dbh->prepare($query);
2329 $sth->execute( $borrowernumber, $type ) ;
2330 my @results;
2331
2332 while ( my $data = $sth->fetchrow_hashref ) {
2333 my $d = C4::Dates->new( $data->{message_date}, 'iso' );
2334 $data->{message_date_formatted} = $d->output;
2335 push @results, $data;
2336 }
2337 return \@results;
2338
2339}
2340
2341=head2 GetMessages
2342
- -
2352sub GetMessagesCount {
2353 my ( $borrowernumber, $type, $branchcode ) = @_;
2354
2355 if ( ! $type ) {
2356 $type = '%';
2357 }
2358
2359 my $dbh = C4::Context->dbh;
2360
2361 my $query = "SELECT COUNT(*) as MsgCount FROM messages WHERE borrowernumber = ? AND message_type LIKE ?";
2362 my $sth = $dbh->prepare($query);
2363 $sth->execute( $borrowernumber, $type ) ;
2364 my @results;
2365
2366 my $data = $sth->fetchrow_hashref;
2367 my $count = $data->{'MsgCount'};
2368
2369 return $count;
2370}
2371
- -
2374=head2 DeleteMessage
2375
- -
2380sub DeleteMessage {
2381 my ( $message_id ) = @_;
2382
2383 my $dbh = C4::Context->dbh;
2384 my $query = "SELECT * FROM messages WHERE message_id = ?";
2385 my $sth = $dbh->prepare($query);
2386 $sth->execute( $message_id );
2387 my $message = $sth->fetchrow_hashref();
2388
2389 $query = "DELETE FROM messages WHERE message_id = ?";
2390 $sth = $dbh->prepare($query);
2391 $sth->execute( $message_id );
2392 logaction("MEMBERS", "DELCIRCMESSAGE", $message->{'borrowernumber'}, $message->{'message'}) if C4::Context->preference("BorrowersLog");
2393}
2394
2395=head2 IssueSlip
2396
- -
2405sub IssueSlip {
2406 my ($branch, $borrowernumber, $quickslip) = @_;
2407
2408# return unless ( C4::Context->boolean_preference('printcirculationslips') );
2409
2410 my $now = POSIX::strftime("%Y-%m-%d", localtime);
2411
2412 my $issueslist = GetPendingIssues($borrowernumber);
2413 foreach my $it (@$issueslist){
2414 if ((substr $it->{'issuedate'}, 0, 10) eq $now || (substr $it->{'lastreneweddate'}, 0, 10) eq $now) {
2415 $it->{'now'} = 1;
2416 }
2417 elsif ((substr $it->{'date_due'}, 0, 10) le $now) {
2418 $it->{'overdue'} = 1;
2419 }
2420 my $dt = dt_from_string( $it->{'date_due'} );
2421 $it->{'date_due'} = output_pref( $dt );;
2422 }
2423 my @issues = sort { $b->{'timestamp'} <=> $a->{'timestamp'} } @$issueslist;
2424
2425 my ($letter_code, %repeat);
2426 if ( $quickslip ) {
2427 $letter_code = 'ISSUEQSLIP';
2428 %repeat = (
2429 'checkedout' => [ map {
2430 'biblio' => $_,
2431 'items' => $_,
2432 'issues' => $_,
2433 }, grep { $_->{'now'} } @issues ],
2434 );
2435 }
2436 else {
2437 $letter_code = 'ISSUESLIP';
2438 %repeat = (
2439 'checkedout' => [ map {
2440 'biblio' => $_,
2441 'items' => $_,
2442 'issues' => $_,
2443 }, grep { !$_->{'overdue'} } @issues ],
2444
2445 'overdue' => [ map {
2446 'biblio' => $_,
2447 'items' => $_,
2448 'issues' => $_,
2449 }, grep { $_->{'overdue'} } @issues ],
2450
2451 'news' => [ map {
2452 $_->{'timestamp'} = $_->{'newdate'};
2453 { opac_news => $_ }
2454 } @{ GetNewsToDisplay("slip") } ],
2455 );
2456 }
2457
2458 return C4::Letters::GetPreparedLetter (
2459 module => 'circulation',
2460 letter_code => $letter_code,
2461 branchcode => $branch,
2462 tables => {
2463 'branches' => $branch,
2464 'borrowers' => $borrowernumber,
2465 },
2466 repeat => \%repeat,
2467 );
2468}
2469
2470=head2 GetBorrowersWithEmail
2471
- -
2481sub GetBorrowersWithEmail {
2482 my $email = shift;
2483
2484 my $dbh = C4::Context->dbh;
2485
2486 my $query = "SELECT borrowernumber, userid FROM borrowers WHERE email=?";
2487 my $sth=$dbh->prepare($query);
2488 $sth->execute($email);
2489 my @result = ();
2490 while (my $ref = $sth->fetch) {
2491 push @result, $ref;
2492 }
2493 die "Failure searching for borrowers by email address: $sth->errstr" if $sth->err;
2494 return @result;
2495}
2496
2497sub AddMember_Opac {
2498 my ( %borrower ) = @_;
2499
2500 $borrower{'categorycode'} = C4::Context->preference('PatronSelfRegistrationDefaultCategory');
2501
2502 my $sr = new String::Random;
2503 $sr->{'A'} = [ 'A'..'Z', 'a'..'z' ];
2504 my $password = $sr->randpattern("AAAAAAAAAA");
2505 $borrower{'password'} = $password;
2506
2507 $borrower{'cardnumber'} = fixup_cardnumber();
2508
2509 my $borrowernumber = AddMember(%borrower);
2510
2511 return ( $borrowernumber, $password );
2512}
2513
251417µs
# spent 4µs within C4::Members::END which was called: # once (4µs+0s) by main::RUNTIME at line 0 of /usr/share/koha/opac/cgi-bin/opac/opac-search.pl
END { } # module clean-up code here (global destructor)
2515
2516111µs1;
2517
2518__END__
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.