Profile of /usr/share/koha/lib/C4/Members.pm

Filename	/usr/share/koha/lib/C4/Members.pm
Statements	Executed 73 statements in 14.1ms

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
1	1	1	4.02ms	528ms	C4::Members::::BEGIN@31C4::Members::BEGIN@31
1	1	1	2.29ms	2.50ms	C4::Members::::BEGIN@28C4::Members::BEGIN@28
1	1	1	1.17ms	1.55ms	C4::Members::::BEGIN@30C4::Members::BEGIN@30
1	1	1	1.03ms	1.41ms	C4::Members::::BEGIN@38C4::Members::BEGIN@38
1	1	1	419µs	1.36ms	C4::Members::::BEGIN@42C4::Members::BEGIN@42
1	1	1	63µs	63µs	C4::Members::::BEGIN@46C4::Members::BEGIN@46
1	1	1	20µs	133µs	C4::Members::::BEGIN@41C4::Members::BEGIN@41
1	1	1	20µs	100µs	C4::Members::::BEGIN@36C4::Members::BEGIN@36
1	1	1	18µs	84µs	C4::Members::::BEGIN@29C4::Members::BEGIN@29
1	1	1	17µs	21µs	C4::Members::::BEGIN@23C4::Members::BEGIN@23
1	1	1	17µs	580µs	C4::Members::::BEGIN@34C4::Members::BEGIN@34
1	1	1	15µs	366µs	C4::Members::::BEGIN@32C4::Members::BEGIN@32
1	1	1	15µs	58µs	C4::Members::::BEGIN@891C4::Members::BEGIN@891
1	1	1	14µs	223µs	C4::Members::::BEGIN@35C4::Members::BEGIN@35
1	1	1	14µs	14µs	C4::Members::::BEGIN@39C4::Members::BEGIN@39
1	1	1	14µs	51µs	C4::Members::::BEGIN@37C4::Members::BEGIN@37
1	1	1	14µs	235µs	C4::Members::::BEGIN@33C4::Members::BEGIN@33
1	1	1	13µs	57µs	C4::Members::::BEGIN@26C4::Members::BEGIN@26
1	1	1	12µs	12µs	C4::Members::::BEGIN@40C4::Members::BEGIN@40
1	1	1	10µs	12µs	C4::Members::::BEGIN@25C4::Members::BEGIN@25
1	1	1	9µs	40µs	C4::Members::::BEGIN@27C4::Members::BEGIN@27
1	1	1	4µs	4µs	C4::Members::::ENDC4::Members::END
0	0	0	0s	0s	C4::Members::::AddMemberC4::Members::AddMember
0	0	0	0s	0s	C4::Members::::AddMember_OpacC4::Members::AddMember_Opac
0	0	0	0s	0s	C4::Members::::AddMessageC4::Members::AddMessage
0	0	0	0s	0s	C4::Members::::Check_UseridC4::Members::Check_Userid
0	0	0	0s	0s	C4::Members::::DebarMemberC4::Members::DebarMember
0	0	0	0s	0s	C4::Members::::DelMemberC4::Members::DelMember
0	0	0	0s	0s	C4::Members::::DeleteMessageC4::Members::DeleteMessage
0	0	0	0s	0s	C4::Members::ExtendMemberSubscriptionTo
0	0	0	0s	0s	C4::Members::::Generate_UseridC4::Members::Generate_Userid
0	0	0	0s	0s	C4::Members::::GetAgeC4::Members::GetAge
0	0	0	0s	0s	C4::Members::::GetAllIssuesC4::Members::GetAllIssues
0	0	0	0s	0s	C4::Members::::GetBorNotifyAcctRecordC4::Members::GetBorNotifyAcctRecord
0	0	0	0s	0s	C4::Members::::GetBorrowerCategorycodeC4::Members::GetBorrowerCategorycode
0	0	0	0s	0s	C4::Members::::GetBorrowercategoryC4::Members::GetBorrowercategory
0	0	0	0s	0s	C4::Members::::GetBorrowercategoryListC4::Members::GetBorrowercategoryList
0	0	0	0s	0s	C4::Members::GetBorrowersNamesAndLatestIssue
0	0	0	0s	0s	C4::Members::::GetBorrowersToExpungeC4::Members::GetBorrowersToExpunge
0	0	0	0s	0s	C4::Members::GetBorrowersWhoHaveNeverBorrowed
0	0	0	0s	0s	C4::Members::::GetBorrowersWithEmailC4::Members::GetBorrowersWithEmail
0	0	0	0s	0s	C4::Members::GetBorrowersWithIssuesHistoryOlderThan
0	0	0	0s	0s	C4::Members::::GetCitiesC4::Members::GetCities
0	0	0	0s	0s	C4::Members::::GetExpiryDateC4::Members::GetExpiryDate
0	0	0	0s	0s	C4::Members::GetFirstValidEmailAddress
0	0	0	0s	0s	C4::Members::::GetGuaranteesC4::Members::GetGuarantees
0	0	0	0s	0s	C4::Members::GetHideLostItemsPreference
0	0	0	0s	0s	C4::Members::::GetMemberC4::Members::GetMember
0	0	0	0s	0s	C4::Members::::GetMemberAccountBalanceC4::Members::GetMemberAccountBalance
0	0	0	0s	0s	C4::Members::::GetMemberAccountRecordsC4::Members::GetMemberAccountRecords
0	0	0	0s	0s	C4::Members::::GetMemberDetailsC4::Members::GetMemberDetails
0	0	0	0s	0s	C4::Members::::GetMemberIssuesAndFinesC4::Members::GetMemberIssuesAndFines
0	0	0	0s	0s	C4::Members::::GetMemberRelativesC4::Members::GetMemberRelatives
0	0	0	0s	0s	C4::Members::::GetMessagesC4::Members::GetMessages
0	0	0	0s	0s	C4::Members::::GetMessagesCountC4::Members::GetMessagesCount
0	0	0	0s	0s	C4::Members::::GetNoticeEmailAddressC4::Members::GetNoticeEmailAddress
0	0	0	0s	0s	C4::Members::::GetPatronImageC4::Members::GetPatronImage
0	0	0	0s	0s	C4::Members::::GetPendingIssuesC4::Members::GetPendingIssues
0	0	0	0s	0s	C4::Members::::GetRoadTypeDetailsC4::Members::GetRoadTypeDetails
0	0	0	0s	0s	C4::Members::::GetRoadTypesC4::Members::GetRoadTypes
0	0	0	0s	0s	C4::Members::::GetSortDetailsC4::Members::GetSortDetails
0	0	0	0s	0s	C4::Members::::GetTitlesC4::Members::GetTitles
0	0	0	0s	0s	C4::Members::::GetborCatFromCatTypeC4::Members::GetborCatFromCatType
0	0	0	0s	0s	C4::Members::::IsMemberBlockedC4::Members::IsMemberBlocked
0	0	0	0s	0s	C4::Members::::IssueSlipC4::Members::IssueSlip
0	0	0	0s	0s	C4::Members::::ModMemberC4::Members::ModMember
0	0	0	0s	0s	C4::Members::::ModPrivacyC4::Members::ModPrivacy
0	0	0	0s	0s	C4::Members::::MoveMemberToDeletedC4::Members::MoveMemberToDeleted
0	0	0	0s	0s	C4::Members::::PutPatronImageC4::Members::PutPatronImage
0	0	0	0s	0s	C4::Members::::RmPatronImageC4::Members::RmPatronImage
0	0	0	0s	0s	C4::Members::::SearchC4::Members::Search
0	0	0	0s	0s	C4::Members::::UpdateGuaranteesC4::Members::UpdateGuarantees
0	0	0	0s	0s	C4::Members::::_express_member_findC4::Members::_express_member_find
0	0	0	0s	0s	C4::Members::::add_member_orgsC4::Members::add_member_orgs
0	0	0	0s	0s	C4::Members::::changepasswordC4::Members::changepassword
0	0	0	0s	0s	C4::Members::::checkcardnumberC4::Members::checkcardnumber
0	0	0	0s	0s	C4::Members::::checkuniquememberC4::Members::checkuniquemember
0	0	0	0s	0s	C4::Members::::checkuserpasswordC4::Members::checkuserpassword
0	0	0	0s	0s	C4::Members::::columnsC4::Members::columns
0	0	0	0s	0s	C4::Members::::ethnicitycategoriesC4::Members::ethnicitycategories
0	0	0	0s	0s	C4::Members::::fixEthnicityC4::Members::fixEthnicity
0	0	0	0s	0s	C4::Members::::fixup_cardnumberC4::Members::fixup_cardnumber
0	0	0	0s	0s	C4::Members::::get_institutionsC4::Members::get_institutions
0	0	0	0s	0s	C4::Members::::getidcityC4::Members::getidcity
0	0	0	0s	0s	C4::Members::::getzipnamecityC4::Members::getzipnamecity
0	0	0	0s	0s	C4::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
1					package 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
23	3	29µs	2	25µ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
25	3	28µs	2	13µ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
26	3	35µs	2	101µ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
27	3	29µs	2	71µ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
28	3	149µs	2	2.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
29	3	38µs	2	150µ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
30	3	138µs	2	1.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
31	3	195µs	2	529ms	# 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
32	3	37µs	2	717µ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
33	3	38µs	2	457µ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
34	3	39µs	2	1.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
35	3	43µs	2	432µ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
36	3	45µs	2	180µ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
37	3	32µs	2	89µ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
38	3	167µs	2	1.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
39	3	56µs	1	14µ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
40	3	46µs	1	12µ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
41	3	63µs	2	245µ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
42	3	548µs	2	1.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
44	1	3µs			our ($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 {
47	1	3µs			$VERSION = 3.07.00.049;
48	1	3µs			$debug = $ENV{DEBUG} \|\| 0;
49	1	1µs			require Exporter;
50	1	18µs			@ISA = qw(Exporter);
51					#Get data
52	1	22µs			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	1	2µs			push @EXPORT, qw(
110					&ModMember
111					&changepassword
112					&ModPrivacy
113					);
114
115					#Delete data
116	1	800ns			push @EXPORT, qw(
117					&DelMember
118					);
119
120					#Insert data
121	1	2µs			push @EXPORT, qw(
122					&AddMember
123					&AddMember_Opac
124					&add_member_orgs
125					&MoveMemberToDeleted
126					&ExtendMemberSubscriptionTo
127					);
128
129					#Check data
130	1	13µs			push @EXPORT, qw(
131					&checkuniquemember
132					&checkuserpassword
133					&Check_Userid
134					&Generate_Userid
135					&fixEthnicity
136					&ethnicitycategories
137					&fixup_cardnumber
138					&checkcardnumber
139					);
140	1	3.37ms	1	63µs	} # spent 63µs making 1 call to C4::Members::BEGIN@46
141
142					=head1 NAME
143
- -
177					sub _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
200					sub 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
- -
321					sub 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.
430					sub 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					#'
527					sub 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
- -
578					sub 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
- -
637					sub 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					#'
675					sub 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
700					sub columns(;$) {
701					return @{C4::Context->dbh->selectcol_arrayref("SHOW columns from borrowers")};
702					}
703
704					=head2 ModMember
705
- -
716					sub 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					#'
754					sub 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
- -
809					sub 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
- -
837					sub 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
855					sub 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
- -
891	3	8.92ms	2	101µ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
892	1	4µs			my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
893
894					sub 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					#'
971					sub 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					#'
996					sub 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					#'
1023					sub 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					#'
1114					sub 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
- -
1157					sub 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
- -
1198					sub 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
- -
1235					sub 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
1283					sub 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
1304					sub 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
- -
1333					sub 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
- -
1351					sub 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
- -
1370					sub 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
- -
1397					sub 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
- -
1426					sub 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
- -
1452					sub 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					#'
1478					sub 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
- -
1529					sub 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
- -
1555					sub 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
- -
1574					sub 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
1606					sub 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
1631					sub 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					#'
1650					sub 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					#'
1677					sub 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					#'
1701					sub 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
- -
1723					sub 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
- -
1753					sub 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
1778					sub 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
- -
1804					sub 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
- -
1835					sub 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);
1846					UPDATE borrowers
1847					SET dateexpiry='$date'
1848					WHERE borrowernumber='$borrowerid'
1849					EOF
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
- -
1873					sub GetRoadTypes {
1874					my $dbh = C4::Context->dbh;
1875					my $query = qq\|
1876					SELECT roadtypeid,road_type
1877					FROM roadtype
1878					ORDER 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
- -
1913					sub 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
- -
1933					sub 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
- -
1954					sub 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
- -
1973					sub 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
- -
1994					sub 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
- -
2014					sub GetRoadTypeDetails {
2015					my ($roadtypeid) = @_;
2016					my $dbh = C4::Context->dbh;
2017					my $query = qq\|
2018					SELECT road_type
2019					FROM roadtype
2020					WHERE 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
- -
2040					sub 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
- -
2111					sub 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
- -
2159					sub 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
- -
2204					sub 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
- -
2231					sub 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
- -
2260					sub 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
- -
2282					sub 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
- -
2309					sub 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
- -
2352					sub 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
- -
2380					sub 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
- -
2405					sub 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
- -
2481					sub 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
2497					sub 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
2514	1	7µ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
2516	1	11µs			1;
2517
2518					__END__