NYTProf Profile: /home/chris/git/koha.git/C4/Members.pm

File	/home/chris/git/koha.git/C4/Members.pm
Statements Executed	60
Total Time	0.0097629 seconds

Subroutines — ordered by exclusive time
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
1	1	1	44µs	366µs	C4::Members::::GetMemberC4::Members::GetMember
0	0	0	0s	0s	C4::Members::::AddMemberC4::Members::AddMember
0	0	0	0s	0s	C4::Members::::BEGINC4::Members::BEGIN
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::::ENDC4::Members::END
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::::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::GetBorrowersWhoHaveNeverBorrowed
0	0	0	0s	0s	C4::Members::GetBorrowersWhoHaveNotBorrowedSince
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::::GetGuaranteesC4::Members::GetGuarantees
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::::GetMemberRevisionsC4::Members::GetMemberRevisions
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::::ModMemberC4::Members::ModMember
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::::SearchMemberC4::Members::SearchMember
0	0	0	0s	0s	C4::Members::::UpdateGuaranteesC4::Members::UpdateGuarantees
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

Line	Stmts.	Exclusive Time	Avg.	Code
1				package C4::Members;
2
3				# Copyright 2000-2003 Katipo Communications
4				#
5				# This file is part of Koha.
6				#
7				# Koha is free software; you can redistribute it and/or modify it under the
8				# terms of the GNU General Public License as published by the Free Software
9				# Foundation; either version 2 of the License, or (at your option) any later
10				# version.
11				#
12				# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13				# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14				# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
15				#
16				# You should have received a copy of the GNU General Public License along with
17				# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
18				# Suite 330, Boston, MA 02111-1307 USA
19
20
21	3	34µs	11µs	use strict; # spent 11µs making 1 call to strict::import
22	3	34µs	11µs	use C4::Context; # spent 8µs making 1 call to C4::Context::import
23	3	199µs	66µs	use C4::Dates qw(format_date_in_iso); # spent 55µs making 1 call to Exporter::import
24	3	35µs	12µs	use Digest::MD5 qw(md5_base64); # spent 39µs making 1 call to Exporter::import
25	3	27µs	9µs	use Date::Calc qw/Today Add_Delta_YM/; # spent 38µs making 1 call to Exporter::import
26	3	218µs	73µs	use C4::Log; # logaction # spent 139µs making 1 call to Exporter::import
27	3	216µs	72µs	use C4::Overdues; # spent 293µs making 1 call to Exporter::import
28	3	32µs	11µs	use C4::Reserves; # spent 219µs making 1 call to Exporter::import
29	3	30µs	10µs	use C4::Accounts; # spent 136µs making 1 call to Exporter::import
30	3	193µs	64µs	use C4::Biblio; # spent 327µs making 1 call to Exporter::import
31
32	1	1µs	1µs	our ($VERSION,@ISA,@EXPORT,@EXPORT_OK,$debug);
33
34				BEGIN {
35	9	32µs	4µs	$VERSION = 3.02;
36				$debug = $ENV{DEBUG} \|\| 0;
37				require Exporter;
38				@ISA = qw(Exporter);
39				#Get data
40				push @EXPORT, qw(
41				&SearchMember
42				&GetMemberDetails
43				&GetMember
44
45				&GetGuarantees
46
47				&GetMemberIssuesAndFines
48				&GetPendingIssues
49				&GetAllIssues
50
51				&get_institutions
52				&getzipnamecity
53				&getidcity
54
55				&GetAge
56				&GetCities
57				&GetRoadTypes
58				&GetRoadTypeDetails
59				&GetSortDetails
60				&GetTitles
61
62				&GetPatronImage
63				&PutPatronImage
64				&RmPatronImage
65
66				&GetMemberAccountRecords
67				&GetBorNotifyAcctRecord
68
69				&GetborCatFromCatType
70				&GetBorrowercategory
71				&GetBorrowercategoryList
72
73				&GetBorrowersWhoHaveNotBorrowedSince
74				&GetBorrowersWhoHaveNeverBorrowed
75				&GetBorrowersWithIssuesHistoryOlderThan
76
77				&GetExpiryDate
78
79				&GetMemberRevisions
80				);
81
82				#Modify data
83				push @EXPORT, qw(
84				&ModMember
85				&changepassword
86				);
87
88				#Delete data
89				push @EXPORT, qw(
90				&DelMember
91				);
92
93				#Insert data
94				push @EXPORT, qw(
95				&AddMember
96				&add_member_orgs
97				&MoveMemberToDeleted
98				&ExtendMemberSubscriptionTo
99				);
100
101				#Check data
102				push @EXPORT, qw(
103				&checkuniquemember
104				&checkuserpassword
105				&Check_Userid
106				&Generate_Userid
107				&fixEthnicity
108				&ethnicitycategories
109				&fixup_cardnumber
110				&checkcardnumber
111				);
112	1	3.51ms	3.51ms	}
113
114				=head1 NAME
115
116				C4::Members - Perl Module containing convenience functions for member handling
117
118				=head1 SYNOPSIS
119
120				use C4::Members;
121
122				=head1 DESCRIPTION
123
124				This module contains routines for adding, modifying and deleting members/patrons/borrowers
125
126				=head1 FUNCTIONS
127
128				=over 2
129
130				=item SearchMember
131
132				($count, $borrowers) = &SearchMember($searchstring, $type,$category_type,$filter,$showallbranches);
133
134				=back
135
136				Looks up patrons (borrowers) by name.
137
138				BUGFIX 499: C<$type> is now used to determine type of search.
139				if $type is "simple", search is performed on the first letter of the
140				surname only.
141
142				$category_type is used to get a specified type of user.
143				(mainly adults when creating a child.)
144
145				C<$searchstring> is a space-separated list of search terms. Each term
146				must match the beginning a borrower's surname, first name, or other
147				name.
148
149				C<$filter> is assumed to be a list of elements to filter results on
150
151				C<$showallbranches> is used in IndependantBranches Context to display all branches results.
152
153				C<&SearchMember> returns a two-element list. C<$borrowers> is a
154				reference-to-array; each element is a reference-to-hash, whose keys
155				are the fields of the C<borrowers> table in the Koha database.
156				C<$count> is the number of elements in C<$borrowers>.
157
158				=cut
159
160				#'
161				#used by member enquiries from the intranet
162				#called by member.pl and circ/circulation.pl
163				sub SearchMember {
164				my ($searchstring, $orderby, $type,$category_type,$filter,$showallbranches ) = @_;
165				my $dbh = C4::Context->dbh;
166				my $query = "";
167				my $count;
168				my @data;
169				my @bind = ();
170
171				# this is used by circulation everytime a new borrowers cardnumber is scanned
172				# so we can check an exact match first, if that works return, otherwise do the rest
173				$query = "SELECT * FROM borrowers
174				LEFT JOIN categories ON borrowers.categorycode=categories.categorycode
175				";
176				my $sth = $dbh->prepare("$query WHERE cardnumber = ?");
177				$sth->execute($searchstring);
178				my $data = $sth->fetchall_arrayref({});
179				if (@$data){
180				return ( scalar(@$data), $data );
181				}
182				$sth->finish;
183
184				if ( $type eq "simple" ) # simple search for one letter only
185				{
186				$query .= ($category_type ? " AND category_type = ".$dbh->quote($category_type) : "");
187				$query .= " WHERE (surname LIKE ? OR cardnumber like ?) ";
188				if (C4::Context->preference("IndependantBranches") && !$showallbranches){
189				if (C4::Context->userenv && C4::Context->userenv->{flags} % 2 !=1 && C4::Context->userenv->{'branch'}){
190				$query.=" AND borrowers.branchcode =".$dbh->quote(C4::Context->userenv->{'branch'}) unless (C4::Context->userenv->{'branch'} eq "insecure");
191				}
192				}
193				$query.=" ORDER BY $orderby";
194				@bind = ("$searchstring%","$searchstring");
195				}
196				else # advanced search looking in surname, firstname and othernames
197				{
198				@data = split( ' ', $searchstring );
199				$count = @data;
200				$query .= " WHERE ";
201				if (C4::Context->preference("IndependantBranches") && !$showallbranches){
202				if (C4::Context->userenv && C4::Context->userenv->{flags} % 2 !=1 && C4::Context->userenv->{'branch'}){
203				$query.=" borrowers.branchcode =".$dbh->quote(C4::Context->userenv->{'branch'})." AND " unless (C4::Context->userenv->{'branch'} eq "insecure");
204				}
205				}
206				$query.="((surname LIKE ? OR surname LIKE ?
207				OR firstname LIKE ? OR firstname LIKE ?
208				OR othernames LIKE ? OR othernames LIKE ?)
209				" .
210				($category_type?" AND category_type = ".$dbh->quote($category_type):"");
211				@bind = (
212				"$data[0]%", "% $data[0]%", "$data[0]%", "% $data[0]%",
213				"$data[0]%", "% $data[0]%"
214				);
215				for ( my $i = 1 ; $i < $count ; $i++ ) {
216				$query = $query . " AND (" . " surname LIKE ? OR surname LIKE ?
217				OR firstname LIKE ? OR firstname LIKE ?
218				OR othernames LIKE ? OR othernames LIKE ?)";
219				push( @bind,
220				"$data[$i]%", "% $data[$i]%", "$data[$i]%",
221				"% $data[$i]%", "$data[$i]%", "% $data[$i]%" );
222
223				# FIXME - .= <<EOT;
224				}
225				$query = $query . ") OR cardnumber LIKE ? ";
226				push( @bind, $searchstring );
227				if (C4::Context->preference('ExtendedPatronAttributes')) {
228				$query .= "OR borrowernumber IN (
229				SELECT borrowernumber
230				FROM borrower_attributes
231				JOIN borrower_attribute_types USING (code)
232				WHERE staff_searchable = 1
233				AND attribute like ?
234				)";
235				push (@bind, $searchstring);
236				}
237				$query .= "order by $orderby";
238
239				# FIXME - .= <<EOT;
240				}
241
242				$sth = $dbh->prepare($query);
243
244				$debug and print STDERR "Q $orderby : $query\n";
245				$sth->execute(@bind);
246				my @results;
247				$data = $sth->fetchall_arrayref({});
248
249				$sth->finish;
250				return ( scalar(@$data), $data );
251				}
252
253				=head2 GetMemberDetails
254
255				($borrower) = &GetMemberDetails($borrowernumber, $cardnumber);
256
257				Looks up a patron and returns information about him or her. If
258				C<$borrowernumber> is true (nonzero), C<&GetMemberDetails> looks
259				up the borrower by number; otherwise, it looks up the borrower by card
260				number.
261
262				C<$borrower> is a reference-to-hash whose keys are the fields of the
263				borrowers table in the Koha database. In addition,
264				C<$borrower-E<gt>{flags}> is a hash giving more detailed information
265				about the patron. Its keys act as flags :
266
267				if $borrower->{flags}->{LOST} {
268				# Patron's card was reported lost
269				}
270
271				If the state of a flag means that the patron should not be
272				allowed to borrow any more books, then it will have a C<noissues> key
273				with a true value.
274
275				See patronflags for more details.
276
277				C<$borrower-E<gt>{authflags}> is a hash giving more detailed information
278				about the top-level permissions flags set for the borrower. For example,
279				if a user has the "editcatalogue" permission,
280				C<$borrower-E<gt>{authflags}-E<gt>{editcatalogue}> will exist and have
281				the value "1".
282
283				=cut
284
285				sub GetMemberDetails {
286				my ( $borrowernumber, $cardnumber ) = @_;
287				my $dbh = C4::Context->dbh;
288				my $query;
289				my $sth;
290				if ($borrowernumber) {
291				$sth = $dbh->prepare("select borrowers.*,category_type,categories.description from borrowers left join categories on borrowers.categorycode=categories.categorycode where borrowernumber=?");
292				$sth->execute($borrowernumber);
293				}
294				elsif ($cardnumber) {
295				$sth = $dbh->prepare("select borrowers.*,category_type,categories.description from borrowers left join categories on borrowers.categorycode=categories.categorycode where cardnumber=?");
296				$sth->execute($cardnumber);
297				}
298				else {
299				return undef;
300				}
301				my $borrower = $sth->fetchrow_hashref;
302				my ($amount) = GetMemberAccountRecords( $borrowernumber);
303				$borrower->{'amountoutstanding'} = $amount;
304				# FIXME - patronflags calls GetMemberAccountRecords... just have patronflags return $amount
305				my $flags = patronflags( $borrower);
306				my $accessflagshash;
307
308				$sth = $dbh->prepare("select bit,flag from userflags");
309				$sth->execute;
310				while ( my ( $bit, $flag ) = $sth->fetchrow ) {
311				if ( $borrower->{'flags'} && $borrower->{'flags'} & 2**$bit ) {
312				$accessflagshash->{$flag} = 1;
313				}
314				}
315				$sth->finish;
316				$borrower->{'flags'} = $flags;
317				$borrower->{'authflags'} = $accessflagshash;
318
319				# find out how long the membership lasts
320				$sth =
321				$dbh->prepare(
322				"select enrolmentperiod from categories where categorycode = ?");
323				$sth->execute( $borrower->{'categorycode'} );
324				my $enrolment = $sth->fetchrow;
325				$borrower->{'enrolmentperiod'} = $enrolment;
326				return ($borrower); #, $flags, $accessflagshash);
327				}
328
329				=head2 patronflags
330
331				$flags = &patronflags($patron);
332
333				This function is not exported.
334
335				The following will be set where applicable:
336				$flags->{CHARGES}->{amount} Amount of debt
337				$flags->{CHARGES}->{noissues} Set if debt amount >$5.00 (or syspref noissuescharge)
338				$flags->{CHARGES}->{message} Message -- deprecated
339
340				$flags->{CREDITS}->{amount} Amount of credit
341				$flags->{CREDITS}->{message} Message -- deprecated
342
343				$flags->{ GNA } Patron has no valid address
344				$flags->{ GNA }->{noissues} Set for each GNA
345				$flags->{ GNA }->{message} "Borrower has no valid address" -- deprecated
346
347				$flags->{ LOST } Patron's card reported lost
348				$flags->{ LOST }->{noissues} Set for each LOST
349				$flags->{ LOST }->{message} Message -- deprecated
350
351				$flags->{DBARRED} Set if patron debarred, no access
352				$flags->{DBARRED}->{noissues} Set for each DBARRED
353				$flags->{DBARRED}->{message} Message -- deprecated
354
355				$flags->{ NOTES }
356				$flags->{ NOTES }->{message} The note itself. NOT deprecated
357
358				$flags->{ ODUES } Set if patron has overdue books.
359				$flags->{ ODUES }->{message} "Yes" -- deprecated
360				$flags->{ ODUES }->{itemlist} ref-to-array: list of overdue books
361				$flags->{ ODUES }->{itemlisttext} Text list of overdue items -- deprecated
362
363				$flags->{WAITING} Set if any of patron's reserves are available
364				$flags->{WAITING}->{message} Message -- deprecated
365				$flags->{WAITING}->{itemlist} ref-to-array: list of available items
366
367				=over 4
368
369				C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the
370				overdue items. Its elements are references-to-hash, each describing an
371				overdue item. The keys are selected fields from the issues, biblio,
372				biblioitems, and items tables of the Koha database.
373
374				C<$flags-E<gt>{ODUES}-E<gt>{itemlisttext}> is a string giving a text listing of
375				the overdue items, one per line. Deprecated.
376
377				C<$flags-E<gt>{WAITING}-E<gt>{itemlist}> is a reference-to-array listing the
378				available items. Each element is a reference-to-hash whose keys are
379				fields from the reserves table of the Koha database.
380
381				=back
382
383				All the "message" fields that include language generated in this function are deprecated,
384				because such strings belong properly in the display layer.
385
386				The "message" field that comes from the DB is OK.
387
388				=cut
389
390				# TODO: use {anonymous => hashes} instead of a dozen %flaginfo
391				# FIXME rename this function.
392				sub patronflags {
393				my %flags;
394				my ( $patroninformation) = @_;
395				my $dbh=C4::Context->dbh;
396				my ($amount) = GetMemberAccountRecords( $patroninformation->{'borrowernumber'});
397				if ( $amount > 0 ) {
398				my %flaginfo;
399				my $noissuescharge = C4::Context->preference("noissuescharge") \|\| 5;
400				$flaginfo{'message'} = sprintf "Patron owes \$%.02f", $amount;
401				$flaginfo{'amount'} = sprintf "%.02f", $amount;
402				if ( $amount > $noissuescharge ) {
403				$flaginfo{'noissues'} = 1;
404				}
405				$flags{'CHARGES'} = \%flaginfo;
406				}
407				elsif ( $amount < 0 ) {
408				my %flaginfo;
409				$flaginfo{'message'} = sprintf "Patron has credit of \$%.02f", -$amount;
410				$flaginfo{'amount'} = sprintf "%.02f", $amount;
411				$flags{'CREDITS'} = \%flaginfo;
412				}
413				if ( $patroninformation->{'gonenoaddress'}
414				&& $patroninformation->{'gonenoaddress'} == 1 )
415				{
416				my %flaginfo;
417				$flaginfo{'message'} = 'Borrower has no valid address.';
418				$flaginfo{'noissues'} = 1;
419				$flags{'GNA'} = \%flaginfo;
420				}
421				if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
422				my %flaginfo;
423				$flaginfo{'message'} = 'Borrower\'s card reported lost.';
424				$flaginfo{'noissues'} = 1;
425				$flags{'LOST'} = \%flaginfo;
426				}
427				if ( $patroninformation->{'debarred'}
428				&& $patroninformation->{'debarred'} == 1 )
429				{
430				my %flaginfo;
431				$flaginfo{'message'} = 'Borrower is Debarred.';
432				$flaginfo{'noissues'} = 1;
433				$flags{'DBARRED'} = \%flaginfo;
434				}
435				if ( $patroninformation->{'borrowernotes'}
436				&& $patroninformation->{'borrowernotes'} )
437				{
438				my %flaginfo;
439				$flaginfo{'message'} = $patroninformation->{'borrowernotes'};
440				$flags{'NOTES'} = \%flaginfo;
441				}
442				my ( $odues, $itemsoverdue ) = checkoverdues($patroninformation->{'borrowernumber'});
443				if ( $odues > 0 ) {
444				my %flaginfo;
445				$flaginfo{'message'} = "Yes";
446				$flaginfo{'itemlist'} = $itemsoverdue;
447				foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
448				@$itemsoverdue )
449				{
450				$flaginfo{'itemlisttext'} .=
451				"$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n"; # newline is display layer
452				}
453				$flags{'ODUES'} = \%flaginfo;
454				}
455				my @itemswaiting = C4::Reserves::GetReservesFromBorrowernumber( $patroninformation->{'borrowernumber'},'W' );
456				my $nowaiting = scalar @itemswaiting;
457				if ( $nowaiting > 0 ) {
458				my %flaginfo;
459				$flaginfo{'message'} = "Reserved items available";
460				$flaginfo{'itemlist'} = \@itemswaiting;
461				$flags{'WAITING'} = \%flaginfo;
462				}
463				return ( \%flags );
464				}
465
466
467				=head2 GetMember
468
469				$borrower = &GetMember($information, $type);
470
471				Looks up information about a patron (borrower) by either card number
472				,firstname, or borrower number, depending on $type value.
473				If C<$type> == 'cardnumber', C<&GetBorrower>
474				searches by cardnumber then by firstname if not found in cardnumber;
475				otherwise, it searches by borrowernumber.
476
477				C<&GetBorrower> returns a reference-to-hash whose keys are the fields of
478				the C<borrowers> table in the Koha database.
479
480				=cut
481
482				#'
483				# spent 366µs (44+322) within C4::Members::GetMember which was called # once (44µs+322µs) at line 61 of /home/chris/git/koha.git/opac/opac-main.pl sub GetMember {
484	12	248µs	21µs	my ( $information, $type ) = @_;
485				my $dbh = C4::Context->dbh; # spent 41µs making 1 call to C4::Context::dbh
486				my $sth;
487				my $select = "
488				SELECT borrowers.*, categories.category_type, categories.description
489				FROM borrowers
490				LEFT JOIN categories on borrowers.categorycode=categories.categorycode
491				";
492				if (defined($type) and ( $type eq 'cardnumber' \|\| $type eq 'firstname'\|\| $type eq 'userid'\|\| $type eq 'borrowernumber' ) ){
493				$information = uc $information;
494	1	6µs	6µs	$sth = $dbh->prepare("$select WHERE $type=?"); # spent 78µs making 1 call to DBI::db::prepare
495				} else {
496				$sth = $dbh->prepare("$select WHERE borrowernumber=?");
497				}
498				$sth->execute($information); # spent 148µs making 1 call to DBI::st::execute
499				my $data = $sth->fetchrow_hashref; # spent 55µs making 1 call to DBI::st::fetchrow_hashref # spent 28µs making 1 call to DBI::common::FETCH # spent 12µs making 1 call to DBI::st::fetch
500				($data) and return ($data);
501
502				if (defined($type) and ($type eq 'cardnumber' \|\| $type eq 'firstname')) { # otherwise, try with firstname
503				$sth = $dbh->prepare("$select WHERE firstname like ?");
504				$sth->execute($information);
505				$data = $sth->fetchrow_hashref;
506				($data) and return ($data);
507				}
508				return undef;
509				}
510
511				=head2 GetMemberIssuesAndFines
512
513				($overdue_count, $issue_count, $total_fines) = &GetMemberIssuesAndFines($borrowernumber);
514
515				Returns aggregate data about items borrowed by the patron with the
516				given borrowernumber.
517
518				C<&GetMemberIssuesAndFines> returns a three-element array. C<$overdue_count> is the
519				number of overdue items the patron currently has borrowed. C<$issue_count> is the
520				number of books the patron currently has borrowed. C<$total_fines> is
521				the total fine currently due by the borrower.
522
523				=cut
524
525				#'
526				sub GetMemberIssuesAndFines {
527				my ( $borrowernumber ) = @_;
528				my $dbh = C4::Context->dbh;
529				my $query = "SELECT COUNT(*) FROM issues WHERE borrowernumber = ?";
530
531				$debug and warn $query."\n";
532				my $sth = $dbh->prepare($query);
533				$sth->execute($borrowernumber);
534				my $issue_count = $sth->fetchrow_arrayref->[0];
535				$sth->finish;
536
537				$sth = $dbh->prepare(
538				"SELECT COUNT(*) FROM issues
539				WHERE borrowernumber = ?
540				AND date_due < now()"
541				);
542				$sth->execute($borrowernumber);
543				my $overdue_count = $sth->fetchrow_arrayref->[0];
544				$sth->finish;
545
546				$sth = $dbh->prepare("SELECT SUM(amountoutstanding) FROM accountlines WHERE borrowernumber = ?");
547				$sth->execute($borrowernumber);
548				my $total_fines = $sth->fetchrow_arrayref->[0];
549				$sth->finish;
550
551				return ($overdue_count, $issue_count, $total_fines);
552				}
553
554				sub columns(;$) {
555				return @{C4::Context->dbh->selectcol_arrayref("SHOW columns from borrowers")};
556				}
557
558				=head2
559
560				=head2 ModMember
561
562				=over 4
563
564				my $success = ModMember(borrowernumber => $borrowernumber, [ field => value ]... );
565
566				Modify borrower's data. All date fields should ALREADY be in ISO format.
567
568				return :
569				true on success, or false on failure
570
571				=back
572
573				=cut
574
575				sub ModMember {
576				my (%data) = @_;
577				my $dbh = C4::Context->dbh;
578				my $iso_re = C4::Dates->new()->regexp('iso');
579				foreach (qw(dateofbirth dateexpiry dateenrolled)) {
580				if (my $tempdate = $data{$_}) { # assignment, not comparison
581				($tempdate =~ /$iso_re/) and next; # Congatulations, you sent a valid ISO date.
582				warn "ModMember given $_ not in ISO format ($tempdate)";
583				my $tempdate2 = format_date_in_iso($tempdate);
584				if (!$tempdate2 or $tempdate2 eq '0000-00-00') {
585				warn "ModMember cannot convert '$tempdate' (from syspref to ISO)";
586				next;
587				}
588				$data{$_} = $tempdate2;
589				}
590				}
591				if (!$data{'dateofbirth'}){
592				delete $data{'dateofbirth'};
593				}
594				my @columns = &columns;
595				my %hashborrowerfields = (map {$_=>1} @columns);
596				my $query = "UPDATE borrowers SET \n";
597				my $sth;
598				my @parameters;
599
600				# test to know if you must update or not the borrower password
601				if (exists $data{password}) {
602				if ($data{password} eq '****' or $data{password} eq '') {
603				delete $data{password};
604				} else {
605				$data{password} = md5_base64($data{password});
606				}
607				}
608				my @badkeys;
609				foreach (keys %data) {
610				next if ($_ eq 'borrowernumber' or $_ eq 'flags');
611				if ($hashborrowerfields{$_}){
612				$query .= " $_=?, ";
613				push @parameters,$data{$_};
614				} else {
615				push @badkeys, $_;
616				delete $data{$_};
617				}
618				}
619				(@badkeys) and warn scalar(@badkeys) . " Illegal key(s) passed to ModMember: " . join(',',@badkeys);
620				$query =~ s/, $//;
621				$query .= " WHERE borrowernumber=?";
622				push @parameters, $data{'borrowernumber'};
623				$debug and print STDERR "$query (executed w/ arg: $data{'borrowernumber'})";
624				$sth = $dbh->prepare($query);
625				my $execute_success = $sth->execute(@parameters);
626				$sth->finish;
627
628				# ok if its an adult (type) it may have borrowers that depend on it as a guarantor
629				# so when we update information for an adult we should check for guarantees and update the relevant part
630				# of their records, ie addresses and phone numbers
631				my $borrowercategory= GetBorrowercategory( $data{'category_type'} );
632				if ( exists $borrowercategory->{'category_type'} && $borrowercategory->{'category_type'} eq ('A' \|\| 'S') ) {
633				# is adult check guarantees;
634				UpdateGuarantees(%data);
635				}
636				logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "$query (executed w/ arg: $data{'borrowernumber'})")
637				if C4::Context->preference("BorrowersLog");
638
639				return $execute_success;
640				}
641
642
643				=head2
644
645				=head2 AddMember
646
647				$borrowernumber = &AddMember(%borrower);
648
649				insert new borrower into table
650				Returns the borrowernumber
651
652				=cut
653
654				#'
655				sub AddMember {
656				my (%data) = @_;
657				my $dbh = C4::Context->dbh;
658				$data{'userid'} = '' unless $data{'password'};
659				$data{'password'} = md5_base64( $data{'password'} ) if $data{'password'};
660
661				# WE SHOULD NEVER PASS THIS SUBROUTINE ANYTHING OTHER THAN ISO DATES
662				# IF YOU UNCOMMENT THESE LINES YOU BETTER HAVE A DARN COMPELLING REASON
663				# $data{'dateofbirth'} = format_date_in_iso( $data{'dateofbirth'} );
664				# $data{'dateenrolled'} = format_date_in_iso( $data{'dateenrolled'});
665				# $data{'dateexpiry'} = format_date_in_iso( $data{'dateexpiry'} );
666				# This query should be rewritten to use "?" at execute.
667				if (!$data{'dateofbirth'}){
668				undef ($data{'dateofbirth'});
669				}
670				my $query =
671				"insert into borrowers set cardnumber=" . $dbh->quote( $data{'cardnumber'} )
672				. ",surname=" . $dbh->quote( $data{'surname'} )
673				. ",firstname=" . $dbh->quote( $data{'firstname'} )
674				. ",title=" . $dbh->quote( $data{'title'} )
675				. ",othernames=" . $dbh->quote( $data{'othernames'} )
676				. ",initials=" . $dbh->quote( $data{'initials'} )
677				. ",streetnumber=". $dbh->quote( $data{'streetnumber'} )
678				. ",streettype=" . $dbh->quote( $data{'streettype'} )
679				. ",address=" . $dbh->quote( $data{'address'} )
680				. ",address2=" . $dbh->quote( $data{'address2'} )
681				. ",zipcode=" . $dbh->quote( $data{'zipcode'} )
682				. ",city=" . $dbh->quote( $data{'city'} )
683				. ",phone=" . $dbh->quote( $data{'phone'} )
684				. ",email=" . $dbh->quote( $data{'email'} )
685				. ",mobile=" . $dbh->quote( $data{'mobile'} )
686				. ",phonepro=" . $dbh->quote( $data{'phonepro'} )
687				. ",opacnote=" . $dbh->quote( $data{'opacnote'} )
688				. ",guarantorid=" . $dbh->quote( $data{'guarantorid'} )
689				. ",dateofbirth=" . $dbh->quote( $data{'dateofbirth'} )
690				. ",branchcode=" . $dbh->quote( $data{'branchcode'} )
691				. ",categorycode=" . $dbh->quote( $data{'categorycode'} )
692				. ",dateenrolled=" . $dbh->quote( $data{'dateenrolled'} )
693				. ",contactname=" . $dbh->quote( $data{'contactname'} )
694				. ",borrowernotes=" . $dbh->quote( $data{'borrowernotes'} )
695				. ",dateexpiry=" . $dbh->quote( $data{'dateexpiry'} )
696				. ",contactnote=" . $dbh->quote( $data{'contactnote'} )
697				. ",B_address=" . $dbh->quote( $data{'B_address'} )
698				. ",B_zipcode=" . $dbh->quote( $data{'B_zipcode'} )
699				. ",B_city=" . $dbh->quote( $data{'B_city'} )
700				. ",B_phone=" . $dbh->quote( $data{'B_phone'} )
701				. ",B_email=" . $dbh->quote( $data{'B_email'} )
702				. ",password=" . $dbh->quote( $data{'password'} )
703				. ",userid=" . $dbh->quote( $data{'userid'} )
704				. ",sort1=" . $dbh->quote( $data{'sort1'} )
705				. ",sort2=" . $dbh->quote( $data{'sort2'} )
706				. ",contacttitle=" . $dbh->quote( $data{'contacttitle'} )
707				. ",emailpro=" . $dbh->quote( $data{'emailpro'} )
708				. ",contactfirstname=" . $dbh->quote( $data{'contactfirstname'} )
709				. ",sex=" . $dbh->quote( $data{'sex'} )
710				. ",fax=" . $dbh->quote( $data{'fax'} )
711				. ",relationship=" . $dbh->quote( $data{'relationship'} )
712				. ",B_streetnumber=" . $dbh->quote( $data{'B_streetnumber'} )
713				. ",B_streettype=" . $dbh->quote( $data{'B_streettype'} )
714				. ",gonenoaddress=" . $dbh->quote( $data{'gonenoaddress'} )
715				. ",lost=" . $dbh->quote( $data{'lost'} )
716				. ",debarred=" . $dbh->quote( $data{'debarred'} )
717				. ",ethnicity=" . $dbh->quote( $data{'ethnicity'} )
718				. ",ethnotes=" . $dbh->quote( $data{'ethnotes'} )
719				. ",altcontactsurname=" . $dbh->quote( $data{'altcontactsurname'} )
720				. ",altcontactfirstname=" . $dbh->quote( $data{'altcontactfirstname'} )
721				. ",altcontactaddress1=" . $dbh->quote( $data{'altcontactaddress1'} )
722				. ",altcontactaddress2=" . $dbh->quote( $data{'altcontactaddress2'} )
723				. ",altcontactaddress3=" . $dbh->quote( $data{'altcontactaddress3'} )
724				. ",altcontactzipcode=" . $dbh->quote( $data{'altcontactzipcode'} )
725				. ",altcontactphone=" . $dbh->quote( $data{'altcontactphone'} ) ;
726				$debug and print STDERR "AddMember SQL: ($query)\n";
727				my $sth = $dbh->prepare($query);
728				# print "Executing SQL: $query\n";
729				$sth->execute();
730				$sth->finish;
731				$data{'borrowernumber'} = $dbh->{'mysql_insertid'}; # unneeded w/ autoincrement ?
732				# mysql_insertid is probably bad. not necessarily accurate and mysql-specific at best.
733
734				logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");
735
736				# check for enrollment fee & add it if needed
737				$sth = $dbh->prepare("SELECT enrolmentfee FROM categories WHERE categorycode=?");
738				$sth->execute($data{'categorycode'});
739				my ($enrolmentfee) = $sth->fetchrow;
740				if ($enrolmentfee && $enrolmentfee > 0) {
741				# insert fee in patron debts
742				manualinvoice($data{'borrowernumber'}, '', '', 'A', $enrolmentfee);
743				}
744				return $data{'borrowernumber'};
745				}
746
747				sub Check_Userid {
748				my ($uid,$member) = @_;
749				my $dbh = C4::Context->dbh;
750				# Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
751				# Then we need to tell the user and have them create a new one.
752				my $sth =
753				$dbh->prepare(
754				"SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
755				$sth->execute( $uid, $member );
756				if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
757				return 0;
758				}
759				else {
760				return 1;
761				}
762				}
763
764				sub Generate_Userid {
765				my ($borrowernumber, $firstname, $surname) = @_;
766				my $newuid;
767				my $offset = 0;
768				do {
769				$firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
770				$surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
771				$newuid = lc("$firstname.$surname");
772				$newuid .= $offset unless $offset == 0;
773				$offset++;
774
775				} while (!Check_Userid($newuid,$borrowernumber));
776
777				return $newuid;
778				}
779
780				sub changepassword {
781				my ( $uid, $member, $digest ) = @_;
782				my $dbh = C4::Context->dbh;
783
784				#Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
785				#Then we need to tell the user and have them create a new one.
786				my $resultcode;
787				my $sth =
788				$dbh->prepare(
789				"SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
790				$sth->execute( $uid, $member );
791				if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
792				$resultcode=0;
793				}
794				else {
795				#Everything is good so we can update the information.
796				$sth =
797				$dbh->prepare(
798				"update borrowers set userid=?, password=? where borrowernumber=?");
799				$sth->execute( $uid, $digest, $member );
800				$resultcode=1;
801				}
802
803				logaction("MEMBERS", "CHANGE PASS", $member, "") if C4::Context->preference("BorrowersLog");
804				return $resultcode;
805				}
806
807
808
809				=head2 fixup_cardnumber
810
811				Warning: The caller is responsible for locking the members table in write
812				mode, to avoid database corruption.
813
814				=cut
815
816	3	4.94ms	1.65ms	use vars qw( @weightings ); # spent 36µs making 1 call to vars::import
817	1	2µs	2µs	my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
818
819				sub fixup_cardnumber ($) {
820				my ($cardnumber) = @_;
821				my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') \|\| 0;
822
823				# Find out whether member numbers should be generated
824				# automatically. Should be either "1" or something else.
825				# Defaults to "0", which is interpreted as "no".
826
827				# if ($cardnumber !~ /\S/ && $autonumber_members) {
828				($autonumber_members) or return $cardnumber;
829				my $checkdigit = C4::Context->preference('checkdigit');
830				my $dbh = C4::Context->dbh;
831				if ( $checkdigit and $checkdigit eq 'katipo' ) {
832
833				# if checkdigit is selected, calculate katipo-style cardnumber.
834				# otherwise, just use the max()
835				# purpose: generate checksum'd member numbers.
836				# We'll assume we just got the max value of digits 2-8 of member #'s
837				# from the database and our job is to increment that by one,
838				# determine the 1st and 9th digits and return the full string.
839				my $sth = $dbh->prepare(
840				"select max(substring(borrowers.cardnumber,2,7)) as new_num from borrowers"
841				);
842				$sth->execute;
843				my $data = $sth->fetchrow_hashref;
844				$cardnumber = $data->{new_num};
845				if ( !$cardnumber ) { # If DB has no values,
846				$cardnumber = 1000000; # start at 1000000
847				} else {
848				$cardnumber += 1;
849				}
850
851				my $sum = 0;
852				for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
853				# read weightings, left to right, 1 char at a time
854				my $temp1 = $weightings[$i];
855
856				# sequence left to right, 1 char at a time
857				my $temp2 = substr( $cardnumber, $i, 1 );
858
859				# mult each char 1-7 by its corresponding weighting
860				$sum += $temp1 * $temp2;
861				}
862
863				my $rem = ( $sum % 11 );
864				$rem = 'X' if $rem == 10;
865
866				return "V$cardnumber$rem";
867				} else {
868
869				# MODIFIED BY JF: mysql4.1 allows casting as an integer, which is probably
870				# better. I'll leave the original in in case it needs to be changed for you
871				# my $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers");
872				my $sth = $dbh->prepare(
873				"select max(cast(cardnumber as signed)) from borrowers"
874				);
875				$sth->execute;
876				my ($result) = $sth->fetchrow;
877				return $result + 1;
878				}
879				return $cardnumber; # just here as a fallback/reminder
880				}
881
882				=head2 GetGuarantees
883
884				($num_children, $children_arrayref) = &GetGuarantees($parent_borrno);
885				$child0_cardno = $children_arrayref->[0]{"cardnumber"};
886				$child0_borrno = $children_arrayref->[0]{"borrowernumber"};
887
888				C<&GetGuarantees> takes a borrower number (e.g., that of a patron
889				with children) and looks up the borrowers who are guaranteed by that
890				borrower (i.e., the patron's children).
891
892				C<&GetGuarantees> returns two values: an integer giving the number of
893				borrowers guaranteed by C<$parent_borrno>, and a reference to an array
894				of references to hash, which gives the actual results.
895
896				=cut
897
898				#'
899				sub GetGuarantees {
900				my ($borrowernumber) = @_;
901				my $dbh = C4::Context->dbh;
902				my $sth =
903				$dbh->prepare(
904				"select cardnumber,borrowernumber, firstname, surname from borrowers where guarantorid=?"
905				);
906				$sth->execute($borrowernumber);
907
908				my @dat;
909				my $data = $sth->fetchall_arrayref({});
910				$sth->finish;
911				return ( scalar(@$data), $data );
912				}
913
914				=head2 UpdateGuarantees
915
916				&UpdateGuarantees($parent_borrno);
917
918
919				C<&UpdateGuarantees> borrower data for an adult and updates all the guarantees
920				with the modified information
921
922				=cut
923
924				#'
925				sub UpdateGuarantees {
926				my (%data) = @_;
927				my $dbh = C4::Context->dbh;
928				my ( $count, $guarantees ) = GetGuarantees( $data{'borrowernumber'} );
929				for ( my $i = 0 ; $i < $count ; $i++ ) {
930
931				# FIXME
932				# It looks like the $i is only being returned to handle walking through
933				# the array, which is probably better done as a foreach loop.
934				#
935				my $guaquery = qq\|UPDATE borrowers
936				SET address='$data{'address'}',fax='$data{'fax'}',
937				B_city='$data{'B_city'}',mobile='$data{'mobile'}',city='$data{'city'}',phone='$data{'phone'}'
938				WHERE borrowernumber='$guarantees->[$i]->{'borrowernumber'}'
939				\|;
940				my $sth3 = $dbh->prepare($guaquery);
941				$sth3->execute;
942				$sth3->finish;
943				}
944				}
945				=head2 GetPendingIssues
946
947				my $issues = &GetPendingIssues($borrowernumber);
948
949				Looks up what the patron with the given borrowernumber has borrowed.
950
951				C<&GetPendingIssues> returns a
952				reference-to-array where each element is a reference-to-hash; the
953				keys are the fields from the C<issues>, C<biblio>, and C<items> tables.
954				The keys include C<biblioitems> fields except marc and marcxml.
955
956				=cut
957
958				#'
959				sub GetPendingIssues {
960				my ($borrowernumber) = @_;
961				# must avoid biblioitems.* to prevent large marc and marcxml fields from killing performance
962				# FIXME: namespace collision: each table has "timestamp" fields. Which one is "timestamp" ?
963				# FIXME: circ/ciculation.pl tries to sort by timestamp!
964				# FIXME: C4::Print::printslip tries to sort by timestamp!
965				# FIXME: namespace collision: other collisions possible.
966				# FIXME: most of this data isn't really being used by callers.
967				my $sth = C4::Context->dbh->prepare(
968				"SELECT issues.*,
969				items.*,
970				biblio.*,
971				biblioitems.volume,
972				biblioitems.number,
973				biblioitems.itemtype,
974				biblioitems.isbn,
975				biblioitems.issn,
976				biblioitems.publicationyear,
977				biblioitems.publishercode,
978				biblioitems.volumedate,
979				biblioitems.volumedesc,
980				biblioitems.lccn,
981				biblioitems.url,
982				issues.timestamp AS timestamp,
983				issues.renewals AS renewals,
984				items.renewals AS totalrenewals
985				FROM issues
986				LEFT JOIN items ON items.itemnumber = issues.itemnumber
987				LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
988				LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
989				WHERE
990				borrowernumber=?
991				ORDER BY issues.issuedate"
992				);
993				$sth->execute($borrowernumber);
994				my $data = $sth->fetchall_arrayref({});
995				my $today = C4::Dates->new->output('iso');
996				foreach (@$data) {
997				$_->{date_due} or next;
998				($_->{date_due} lt $today) and $_->{overdue} = 1;
999				}
1000				return $data;
1001				}
1002
1003				=head2 GetAllIssues
1004
1005				($count, $issues) = &GetAllIssues($borrowernumber, $sortkey, $limit);
1006
1007				Looks up what the patron with the given borrowernumber has borrowed,
1008				and sorts the results.
1009
1010				C<$sortkey> is the name of a field on which to sort the results. This
1011				should be the name of a field in the C<issues>, C<biblio>,
1012				C<biblioitems>, or C<items> table in the Koha database.
1013
1014				C<$limit> is the maximum number of results to return.
1015
1016				C<&GetAllIssues> returns a two-element array. C<$issues> is a
1017				reference-to-array, where each element is a reference-to-hash; the
1018				keys are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
1019				C<items> tables of the Koha database. C<$count> is the number of
1020				elements in C<$issues>
1021
1022				=cut
1023
1024				#'
1025				sub GetAllIssues {
1026				my ( $borrowernumber, $order, $limit ) = @_;
1027
1028				#FIXME: sanity-check order and limit
1029				my $dbh = C4::Context->dbh;
1030				my $count = 0;
1031				my $query =
1032				"SELECT *,issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1033				FROM issues
1034				LEFT JOIN items on items.itemnumber=issues.itemnumber
1035				LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1036				LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1037				WHERE borrowernumber=?
1038				UNION ALL
1039				SELECT *,old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1040				FROM old_issues
1041				LEFT JOIN items on items.itemnumber=old_issues.itemnumber
1042				LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1043				LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1044				WHERE borrowernumber=?
1045				order by $order";
1046				if ( $limit != 0 ) {
1047				$query .= " limit $limit";
1048				}
1049
1050				#print $query;
1051				my $sth = $dbh->prepare($query);
1052				$sth->execute($borrowernumber, $borrowernumber);
1053				my @result;
1054				my $i = 0;
1055				while ( my $data = $sth->fetchrow_hashref ) {
1056				$result[$i] = $data;
1057				$i++;
1058				$count++;
1059				}
1060
1061				# get all issued items for borrowernumber from oldissues table
1062				# large chunk of older issues data put into table oldissues
1063				# to speed up db calls for issuing items
1064				if ( C4::Context->preference("ReadingHistory") ) {
1065				# FIXME oldissues (not to be confused with old_issues) is
1066				# apparently specific to HLT. Not sure if the ReadingHistory
1067				# syspref is still required, as old_issues by design
1068				# is no longer checked with each loan.
1069				my $query2 = "SELECT * FROM oldissues
1070				LEFT JOIN items ON items.itemnumber=oldissues.itemnumber
1071				LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1072				LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1073				WHERE borrowernumber=?
1074				ORDER BY $order";
1075				if ( $limit != 0 ) {
1076				$limit = $limit - $count;
1077				$query2 .= " limit $limit";
1078				}
1079
1080				my $sth2 = $dbh->prepare($query2);
1081				$sth2->execute($borrowernumber);
1082
1083				while ( my $data2 = $sth2->fetchrow_hashref ) {
1084				$result[$i] = $data2;
1085				$i++;
1086				}
1087				$sth2->finish;
1088				}
1089				$sth->finish;
1090
1091				return ( $i, \@result );
1092				}
1093
1094
1095				=head2 GetMemberAccountRecords
1096
1097				($total, $acctlines, $count) = &GetMemberAccountRecords($borrowernumber);
1098
1099				Looks up accounting data for the patron with the given borrowernumber.
1100
1101				C<&GetMemberAccountRecords> returns a three-element array. C<$acctlines> is a
1102				reference-to-array, where each element is a reference-to-hash; the
1103				keys are the fields of the C<accountlines> table in the Koha database.
1104				C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1105				total amount outstanding for all of the account lines.
1106
1107				=cut
1108
1109				#'
1110				sub GetMemberAccountRecords {
1111				my ($borrowernumber,$date) = @_;
1112				my $dbh = C4::Context->dbh;
1113				my @acctlines;
1114				my $numlines = 0;
1115				my $strsth = qq(
1116				SELECT *
1117				FROM accountlines
1118				WHERE borrowernumber=?);
1119				my @bind = ($borrowernumber);
1120				if ($date && $date ne ''){
1121				$strsth.=" AND date < ? ";
1122				push(@bind,$date);
1123				}
1124				$strsth.=" ORDER BY date desc,timestamp DESC";
1125				my $sth= $dbh->prepare( $strsth );
1126				$sth->execute( @bind );
1127				my $total = 0;
1128				while ( my $data = $sth->fetchrow_hashref ) {
1129				my $biblio = GetBiblioFromItemNumber($data->{itemnumber}) if $data->{itemnumber};
1130				$data->{biblionumber} = $biblio->{biblionumber};
1131				$data->{title} = $biblio->{title};
1132				$acctlines[$numlines] = $data;
1133				$numlines++;
1134				$total += int(1000 * $data->{'amountoutstanding'}); # convert float to integer to avoid round-off errors
1135				}
1136				$total /= 1000;
1137				$sth->finish;
1138				return ( $total, \@acctlines,$numlines);
1139				}
1140
1141				=head2 GetBorNotifyAcctRecord
1142
1143				($count, $acctlines, $total) = &GetBorNotifyAcctRecord($params,$notifyid);
1144
1145				Looks up accounting data for the patron with the given borrowernumber per file number.
1146
1147				(FIXME - I'm not at all sure what this is about.)
1148
1149				C<&GetBorNotifyAcctRecord> returns a three-element array. C<$acctlines> is a
1150				reference-to-array, where each element is a reference-to-hash; the
1151				keys are the fields of the C<accountlines> table in the Koha database.
1152				C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1153				total amount outstanding for all of the account lines.
1154
1155				=cut
1156
1157				sub GetBorNotifyAcctRecord {
1158				my ( $borrowernumber, $notifyid ) = @_;
1159				my $dbh = C4::Context->dbh;
1160				my @acctlines;
1161				my $numlines = 0;
1162				my $sth = $dbh->prepare(
1163				"SELECT *
1164				FROM accountlines
1165				WHERE borrowernumber=?
1166				AND notify_id=?
1167				AND amountoutstanding != '0'
1168				ORDER BY notify_id,accounttype
1169				");
1170				# AND (accounttype='FU' OR accounttype='N' OR accounttype='M'OR accounttype='A'OR accounttype='F'OR accounttype='L' OR accounttype='IP' OR accounttype='CH' OR accounttype='RE' OR accounttype='RL')
1171
1172				$sth->execute( $borrowernumber, $notifyid );
1173				my $total = 0;
1174				while ( my $data = $sth->fetchrow_hashref ) {
1175				$acctlines[$numlines] = $data;
1176				$numlines++;
1177				$total += int(100 * $data->{'amountoutstanding'});
1178				}
1179				$total /= 100;
1180				$sth->finish;
1181				return ( $total, \@acctlines, $numlines );
1182				}
1183
1184				=head2 checkuniquemember (OUEST-PROVENCE)
1185
1186				($result,$categorycode) = &checkuniquemember($collectivity,$surname,$firstname,$dateofbirth);
1187
1188				Checks that a member exists or not in the database.
1189
1190				C<&result> is nonzero (=exist) or 0 (=does not exist)
1191				C<&categorycode> is from categorycode table
1192				C<&collectivity> is 1 (= we add a collectivity) or 0 (= we add a physical member)
1193				C<&surname> is the surname
1194				C<&firstname> is the firstname (only if collectivity=0)
1195				C<&dateofbirth> is the date of birth in ISO format (only if collectivity=0)
1196
1197				=cut
1198
1199				# FIXME: This function is not legitimate. Multiple patrons might have the same first/last name and birthdate.
1200				# This is especially true since first name is not even a required field.
1201
1202				sub checkuniquemember {
1203				my ( $collectivity, $surname, $firstname, $dateofbirth ) = @_;
1204				my $dbh = C4::Context->dbh;
1205				my $request = ($collectivity) ?
1206				"SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? " :
1207				($dateofbirth) ?
1208				"SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=? and dateofbirth=?" :
1209				"SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=?";
1210				my $sth = $dbh->prepare($request);
1211				if ($collectivity) {
1212				$sth->execute( uc($surname) );
1213				} elsif($dateofbirth){
1214				$sth->execute( uc($surname), ucfirst($firstname), $dateofbirth );
1215				}else{
1216				$sth->execute( uc($surname), ucfirst($firstname));
1217				}
1218				my @data = $sth->fetchrow;
1219				$sth->finish;
1220				( $data[0] ) and return $data[0], $data[1];
1221				return 0;
1222				}
1223
1224				sub checkcardnumber {
1225				my ($cardnumber,$borrowernumber) = @_;
1226				my $dbh = C4::Context->dbh;
1227				my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
1228				$query .= " AND borrowernumber <> ?" if ($borrowernumber);
1229				my $sth = $dbh->prepare($query);
1230				if ($borrowernumber) {
1231				$sth->execute($cardnumber,$borrowernumber);
1232				} else {
1233				$sth->execute($cardnumber);
1234				}
1235				if (my $data= $sth->fetchrow_hashref()){
1236				return 1;
1237				}
1238				else {
1239				return 0;
1240				}
1241				$sth->finish();
1242				}
1243
1244
1245				=head2 getzipnamecity (OUEST-PROVENCE)
1246
1247				take all info from table city for the fields city and zip
1248				check for the name and the zip code of the city selected
1249
1250				=cut
1251
1252				sub getzipnamecity {
1253				my ($cityid) = @_;
1254				my $dbh = C4::Context->dbh;
1255				my $sth =
1256				$dbh->prepare(
1257				"select city_name,city_zipcode from cities where cityid=? ");
1258				$sth->execute($cityid);
1259				my @data = $sth->fetchrow;
1260				return $data[0], $data[1];
1261				}
1262
1263
1264				=head2 getdcity (OUEST-PROVENCE)
1265
1266				recover cityid with city_name condition
1267
1268				=cut
1269
1270				sub getidcity {
1271				my ($city_name) = @_;
1272				my $dbh = C4::Context->dbh;
1273				my $sth = $dbh->prepare("select cityid from cities where city_name=? ");
1274				$sth->execute($city_name);
1275				my $data = $sth->fetchrow;
1276				return $data;
1277				}
1278
1279
1280				=head2 GetExpiryDate
1281
1282				$expirydate = GetExpiryDate($categorycode, $dateenrolled);
1283
1284				Calculate expiry date given a categorycode and starting date. Date argument must be in ISO format.
1285				Return date is also in ISO format.
1286
1287				=cut
1288
1289				sub GetExpiryDate {
1290				my ( $categorycode, $dateenrolled ) = @_;
1291				my $enrolmentperiod = 12; # reasonable default
1292				if ($categorycode) {
1293				my $dbh = C4::Context->dbh;
1294				my $sth = $dbh->prepare("select enrolmentperiod from categories where categorycode=?");
1295				$sth->execute($categorycode);
1296				$enrolmentperiod = $sth->fetchrow;
1297				}
1298				# die "GetExpiryDate: for enrollmentperiod $enrolmentperiod (category '$categorycode') starting $dateenrolled.\n";
1299				my @date = split /-/,$dateenrolled;
1300				return sprintf("%04d-%02d-%02d", Add_Delta_YM(@date,0,$enrolmentperiod));
1301				}
1302
1303				=head2 GetMemberRevisions
1304
1305				=over 4
1306
1307				$revisions = &GetMemberRevisions($borrowernumber);
1308
1309				Looks up addition/modification occurences of a patron's
1310				account by library staff via the action_logs table.
1311				Uses patron's borrowernumber for database selection.
1312
1313				&GetMemberRevisions returns a reference-to array where each element
1314				is a reference-to-hash whose keys are the fields of the action_logs
1315				table.
1316
1317				=cut
1318
1319				#'
1320				sub GetMemberRevisions {
1321
1322				my ($borrowernumber) = @_;
1323				my $dbh = C4::Context->dbh;
1324				my $sth;
1325				my $select = "
1326				SELECT *
1327				FROM action_logs
1328				WHERE object=?
1329				";
1330				$sth = $dbh->prepare($select);
1331				$sth->execute($borrowernumber);
1332				my $data = $sth->fetchall_arrayref({});
1333				($data) and return ($data);
1334
1335				return undef;
1336				}
1337
1338				=head2 checkuserpassword (OUEST-PROVENCE)
1339
1340				check for the password and login are not used
1341				return the number of record
1342				0=> NOT USED 1=> USED
1343
1344				=cut
1345
1346				sub checkuserpassword {
1347				my ( $borrowernumber, $userid, $password ) = @_;
1348				$password = md5_base64($password);
1349				my $dbh = C4::Context->dbh;
1350				my $sth =
1351				$dbh->prepare(
1352				"Select count(*) from borrowers where borrowernumber !=? and userid =? and password=? "
1353				);
1354				$sth->execute( $borrowernumber, $userid, $password );
1355				my $number_rows = $sth->fetchrow;
1356				return $number_rows;
1357
1358				}
1359
1360				=head2 GetborCatFromCatType
1361
1362				($codes_arrayref, $labels_hashref) = &GetborCatFromCatType();
1363
1364				Looks up the different types of borrowers in the database. Returns two
1365				elements: a reference-to-array, which lists the borrower category
1366				codes, and a reference-to-hash, which maps the borrower category codes
1367				to category descriptions.
1368
1369				=cut
1370
1371				#'
1372				sub GetborCatFromCatType {
1373				my ( $category_type, $action ) = @_;
1374				# FIXME - This API seems both limited and dangerous.
1375				my $dbh = C4::Context->dbh;
1376				my $request = qq\| SELECT categorycode,description
1377				FROM categories
1378				$action
1379				ORDER BY categorycode\|;
1380				my $sth = $dbh->prepare($request);
1381				if ($action) {
1382				$sth->execute($category_type);
1383				}
1384				else {
1385				$sth->execute();
1386				}
1387
1388				my %labels;
1389				my @codes;
1390
1391				while ( my $data = $sth->fetchrow_hashref ) {
1392				push @codes, $data->{'categorycode'};
1393				$labels{ $data->{'categorycode'} } = $data->{'description'};
1394				}
1395				$sth->finish;
1396				return ( \@codes, \%labels );
1397				}
1398
1399				=head2 GetBorrowercategory
1400
1401				$hashref = &GetBorrowercategory($categorycode);
1402
1403				Given the borrower's category code, the function returns the corresponding
1404				data hashref for a comprehensive information display.
1405
1406				$arrayref_hashref = &GetBorrowercategory;
1407				If no category code provided, the function returns all the categories.
1408
1409				=cut
1410
1411				sub GetBorrowercategory {
1412				my ($catcode) = @_;
1413				my $dbh = C4::Context->dbh;
1414				if ($catcode){
1415				my $sth =
1416				$dbh->prepare(
1417				"SELECT description,dateofbirthrequired,upperagelimit,category_type
1418				FROM categories
1419				WHERE categorycode = ?"
1420				);
1421				$sth->execute($catcode);
1422				my $data =
1423				$sth->fetchrow_hashref;
1424				$sth->finish();
1425				return $data;
1426				}
1427				return;
1428				} # sub getborrowercategory
1429
1430				=head2 GetBorrowercategoryList
1431
1432				$arrayref_hashref = &GetBorrowercategoryList;
1433				If no category code provided, the function returns all the categories.
1434
1435				=cut
1436
1437				sub GetBorrowercategoryList {
1438				my $dbh = C4::Context->dbh;
1439				my $sth =
1440				$dbh->prepare(
1441				"SELECT *
1442				FROM categories
1443				ORDER BY description"
1444				);
1445				$sth->execute;
1446				my $data =
1447				$sth->fetchall_arrayref({});
1448				$sth->finish();
1449				return $data;
1450				} # sub getborrowercategory
1451
1452				=head2 ethnicitycategories
1453
1454				($codes_arrayref, $labels_hashref) = &ethnicitycategories();
1455
1456				Looks up the different ethnic types in the database. Returns two
1457				elements: a reference-to-array, which lists the ethnicity codes, and a
1458				reference-to-hash, which maps the ethnicity codes to ethnicity
1459				descriptions.
1460
1461				=cut
1462
1463				#'
1464
1465				sub ethnicitycategories {
1466				my $dbh = C4::Context->dbh;
1467				my $sth = $dbh->prepare("Select code,name from ethnicity order by name");
1468				$sth->execute;
1469				my %labels;
1470				my @codes;
1471				while ( my $data = $sth->fetchrow_hashref ) {
1472				push @codes, $data->{'code'};
1473				$labels{ $data->{'code'} } = $data->{'name'};
1474				}
1475				$sth->finish;
1476				return ( \@codes, \%labels );
1477				}
1478
1479				=head2 fixEthnicity
1480
1481				$ethn_name = &fixEthnicity($ethn_code);
1482
1483				Takes an ethnicity code (e.g., "european" or "pi") and returns the
1484				corresponding descriptive name from the C<ethnicity> table in the
1485				Koha database ("European" or "Pacific Islander").
1486
1487				=cut
1488
1489				#'
1490
1491				sub fixEthnicity {
1492				my $ethnicity = shift;
1493				return unless $ethnicity;
1494				my $dbh = C4::Context->dbh;
1495				my $sth = $dbh->prepare("Select name from ethnicity where code = ?");
1496				$sth->execute($ethnicity);
1497				my $data = $sth->fetchrow_hashref;
1498				$sth->finish;
1499				return $data->{'name'};
1500				} # sub fixEthnicity
1501
1502				=head2 GetAge
1503
1504				$dateofbirth,$date = &GetAge($date);
1505
1506				this function return the borrowers age with the value of dateofbirth
1507
1508				=cut
1509
1510				#'
1511				sub GetAge{
1512				my ( $date, $date_ref ) = @_;
1513
1514				if ( not defined $date_ref ) {
1515				$date_ref = sprintf( '%04d-%02d-%02d', Today() );
1516				}
1517
1518				my ( $year1, $month1, $day1 ) = split /-/, $date;
1519				my ( $year2, $month2, $day2 ) = split /-/, $date_ref;
1520
1521				my $age = $year2 - $year1;
1522				if ( $month1 . $day1 > $month2 . $day2 ) {
1523				$age--;
1524				}
1525
1526				return $age;
1527				} # sub get_age
1528
1529				=head2 get_institutions
1530				$insitutions = get_institutions();
1531
1532				Just returns a list of all the borrowers of type I, borrownumber and name
1533
1534				=cut
1535
1536				#'
1537				sub get_institutions {
1538				my $dbh = C4::Context->dbh();
1539				my $sth =
1540				$dbh->prepare(
1541				"SELECT borrowernumber,surname FROM borrowers WHERE categorycode=? ORDER BY surname"
1542				);
1543				$sth->execute('I');
1544				my %orgs;
1545				while ( my $data = $sth->fetchrow_hashref() ) {
1546				$orgs{ $data->{'borrowernumber'} } = $data;
1547				}
1548				$sth->finish();
1549				return ( \%orgs );
1550
1551				} # sub get_institutions
1552
1553				=head2 add_member_orgs
1554
1555				add_member_orgs($borrowernumber,$borrowernumbers);
1556
1557				Takes a borrowernumber and a list of other borrowernumbers and inserts them into the borrowers_to_borrowers table
1558
1559				=cut
1560
1561				#'
1562				sub add_member_orgs {
1563				my ( $borrowernumber, $otherborrowers ) = @_;
1564				my $dbh = C4::Context->dbh();
1565				my $query =
1566				"INSERT INTO borrowers_to_borrowers (borrower1,borrower2) VALUES (?,?)";
1567				my $sth = $dbh->prepare($query);
1568				foreach my $otherborrowernumber (@$otherborrowers) {
1569				$sth->execute( $borrowernumber, $otherborrowernumber );
1570				}
1571				$sth->finish();
1572
1573				} # sub add_member_orgs
1574
1575				=head2 GetCities (OUEST-PROVENCE)
1576
1577				($id_cityarrayref, $city_hashref) = &GetCities();
1578
1579				Looks up the different city and zip in the database. Returns two
1580				elements: a reference-to-array, which lists the zip city
1581				codes, and a reference-to-hash, which maps the name of the city.
1582				WHERE =>OUEST PROVENCE OR EXTERIEUR
1583
1584				=cut
1585
1586				sub GetCities {
1587
1588				#my ($type_city) = @_;
1589				my $dbh = C4::Context->dbh;
1590				my $query = qq\|SELECT cityid,city_zipcode,city_name
1591				FROM cities
1592				ORDER BY city_name\|;
1593				my $sth = $dbh->prepare($query);
1594
1595				#$sth->execute($type_city);
1596				$sth->execute();
1597				my %city;
1598				my @id;
1599				# insert empty value to create a empty choice in cgi popup
1600				push @id, " ";
1601				$city{""} = "";
1602				while ( my $data = $sth->fetchrow_hashref ) {
1603				push @id, $data->{'city_zipcode'}."\|".$data->{'city_name'};
1604				$city{ $data->{'city_zipcode'}."\|".$data->{'city_name'} } = $data->{'city_name'};
1605				}
1606
1607				#test to know if the table contain some records if no the function return nothing
1608				my $id = @id;
1609				$sth->finish;
1610				if ( $id == 1 ) {
1611				# all we have is the one blank row
1612				return ();
1613				}
1614				else {
1615				unshift( @id, "" );
1616				return ( \@id, \%city );
1617				}
1618				}
1619
1620				=head2 GetSortDetails (OUEST-PROVENCE)
1621
1622				($lib) = &GetSortDetails($category,$sortvalue);
1623
1624				Returns the authorized value details
1625				C<&$lib>return value of authorized value details
1626				C<&$sortvalue>this is the value of authorized value
1627				C<&$category>this is the value of authorized value category
1628
1629				=cut
1630
1631				sub GetSortDetails {
1632				my ( $category, $sortvalue ) = @_;
1633				my $dbh = C4::Context->dbh;
1634				my $query = qq\|SELECT lib
1635				FROM authorised_values
1636				WHERE category=?
1637				AND authorised_value=? \|;
1638				my $sth = $dbh->prepare($query);
1639				$sth->execute( $category, $sortvalue );
1640				my $lib = $sth->fetchrow;
1641				return ($lib) if ($lib);
1642				return ($sortvalue) unless ($lib);
1643				}
1644
1645				=head2 MoveMemberToDeleted
1646
1647				$result = &MoveMemberToDeleted($borrowernumber);
1648
1649				Copy the record from borrowers to deletedborrowers table.
1650
1651				=cut
1652
1653				# FIXME: should do it in one SQL statement w/ subquery
1654				# Otherwise, we should return the @data on success
1655
1656				sub MoveMemberToDeleted {
1657				my ($member) = shift or return;
1658				my $dbh = C4::Context->dbh;
1659				my $query = qq\|SELECT *
1660				FROM borrowers
1661				WHERE borrowernumber=?\|;
1662				my $sth = $dbh->prepare($query);
1663				$sth->execute($member);
1664				my @data = $sth->fetchrow_array;
1665				(@data) or return; # if we got a bad borrowernumber, there's nothing to insert
1666				$sth =
1667				$dbh->prepare( "INSERT INTO deletedborrowers VALUES ("
1668				. ( "?," x ( scalar(@data) - 1 ) )
1669				. "?)" );
1670				$sth->execute(@data);
1671				}
1672
1673				=head2 DelMember
1674
1675				DelMember($borrowernumber);
1676
1677				This function remove directly a borrower whitout writing it on deleteborrower.
1678				+ Deletes reserves for the borrower
1679
1680				=cut
1681
1682				sub DelMember {
1683				my $dbh = C4::Context->dbh;
1684				my $borrowernumber = shift;
1685				#warn "in delmember with $borrowernumber";
1686				return unless $borrowernumber; # borrowernumber is mandatory.
1687
1688				my $query = qq\|DELETE
1689				FROM reserves
1690				WHERE borrowernumber=?\|;
1691				my $sth = $dbh->prepare($query);
1692				$sth->execute($borrowernumber);
1693				$sth->finish;
1694				$query = "
1695				DELETE
1696				FROM borrowers
1697				WHERE borrowernumber = ?
1698				";
1699				$sth = $dbh->prepare($query);
1700				$sth->execute($borrowernumber);
1701				$sth->finish;
1702				logaction("MEMBERS", "DELETE", $borrowernumber, "") if C4::Context->preference("BorrowersLog");
1703				return $sth->rows;
1704				}
1705
1706				=head2 ExtendMemberSubscriptionTo (OUEST-PROVENCE)
1707
1708				$date = ExtendMemberSubscriptionTo($borrowerid, $date);
1709
1710				Extending the subscription to a given date or to the expiry date calculated on ISO date.
1711				Returns ISO date.
1712
1713				=cut
1714
1715				sub ExtendMemberSubscriptionTo {
1716				my ( $borrowerid,$date) = @_;
1717				my $dbh = C4::Context->dbh;
1718				my $borrower = GetMember($borrowerid,'borrowernumber');
1719				unless ($date){
1720				$date=POSIX::strftime("%Y-%m-%d",localtime());
1721				my $borrower = GetMember($borrowerid,'borrowernumber');
1722				$date = GetExpiryDate( $borrower->{'categorycode'}, $date );
1723				}
1724				my $sth = $dbh->do(<<EOF);
1725				UPDATE borrowers
1726				SET dateexpiry='$date'
1727				WHERE borrowernumber='$borrowerid'
1728				EOF
1729				# add enrolmentfee if needed
1730				$sth = $dbh->prepare("SELECT enrolmentfee FROM categories WHERE categorycode=?");
1731				$sth->execute($borrower->{'categorycode'});
1732				my ($enrolmentfee) = $sth->fetchrow;
1733				if ($enrolmentfee && $enrolmentfee > 0) {
1734				# insert fee in patron debts
1735				manualinvoice($borrower->{'borrowernumber'}, '', '', 'A', $enrolmentfee);
1736				}
1737				return $date if ($sth);
1738				return 0;
1739				}
1740
1741				=head2 GetRoadTypes (OUEST-PROVENCE)
1742
1743				($idroadtypearrayref, $roadttype_hashref) = &GetRoadTypes();
1744
1745				Looks up the different road type . Returns two
1746				elements: a reference-to-array, which lists the id_roadtype
1747				codes, and a reference-to-hash, which maps the road type of the road .
1748
1749				=cut
1750
1751				sub GetRoadTypes {
1752				my $dbh = C4::Context->dbh;
1753				my $query = qq\|
1754				SELECT roadtypeid,road_type
1755				FROM roadtype
1756				ORDER BY road_type\|;
1757				my $sth = $dbh->prepare($query);
1758				$sth->execute();
1759				my %roadtype;
1760				my @id;
1761
1762				# insert empty value to create a empty choice in cgi popup
1763
1764				while ( my $data = $sth->fetchrow_hashref ) {
1765
1766				push @id, $data->{'roadtypeid'};
1767				$roadtype{ $data->{'roadtypeid'} } = $data->{'road_type'};
1768				}
1769
1770				#test to know if the table contain some records if no the function return nothing
1771				my $id = @id;
1772				$sth->finish;
1773				if ( $id eq 0 ) {
1774				return ();
1775				}
1776				else {
1777				unshift( @id, "" );
1778				return ( \@id, \%roadtype );
1779				}
1780				}
1781
1782
1783
1784				=head2 GetTitles (OUEST-PROVENCE)
1785
1786				($borrowertitle)= &GetTitles();
1787
1788				Looks up the different title . Returns array with all borrowers title
1789
1790				=cut
1791
1792				sub GetTitles {
1793				my @borrowerTitle = split /,\|\\|/,C4::Context->preference('BorrowersTitles');
1794				unshift( @borrowerTitle, "" );
1795				my $count=@borrowerTitle;
1796				if ($count == 1){
1797				return ();
1798				}
1799				else {
1800				return ( \@borrowerTitle);
1801				}
1802				}
1803
1804				=head2 GetPatronImage
1805
1806				my ($imagedata, $dberror) = GetPatronImage($cardnumber);
1807
1808				Returns the mimetype and binary image data of the image for the patron with the supplied cardnumber.
1809
1810				=cut
1811
1812				sub GetPatronImage {
1813				my ($cardnumber) = @_;
1814				warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1815				my $dbh = C4::Context->dbh;
1816				my $query = 'SELECT mimetype, imagefile FROM patronimage WHERE cardnumber = ?';
1817				my $sth = $dbh->prepare($query);
1818				$sth->execute($cardnumber);
1819				my $imagedata = $sth->fetchrow_hashref;
1820				warn "Database error!" if $sth->errstr;
1821				return $imagedata, $sth->errstr;
1822				}
1823
1824				=head2 PutPatronImage
1825
1826				PutPatronImage($cardnumber, $mimetype, $imgfile);
1827
1828				Stores patron binary image data and mimetype in database.
1829				NOTE: This function is good for updating images as well as inserting new images in the database.
1830
1831				=cut
1832
1833				sub PutPatronImage {
1834				my ($cardnumber, $mimetype, $imgfile) = @_;
1835				warn "Parameters passed in: Cardnumber=$cardnumber, Mimetype=$mimetype, " . ($imgfile ? "Imagefile" : "No Imagefile") if $debug;
1836				my $dbh = C4::Context->dbh;
1837				my $query = "INSERT INTO patronimage (cardnumber, mimetype, imagefile) VALUES (?,?,?) ON DUPLICATE KEY UPDATE imagefile = ?;";
1838				my $sth = $dbh->prepare($query);
1839				$sth->execute($cardnumber,$mimetype,$imgfile,$imgfile);
1840				warn "Error returned inserting $cardnumber.$mimetype." if $sth->errstr;
1841				return $sth->errstr;
1842				}
1843
1844				=head2 RmPatronImage
1845
1846				my ($dberror) = RmPatronImage($cardnumber);
1847
1848				Removes the image for the patron with the supplied cardnumber.
1849
1850				=cut
1851
1852				sub RmPatronImage {
1853				my ($cardnumber) = @_;
1854				warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1855				my $dbh = C4::Context->dbh;
1856				my $query = "DELETE FROM patronimage WHERE cardnumber = ?;";
1857				my $sth = $dbh->prepare($query);
1858				$sth->execute($cardnumber);
1859				my $dberror = $sth->errstr;
1860				warn "Database error!" if $sth->errstr;
1861				return $dberror;
1862				}
1863
1864				=head2 GetRoadTypeDetails (OUEST-PROVENCE)
1865
1866				($roadtype) = &GetRoadTypeDetails($roadtypeid);
1867
1868				Returns the description of roadtype
1869				C<&$roadtype>return description of road type
1870				C<&$roadtypeid>this is the value of roadtype s
1871
1872				=cut
1873
1874				sub GetRoadTypeDetails {
1875				my ($roadtypeid) = @_;
1876				my $dbh = C4::Context->dbh;
1877				my $query = qq\|
1878				SELECT road_type
1879				FROM roadtype
1880				WHERE roadtypeid=?\|;
1881				my $sth = $dbh->prepare($query);
1882				$sth->execute($roadtypeid);
1883				my $roadtype = $sth->fetchrow;
1884				return ($roadtype);
1885				}
1886
1887				=head2 GetBorrowersWhoHaveNotBorrowedSince
1888
1889				&GetBorrowersWhoHaveNotBorrowedSince($date)
1890
1891				this function get all borrowers who haven't borrowed since the date given on input arg.
1892
1893				=cut
1894
1895				sub GetBorrowersWhoHaveNotBorrowedSince {
1896				### TODO : It could be dangerous to delete Borrowers who have just been entered and who have not yet borrowed any book. May be good to add a dateexpiry or dateenrolled filter.
1897
1898				my $filterdate = shift\|\|POSIX::strftime("%Y-%m-%d",localtime());
1899				my $filterbranch = shift \|\|
1900				((C4::Context->preference('IndependantBranches')
1901				&& C4::Context->userenv
1902				&& C4::Context->userenv->{flags} % 2 !=1
1903				&& C4::Context->userenv->{branch})
1904				? C4::Context->userenv->{branch}
1905				: "");
1906				my $dbh = C4::Context->dbh;
1907				my $query = "
1908				SELECT borrowers.borrowernumber,max(issues.timestamp) as latestissue
1909				FROM borrowers
1910				JOIN categories USING (categorycode)
1911				LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
1912				WHERE category_type <> 'S'
1913				";
1914				my @query_params;
1915				if ($filterbranch && $filterbranch ne ""){
1916				$query.=" AND borrowers.branchcode= ?";
1917				push @query_params,$filterbranch;
1918				}
1919				$query.=" GROUP BY borrowers.borrowernumber";
1920				if ($filterdate){
1921				$query.=" HAVING latestissue <? OR latestissue IS NULL";
1922				push @query_params,$filterdate;
1923				}
1924				warn $query if $debug;
1925				my $sth = $dbh->prepare($query);
1926				if (scalar(@query_params)>0){
1927				$sth->execute(@query_params);
1928				}
1929				else {
1930				$sth->execute;
1931				}
1932
1933				my @results;
1934				while ( my $data = $sth->fetchrow_hashref ) {
1935				push @results, $data;
1936				}
1937				return \@results;
1938				}
1939
1940				=head2 GetBorrowersWhoHaveNeverBorrowed
1941
1942				$results = &GetBorrowersWhoHaveNeverBorrowed
1943
1944				this function get all borrowers who have never borrowed.
1945
1946				I<$result> is a ref to an array which all elements are a hasref.
1947
1948				=cut
1949
1950				sub GetBorrowersWhoHaveNeverBorrowed {
1951				my $filterbranch = shift \|\|
1952				((C4::Context->preference('IndependantBranches')
1953				&& C4::Context->userenv
1954				&& C4::Context->userenv->{flags} % 2 !=1
1955				&& C4::Context->userenv->{branch})
1956				? C4::Context->userenv->{branch}
1957				: "");
1958				my $dbh = C4::Context->dbh;
1959				my $query = "
1960				SELECT borrowers.borrowernumber,max(timestamp) as latestissue
1961				FROM borrowers
1962				LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
1963				WHERE issues.borrowernumber IS NULL
1964				";
1965				my @query_params;
1966				if ($filterbranch && $filterbranch ne ""){
1967				$query.=" AND borrowers.branchcode= ?";
1968				push @query_params,$filterbranch;
1969				}
1970				warn $query if $debug;
1971
1972				my $sth = $dbh->prepare($query);
1973				if (scalar(@query_params)>0){
1974				$sth->execute(@query_params);
1975				}
1976				else {
1977				$sth->execute;
1978				}
1979
1980				my @results;
1981				while ( my $data = $sth->fetchrow_hashref ) {
1982				push @results, $data;
1983				}
1984				return \@results;
1985				}
1986
1987				=head2 GetBorrowersWithIssuesHistoryOlderThan
1988
1989				$results = &GetBorrowersWithIssuesHistoryOlderThan($date)
1990
1991				this function get all borrowers who has an issue history older than I<$date> given on input arg.
1992
1993				I<$result> is a ref to an array which all elements are a hashref.
1994				This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
1995
1996				=cut
1997
1998				sub GetBorrowersWithIssuesHistoryOlderThan {
1999				my $dbh = C4::Context->dbh;
2000				my $date = shift \|\|POSIX::strftime("%Y-%m-%d",localtime());
2001				my $filterbranch = shift \|\|
2002				((C4::Context->preference('IndependantBranches')
2003				&& C4::Context->userenv
2004				&& C4::Context->userenv->{flags} % 2 !=1
2005				&& C4::Context->userenv->{branch})
2006				? C4::Context->userenv->{branch}
2007				: "");
2008				my $query = "
2009				SELECT count(borrowernumber) as n,borrowernumber
2010				FROM old_issues
2011				WHERE returndate < ?
2012				AND borrowernumber IS NOT NULL
2013				";
2014				my @query_params;
2015				push @query_params, $date;
2016				if ($filterbranch){
2017				$query.=" AND branchcode = ?";
2018				push @query_params, $filterbranch;
2019				}
2020				$query.=" GROUP BY borrowernumber ";
2021				warn $query if $debug;
2022				my $sth = $dbh->prepare($query);
2023				$sth->execute(@query_params);
2024				my @results;
2025
2026				while ( my $data = $sth->fetchrow_hashref ) {
2027				push @results, $data;
2028				}
2029				return \@results;
2030				}
2031
2032				=head2 GetBorrowersNamesAndLatestIssue
2033
2034				$results = &GetBorrowersNamesAndLatestIssueList(@borrowernumbers)
2035
2036				this function get borrowers Names and surnames and Issue information.
2037
2038				I<@borrowernumbers> is an array which all elements are borrowernumbers.
2039				This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
2040
2041				=cut
2042
2043				sub GetBorrowersNamesAndLatestIssue {
2044				my $dbh = C4::Context->dbh;
2045				my @borrowernumbers=@_;
2046				my $query = "
2047				SELECT surname,lastname, phone, email,max(timestamp)
2048				FROM borrowers
2049				LEFT JOIN issues ON borrowers.borrowernumber=issues.borrowernumber
2050				GROUP BY borrowernumber
2051				";
2052				my $sth = $dbh->prepare($query);
2053				$sth->execute;
2054				my $results = $sth->fetchall_arrayref({});
2055				return $results;
2056				}
2057
2058				=head2 DebarMember
2059
2060				=over 4
2061
2062				my $success = DebarMember( $borrowernumber );
2063
2064				marks a Member as debarred, and therefore unable to checkout any more
2065				items.
2066
2067				return :
2068				true on success, false on failure
2069
2070				=back
2071
2072				=cut
2073
2074				sub DebarMember {
2075				my $borrowernumber = shift;
2076
2077				return unless defined $borrowernumber;
2078				return unless $borrowernumber =~ /^\d+$/;
2079
2080				return ModMember( borrowernumber => $borrowernumber,
2081				debarred => 1 );
2082
2083				}
2084
2085	1	300ns	300ns	END { } # module clean-up code here (global destructor)
2086
2087	1	7µs	7µs	1;
2088
2089				__END__
2090
2091				=head1 AUTHOR
2092
2093				Koha Team
2094
2095				=cut