Profile: C4/Members.pm

File	C4/Members.pm
Statements Executed	14
Total Time	0.000221 seconds

Subroutines — ordered by inclusive time then name
Calls	Inclusive Time	Subroutine
1	0.00044	C4::Members::	GetMember
0	0	C4::Members::	AddMember
0	0	C4::Members::	BEGIN
0	0	C4::Members::	Check_Userid
0	0	C4::Members::	DebarMember
0	0	C4::Members::	DelMember
0	0	C4::Members::	END
0	0	C4::Members::	ExtendMemberSubscriptionTo
0	0	C4::Members::	GetAge
0	0	C4::Members::	GetAllIssues
0	0	C4::Members::	GetBorNotifyAcctRecord
0	0	C4::Members::	GetBorrowercategory
0	0	C4::Members::	GetBorrowercategoryList
0	0	C4::Members::	GetBorrowersNamesAndLatestIssue
0	0	C4::Members::	GetBorrowersWhoHaveNeverBorrowed
0	0	C4::Members::	GetBorrowersWhoHaveNotBorrowedSince
0	0	C4::Members::	GetBorrowersWithIssuesHistoryOlderThan
0	0	C4::Members::	GetCities
0	0	C4::Members::	GetExpiryDate
0	0	C4::Members::	GetGuarantees
0	0	C4::Members::	GetMemberAccountRecords
0	0	C4::Members::	GetMemberDetails
0	0	C4::Members::	GetMemberIssuesAndFines
0	0	C4::Members::	GetPatronImage
0	0	C4::Members::	GetPendingIssues
0	0	C4::Members::	GetRoadTypeDetails
0	0	C4::Members::	GetRoadTypes
0	0	C4::Members::	GetSortDetails
0	0	C4::Members::	GetTitles
0	0	C4::Members::	GetborCatFromCatType
0	0	C4::Members::	ModMember
0	0	C4::Members::	MoveMemberToDeleted
0	0	C4::Members::	PutPatronImage
0	0	C4::Members::	RmPatronImage
0	0	C4::Members::	SearchMember
0	0	C4::Members::	UpdateGuarantees
0	0	C4::Members::	add_member_orgs
0	0	C4::Members::	changepassword
0	0	C4::Members::	checkcardnumber
0	0	C4::Members::	checkuniquemember
0	0	C4::Members::	checkuserpassword
0	0	C4::Members::	ethnicitycategories
0	0	C4::Members::	fixEthnicity
0	0	C4::Members::	fixup_cardnumber
0	0	C4::Members::	get_institutions
0	0	C4::Members::	getidcity
0	0	C4::Members::	getzipnamecity
0	0	C4::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				use strict;
22				use C4::Context;
23				use C4::Dates qw(format_date_in_iso);
24				use Digest::MD5 qw(md5_base64);
25				use Date::Calc qw/Today Add_Delta_YM/;
26				use C4::Log; # logaction
27				use C4::Overdues;
28				use C4::Reserves;
29				use C4::Accounts;
30
31				our ($VERSION,@ISA,@EXPORT,@EXPORT_OK,$debug);
32
33				BEGIN {
34				$VERSION = 3.02;
35				$debug = $ENV{DEBUG} \|\| 0;
36				require Exporter;
37				@ISA = qw(Exporter);
38				#Get data
39				push @EXPORT, qw(
40				&SearchMember
41				&GetMemberDetails
42				&GetMember
43
44				&GetGuarantees
45
46				&GetMemberIssuesAndFines
47				&GetPendingIssues
48				&GetAllIssues
49
50				&get_institutions
51				&getzipnamecity
52				&getidcity
53
54				&GetAge
55				&GetCities
56				&GetRoadTypes
57				&GetRoadTypeDetails
58				&GetSortDetails
59				&GetTitles
60
61				&GetPatronImage
62				&PutPatronImage
63				&RmPatronImage
64
65				&GetMemberAccountRecords
66				&GetBorNotifyAcctRecord
67
68				&GetborCatFromCatType
69				&GetBorrowercategory
70				&GetBorrowercategoryList
71
72				&GetBorrowersWhoHaveNotBorrowedSince
73				&GetBorrowersWhoHaveNeverBorrowed
74				&GetBorrowersWithIssuesHistoryOlderThan
75
76				&GetExpiryDate
77				);
78
79				#Modify data
80				push @EXPORT, qw(
81				&ModMember
82				&changepassword
83				);
84
85				#Delete data
86				push @EXPORT, qw(
87				&DelMember
88				);
89
90				#Insert data
91				push @EXPORT, qw(
92				&AddMember
93				&add_member_orgs
94				&MoveMemberToDeleted
95				&ExtendMemberSubscriptionTo
96				);
97
98				#Check data
99				push @EXPORT, qw(
100				&checkuniquemember
101				&checkuserpassword
102				&Check_Userid
103				&fixEthnicity
104				&ethnicitycategories
105				&fixup_cardnumber
106				&checkcardnumber
107				);
108				}
109
110				=head1 NAME
111
112				C4::Members - Perl Module containing convenience functions for member handling
113
114				=head1 SYNOPSIS
115
116				use C4::Members;
117
118				=head1 DESCRIPTION
119
120				This module contains routines for adding, modifying and deleting members/patrons/borrowers
121
122				=head1 FUNCTIONS
123
124				=over 2
125
126				=item SearchMember
127
128				($count, $borrowers) = &SearchMember($searchstring, $type,$category_type,$filter,$showallbranches);
129
130				=back
131
132				Looks up patrons (borrowers) by name.
133
134				BUGFIX 499: C<$type> is now used to determine type of search.
135				if $type is "simple", search is performed on the first letter of the
136				surname only.
137
138				$category_type is used to get a specified type of user.
139				(mainly adults when creating a child.)
140
141				C<$searchstring> is a space-separated list of search terms. Each term
142				must match the beginning a borrower's surname, first name, or other
143				name.
144
145				C<$filter> is assumed to be a list of elements to filter results on
146
147				C<$showallbranches> is used in IndependantBranches Context to display all branches results.
148
149				C<&SearchMember> returns a two-element list. C<$borrowers> is a
150				reference-to-array; each element is a reference-to-hash, whose keys
151				are the fields of the C<borrowers> table in the Koha database.
152				C<$count> is the number of elements in C<$borrowers>.
153
154				=cut
155
156				#'
157				#used by member enquiries from the intranet
158				#called by member.pl and circ/circulation.pl
159				sub SearchMember {
160				my ($searchstring, $orderby, $type,$category_type,$filter,$showallbranches ) = @_;
161				my $dbh = C4::Context->dbh;
162				my $query = "";
163				my $count;
164				my @data;
165				my @bind = ();
166
167				# this is used by circulation everytime a new borrowers cardnumber is scanned
168				# so we can check an exact match first, if that works return, otherwise do the rest
169				$query = "SELECT * FROM borrowers
170				LEFT JOIN categories ON borrowers.categorycode=categories.categorycode
171				";
172				my $sth = $dbh->prepare("$query WHERE cardnumber = ?");
173				$sth->execute($searchstring);
174				my $data = $sth->fetchall_arrayref({});
175				if (@$data){
176				return ( scalar(@$data), $data );
177				}
178				$sth->finish;
179
180				if ( $type eq "simple" ) # simple search for one letter only
181				{
182				$query .= ($category_type ? " AND category_type = ".$dbh->quote($category_type) : "");
183				$query .= " WHERE (surname LIKE ? OR cardnumber like ?) ";
184				if (C4::Context->preference("IndependantBranches") && !$showallbranches){
185				if (C4::Context->userenv && C4::Context->userenv->{flags}!=1 && C4::Context->userenv->{'branch'}){
186				$query.=" AND borrowers.branchcode =".$dbh->quote(C4::Context->userenv->{'branch'}) unless (C4::Context->userenv->{'branch'} eq "insecure");
187				}
188				}
189				$query.=" ORDER BY $orderby";
190				@bind = ("$searchstring%","$searchstring");
191				}
192				else # advanced search looking in surname, firstname and othernames
193				{
194				@data = split( ' ', $searchstring );
195				$count = @data;
196				$query .= " WHERE ";
197				if (C4::Context->preference("IndependantBranches") && !$showallbranches){
198				if (C4::Context->userenv && C4::Context->userenv->{flags}!=1 && C4::Context->userenv->{'branch'}){
199				$query.=" borrowers.branchcode =".$dbh->quote(C4::Context->userenv->{'branch'})." AND " unless (C4::Context->userenv->{'branch'} eq "insecure");
200				}
201				}
202				$query.="((surname LIKE ? OR surname LIKE ?
203				OR firstname LIKE ? OR firstname LIKE ?
204				OR othernames LIKE ? OR othernames LIKE ?)
205				" .
206				($category_type?" AND category_type = ".$dbh->quote($category_type):"");
207				@bind = (
208				"$data[0]%", "% $data[0]%", "$data[0]%", "% $data[0]%",
209				"$data[0]%", "% $data[0]%"
210				);
211				for ( my $i = 1 ; $i < $count ; $i++ ) {
212				$query = $query . " AND (" . " surname LIKE ? OR surname LIKE ?
213				OR firstname LIKE ? OR firstname LIKE ?
214				OR othernames LIKE ? OR othernames LIKE ?)";
215				push( @bind,
216				"$data[$i]%", "% $data[$i]%", "$data[$i]%",
217				"% $data[$i]%", "$data[$i]%", "% $data[$i]%" );
218
219				# FIXME - .= <<EOT;
220				}
221				$query = $query . ") OR cardnumber LIKE ? ";
222				push( @bind, $searchstring );
223				if (C4::Context->preference('ExtendedPatronAttributes')) {
224				$query .= "OR borrowernumber IN (
225				SELECT borrowernumber
226				FROM borrower_attributes
227				JOIN borrower_attribute_types USING (code)
228				WHERE staff_searchable = 1
229				AND attribute like ?
230				)";
231				push (@bind, $searchstring);
232				}
233				$query .= "order by $orderby";
234
235				# FIXME - .= <<EOT;
236				}
237
238				$sth = $dbh->prepare($query);
239
240				$debug and print STDERR "Q $orderby : $query\n";
241				$sth->execute(@bind);
242				my @results;
243				$data = $sth->fetchall_arrayref({});
244
245				$sth->finish;
246				return ( scalar(@$data), $data );
247				}
248
249				=head2 GetMemberDetails
250
251				($borrower) = &GetMemberDetails($borrowernumber, $cardnumber);
252
253				Looks up a patron and returns information about him or her. If
254				C<$borrowernumber> is true (nonzero), C<&GetMemberDetails> looks
255				up the borrower by number; otherwise, it looks up the borrower by card
256				number.
257
258				C<$borrower> is a reference-to-hash whose keys are the fields of the
259				borrowers table in the Koha database. In addition,
260				C<$borrower-E<gt>{flags}> is a hash giving more detailed information
261				about the patron. Its keys act as flags :
262
263				if $borrower->{flags}->{LOST} {
264				# Patron's card was reported lost
265				}
266
267				Each flag has a C<message> key, giving a human-readable explanation of
268				the flag. If the state of a flag means that the patron should not be
269				allowed to borrow any more books, then it will have a C<noissues> key
270				with a true value.
271
272				The possible flags are:
273
274				=head3 CHARGES
275
276				=over 4
277
278				=item Shows the patron's credit or debt, if any.
279
280				=back
281
282				=head3 GNA
283
284				=over 4
285
286				=item (Gone, no address.) Set if the patron has left without giving a
287				forwarding address.
288
289				=back
290
291				=head3 LOST
292
293				=over 4
294
295				=item Set if the patron's card has been reported as lost.
296
297				=back
298
299				=head3 DBARRED
300
301				=over 4
302
303				=item Set if the patron has been debarred.
304
305				=back
306
307				=head3 NOTES
308
309				=over 4
310
311				=item Any additional notes about the patron.
312
313				=back
314
315				=head3 ODUES
316
317				=over 4
318
319				=item Set if the patron has overdue items. This flag has several keys:
320
321				C<$flags-E<gt>{ODUES}{itemlist}> is a reference-to-array listing the
322				overdue items. Its elements are references-to-hash, each describing an
323				overdue item. The keys are selected fields from the issues, biblio,
324				biblioitems, and items tables of the Koha database.
325
326				C<$flags-E<gt>{ODUES}{itemlist}> is a string giving a text listing of
327				the overdue items, one per line.
328
329				=back
330
331				=head3 WAITING
332
333				=over 4
334
335				=item Set if any items that the patron has reserved are available.
336
337				C<$flags-E<gt>{WAITING}{itemlist}> is a reference-to-array listing the
338				available items. Each element is a reference-to-hash whose keys are
339				fields from the reserves table of the Koha database.
340
341				=back
342
343				C<$borrower-E<gt>{authflags}> is a hash giving more detailed information
344				about the top-level permissions flags set for the borrower. For example,
345				if a user has the "editcatalogue" permission,
346				C<$borrower-E<gt>{authflags}-E<gt>{editcatalogue}> will exist and have
347				the value "1".
348
349				=cut
350
351				sub GetMemberDetails {
352				my ( $borrowernumber, $cardnumber ) = @_;
353				my $dbh = C4::Context->dbh;
354				my $query;
355				my $sth;
356				if ($borrowernumber) {
357				$sth = $dbh->prepare("select borrowers.*,category_type from borrowers left join categories on borrowers.categorycode=categories.categorycode where borrowernumber=?");
358				$sth->execute($borrowernumber);
359				}
360				elsif ($cardnumber) {
361				$sth = $dbh->prepare("select borrowers.*,category_type from borrowers left join categories on borrowers.categorycode=categories.categorycode where cardnumber=?");
362				$sth->execute($cardnumber);
363				}
364				else {
365				return undef;
366				}
367				my $borrower = $sth->fetchrow_hashref;
368				my ($amount) = GetMemberAccountRecords( $borrowernumber);
369				$borrower->{'amountoutstanding'} = $amount;
370				# FIXME - patronflags calls GetMemberAccountRecords... just have patronflags return $amount
371				my $flags = patronflags( $borrower);
372				my $accessflagshash;
373
374				$sth = $dbh->prepare("select bit,flag from userflags");
375				$sth->execute;
376				while ( my ( $bit, $flag ) = $sth->fetchrow ) {
377				if ( $borrower->{'flags'} && $borrower->{'flags'} & 2**$bit ) {
378				$accessflagshash->{$flag} = 1;
379				}
380				}
381				$sth->finish;
382				$borrower->{'flags'} = $flags;
383				$borrower->{'authflags'} = $accessflagshash;
384
385				# find out how long the membership lasts
386				$sth =
387				$dbh->prepare(
388				"select enrolmentperiod from categories where categorycode = ?");
389				$sth->execute( $borrower->{'categorycode'} );
390				my $enrolment = $sth->fetchrow;
391				$borrower->{'enrolmentperiod'} = $enrolment;
392				return ($borrower); #, $flags, $accessflagshash);
393				}
394
395				=head2 patronflags
396
397				Not exported
398
399				NOTE!: If you change this function, be sure to update the POD for
400				&GetMemberDetails.
401
402				$flags = &patronflags($patron);
403
404				$flags->{CHARGES}
405				{message} Message showing patron's credit or debt
406				{noissues} Set if patron owes >$5.00
407				{GNA} Set if patron gone w/o address
408				{message} "Borrower has no valid address"
409				{noissues} Set.
410				{LOST} Set if patron's card reported lost
411				{message} Message to this effect
412				{noissues} Set.
413				{DBARRED} Set is patron is debarred
414				{message} Message to this effect
415				{noissues} Set.
416				{NOTES} Set if patron has notes
417				{message} Notes about patron
418				{ODUES} Set if patron has overdue books
419				{message} "Yes"
420				{itemlist} ref-to-array: list of overdue books
421				{itemlisttext} Text list of overdue items
422				{WAITING} Set if there are items available that the
423				patron reserved
424				{message} Message to this effect
425				{itemlist} ref-to-array: list of available items
426
427				=cut
428				# FIXME rename this function.
429				sub patronflags {
430				my %flags;
431				my ( $patroninformation) = @_;
432				my $dbh=C4::Context->dbh;
433				my ($amount) = GetMemberAccountRecords( $patroninformation->{'borrowernumber'});
434				if ( $amount > 0 ) {
435				my %flaginfo;
436				my $noissuescharge = C4::Context->preference("noissuescharge");
437				$flaginfo{'message'} = sprintf "Patron owes \$%.02f", $amount;
438				$flaginfo{'amount'} = sprintf "%.02f",$amount;
439				if ( $amount > $noissuescharge ) {
440				$flaginfo{'noissues'} = 1;
441				}
442				$flags{'CHARGES'} = \%flaginfo;
443				}
444				elsif ( $amount < 0 ) {
445				my %flaginfo;
446				$flaginfo{'message'} = sprintf "Patron has credit of \$%.02f", -$amount;
447				$flags{'CREDITS'} = \%flaginfo;
448				}
449				if ( $patroninformation->{'gonenoaddress'}
450				&& $patroninformation->{'gonenoaddress'} == 1 )
451				{
452				my %flaginfo;
453				$flaginfo{'message'} = 'Borrower has no valid address.';
454				$flaginfo{'noissues'} = 1;
455				$flags{'GNA'} = \%flaginfo;
456				}
457				if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
458				my %flaginfo;
459				$flaginfo{'message'} = 'Borrower\'s card reported lost.';
460				$flaginfo{'noissues'} = 1;
461				$flags{'LOST'} = \%flaginfo;
462				}
463				if ( $patroninformation->{'debarred'}
464				&& $patroninformation->{'debarred'} == 1 )
465				{
466				my %flaginfo;
467				$flaginfo{'message'} = 'Borrower is Debarred.';
468				$flaginfo{'noissues'} = 1;
469				$flags{'DBARRED'} = \%flaginfo;
470				}
471				if ( $patroninformation->{'borrowernotes'}
472				&& $patroninformation->{'borrowernotes'} )
473				{
474				my %flaginfo;
475				$flaginfo{'message'} = "$patroninformation->{'borrowernotes'}";
476				$flags{'NOTES'} = \%flaginfo;
477				}
478				my ( $odues, $itemsoverdue ) =
479				checkoverdues( $patroninformation->{'borrowernumber'}, $dbh );
480				if ( $odues > 0 ) {
481				my %flaginfo;
482				$flaginfo{'message'} = "Yes";
483				$flaginfo{'itemlist'} = $itemsoverdue;
484				foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
485				@$itemsoverdue )
486				{
487				$flaginfo{'itemlisttext'} .=
488				"$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n";
489				}
490				$flags{'ODUES'} = \%flaginfo;
491				}
492				my @itemswaiting = C4::Reserves::GetReservesFromBorrowernumber( $patroninformation->{'borrowernumber'},'W' );
493				my $nowaiting = scalar @itemswaiting;
494				if ( $nowaiting > 0 ) {
495				my %flaginfo;
496				$flaginfo{'message'} = "Reserved items available";
497				$flaginfo{'itemlist'} = \@itemswaiting;
498				$flags{'WAITING'} = \%flaginfo;
499				}
500				return ( \%flags );
501				}
502
503
504				=head2 GetMember
505
506				$borrower = &GetMember($information, $type);
507
508				Looks up information about a patron (borrower) by either card number
509				,firstname, or borrower number, depending on $type value.
510				If C<$type> == 'cardnumber', C<&GetBorrower>
511				searches by cardnumber then by firstname if not found in cardnumber;
512				otherwise, it searches by borrowernumber.
513
514				C<&GetBorrower> returns a reference-to-hash whose keys are the fields of
515				the C<borrowers> table in the Koha database.
516
517				=cut
518
519				#'
520				# spent 0.00044s within C4::Members::GetMember which was called: # 1 times (0.00044s) at line 43 of opac/opac-main.pl sub GetMember {
521	1	1e-06	1e-06	my ( $information, $type ) = @_;
522	1	8e-06	8e-06	my $dbh = C4::Context->dbh; # spent 0.00015s making 1 calls to C4::Context::dbh
523	1	0	0	my $sth;
524	1	1e-06	1e-06	my $select = "
525				SELECT borrowers.*, categories.category_type, categories.description
526				FROM borrowers
527				LEFT JOIN categories on borrowers.categorycode=categories.categorycode
528				";
529	1	2e-06	2e-06	if ( defined $type && ( $type eq 'cardnumber' \|\| $type eq 'firstname'\|\| $type eq 'userid'\|\| $type eq 'borrowernumber' ) ){
530	1	1e-06	1e-06	$information = uc $information;
531	1	0.00001	0.00001	$sth = $dbh->prepare("$select WHERE $type=?"); # spent 0.00006s making 1 calls to DBI::db::prepare
532				} else {
533				$sth = $dbh->prepare("$select WHERE borrowernumber=?");
534				}
535	1	0.00011	0.00011	$sth->execute($information); # spent 0.00011s making 1 calls to DBI::st::execute
536	1	0.00006	0.00006	my $data = $sth->fetchrow_hashref; # spent 0.00006s making 1 calls to DBI::st::fetchrow_hashref # spent 0.00003s making 1 calls to DBI::common::FETCH # spent 0.00001s making 1 calls to DBI::st::fetch
537	1	0.00001	0.00001	$sth->finish; # spent 0.00001s making 1 calls to DBI::st::finish
538	1	1e-06	1e-06	($data) and return ($data);
539
540	1	1e-06	1e-06	if ($type eq 'cardnumber' \|\| $type eq 'firstname') { # otherwise, try with firstname
541				$sth = $dbh->prepare("$select WHERE firstname like ?");
542				$sth->execute($information);
543				$data = $sth->fetchrow_hashref;
544				$sth->finish;
545				($data) and return ($data);
546				}
547	1	0.00002	0.00002	return undef;
548				}
549
550				=head2 GetMemberIssuesAndFines
551
552				($overdue_count, $issue_count, $total_fines) = &GetMemberIssuesAndFines($borrowernumber);
553
554				Returns aggregate data about items borrowed by the patron with the
555				given borrowernumber.
556
557				C<&GetMemberIssuesAndFines> returns a three-element array. C<$overdue_count> is the
558				number of overdue items the patron currently has borrowed. C<$issue_count> is the
559				number of books the patron currently has borrowed. C<$total_fines> is
560				the total fine currently due by the borrower.
561
562				=cut
563
564				#'
565				sub GetMemberIssuesAndFines {
566				my ( $borrowernumber ) = @_;
567				my $dbh = C4::Context->dbh;
568				my $query = "SELECT COUNT(*) FROM issues WHERE borrowernumber = ?";
569
570				$debug and warn $query."\n";
571				my $sth = $dbh->prepare($query);
572				$sth->execute($borrowernumber);
573				my $issue_count = $sth->fetchrow_arrayref->[0];
574				$sth->finish;
575
576				$sth = $dbh->prepare(
577				"SELECT COUNT(*) FROM issues
578				WHERE borrowernumber = ?
579				AND date_due < now()"
580				);
581				$sth->execute($borrowernumber);
582				my $overdue_count = $sth->fetchrow_arrayref->[0];
583				$sth->finish;
584
585				$sth = $dbh->prepare("SELECT SUM(amountoutstanding) FROM accountlines WHERE borrowernumber = ?");
586				$sth->execute($borrowernumber);
587				my $total_fines = $sth->fetchrow_arrayref->[0];
588				$sth->finish;
589
590				return ($overdue_count, $issue_count, $total_fines);
591				}
592
593				=head2
594
595				=head2 ModMember
596
597				=over 4
598
599				my $success = ModMember(borrowernumber => $borrowernumber, [ field => value ]... );
600
601				Modify borrower's data. All date fields should ALREADY be in ISO format.
602
603				return :
604				true on success, or false on failure
605
606				=back
607
608				=cut
609
610				#'
611				sub ModMember {
612				my (%data) = @_;
613				my $dbh = C4::Context->dbh;
614				my $iso_re = C4::Dates->new()->regexp('iso');
615				foreach (qw(dateofbirth dateexpiry dateenrolled)) {
616				if (my $tempdate = $data{$_}) { # assignment, not comparison
617				($tempdate =~ /$iso_re/) and next; # Congatulations, you sent a valid ISO date.
618				warn "ModMember given $_ not in ISO format ($tempdate)";
619				if (my $tempdate2 = format_date_in_iso($tempdate)) { # assignment, not comparison
620				$data{$_} = $tempdate2;
621				} else {
622				warn "ModMember cannot convert '$tempdate' (from syspref)";
623				}
624				}
625				}
626				if (!$data{'dateofbirth'}){
627				delete $data{'dateofbirth'};
628				}
629				my $qborrower=$dbh->prepare("SHOW columns from borrowers");
630				$qborrower->execute;
631				my %hashborrowerfields;
632				while (my ($field)=$qborrower->fetchrow){
633				$hashborrowerfields{$field}=1;
634				}
635				my $query = "UPDATE borrowers SET \n";
636				my $sth;
637				my @parameters;
638
639				# test to know if you must update or not the borrower password
640				if ( exists $data{'password'} ) {
641				if ( $data{'password'} eq '****' ) {
642				delete $data{'password'};
643				} else {
644				$data{'password'} = md5_base64( $data{'password'} ) if ( $data{'password'} ne "" );
645				delete $data{'password'} if ( $data{password} eq "" );
646				}
647				}
648				foreach (keys %data){
649				if ($_ ne 'borrowernumber' and $_ ne 'flags' and $hashborrowerfields{$_}){
650				$query .= " $_=?, ";
651				push @parameters,$data{$_};
652				}
653				}
654				$query =~ s/, $//;
655				$query .= " WHERE borrowernumber=?";
656				push @parameters, $data{'borrowernumber'};
657				$debug and print STDERR "$query (executed w/ arg: $data{'borrowernumber'})";
658				$sth = $dbh->prepare($query);
659				my $execute_success = $sth->execute(@parameters);
660				$sth->finish;
661
662				# ok if its an adult (type) it may have borrowers that depend on it as a guarantor
663				# so when we update information for an adult we should check for guarantees and update the relevant part
664				# of their records, ie addresses and phone numbers
665				my $borrowercategory= GetBorrowercategory( $data{'category_type'} );
666				if ( exists $borrowercategory->{'category_type'} && $borrowercategory->{'category_type'} eq ('A' \|\| 'S') ) {
667				# is adult check guarantees;
668				UpdateGuarantees(%data);
669				}
670				logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "$query (executed w/ arg: $data{'borrowernumber'})")
671				if C4::Context->preference("BorrowersLog");
672
673				return $execute_success;
674				}
675
676
677				=head2
678
679				=head2 AddMember
680
681				$borrowernumber = &AddMember(%borrower);
682
683				insert new borrower into table
684				Returns the borrowernumber
685
686				=cut
687
688				#'
689				sub AddMember {
690				my (%data) = @_;
691				my $dbh = C4::Context->dbh;
692				$data{'userid'} = '' unless $data{'password'};
693				$data{'password'} = md5_base64( $data{'password'} ) if $data{'password'};
694
695				# WE SHOULD NEVER PASS THIS SUBROUTINE ANYTHING OTHER THAN ISO DATES
696				# IF YOU UNCOMMENT THESE LINES YOU BETTER HAVE A DARN COMPELLING REASON
697				# $data{'dateofbirth'} = format_date_in_iso( $data{'dateofbirth'} );
698				# $data{'dateenrolled'} = format_date_in_iso( $data{'dateenrolled'});
699				# $data{'dateexpiry'} = format_date_in_iso( $data{'dateexpiry'} );
700				# This query should be rewritten to use "?" at execute.
701				if (!$data{'dateofbirth'}){
702				undef ($data{'dateofbirth'});
703				}
704				my $query =
705				"insert into borrowers set cardnumber=" . $dbh->quote( $data{'cardnumber'} )
706				. ",surname=" . $dbh->quote( $data{'surname'} )
707				. ",firstname=" . $dbh->quote( $data{'firstname'} )
708				. ",title=" . $dbh->quote( $data{'title'} )
709				. ",othernames=" . $dbh->quote( $data{'othernames'} )
710				. ",initials=" . $dbh->quote( $data{'initials'} )
711				. ",streetnumber=". $dbh->quote( $data{'streetnumber'} )
712				. ",streettype=" . $dbh->quote( $data{'streettype'} )
713				. ",address=" . $dbh->quote( $data{'address'} )
714				. ",address2=" . $dbh->quote( $data{'address2'} )
715				. ",zipcode=" . $dbh->quote( $data{'zipcode'} )
716				. ",city=" . $dbh->quote( $data{'city'} )
717				. ",phone=" . $dbh->quote( $data{'phone'} )
718				. ",email=" . $dbh->quote( $data{'email'} )
719				. ",mobile=" . $dbh->quote( $data{'mobile'} )
720				. ",phonepro=" . $dbh->quote( $data{'phonepro'} )
721				. ",opacnote=" . $dbh->quote( $data{'opacnote'} )
722				. ",guarantorid=" . $dbh->quote( $data{'guarantorid'} )
723				. ",dateofbirth=" . $dbh->quote( $data{'dateofbirth'} )
724				. ",branchcode=" . $dbh->quote( $data{'branchcode'} )
725				. ",categorycode=" . $dbh->quote( $data{'categorycode'} )
726				. ",dateenrolled=" . $dbh->quote( $data{'dateenrolled'} )
727				. ",contactname=" . $dbh->quote( $data{'contactname'} )
728				. ",borrowernotes=" . $dbh->quote( $data{'borrowernotes'} )
729				. ",dateexpiry=" . $dbh->quote( $data{'dateexpiry'} )
730				. ",contactnote=" . $dbh->quote( $data{'contactnote'} )
731				. ",B_address=" . $dbh->quote( $data{'B_address'} )
732				. ",B_zipcode=" . $dbh->quote( $data{'B_zipcode'} )
733				. ",B_city=" . $dbh->quote( $data{'B_city'} )
734				. ",B_phone=" . $dbh->quote( $data{'B_phone'} )
735				. ",B_email=" . $dbh->quote( $data{'B_email'} )
736				. ",password=" . $dbh->quote( $data{'password'} )
737				. ",userid=" . $dbh->quote( $data{'userid'} )
738				. ",sort1=" . $dbh->quote( $data{'sort1'} )
739				. ",sort2=" . $dbh->quote( $data{'sort2'} )
740				. ",contacttitle=" . $dbh->quote( $data{'contacttitle'} )
741				. ",emailpro=" . $dbh->quote( $data{'emailpro'} )
742				. ",contactfirstname=" . $dbh->quote( $data{'contactfirstname'} )
743				. ",sex=" . $dbh->quote( $data{'sex'} )
744				. ",fax=" . $dbh->quote( $data{'fax'} )
745				. ",relationship=" . $dbh->quote( $data{'relationship'} )
746				. ",B_streetnumber=" . $dbh->quote( $data{'B_streetnumber'} )
747				. ",B_streettype=" . $dbh->quote( $data{'B_streettype'} )
748				. ",gonenoaddress=" . $dbh->quote( $data{'gonenoaddress'} )
749				. ",lost=" . $dbh->quote( $data{'lost'} )
750				. ",debarred=" . $dbh->quote( $data{'debarred'} )
751				. ",ethnicity=" . $dbh->quote( $data{'ethnicity'} )
752				. ",ethnotes=" . $dbh->quote( $data{'ethnotes'} )
753				. ",altcontactsurname=" . $dbh->quote( $data{'altcontactsurname'} )
754				. ",altcontactfirstname=" . $dbh->quote( $data{'altcontactfirstname'} )
755				. ",altcontactaddress1=" . $dbh->quote( $data{'altcontactaddress1'} )
756				. ",altcontactaddress2=" . $dbh->quote( $data{'altcontactaddress2'} )
757				. ",altcontactaddress3=" . $dbh->quote( $data{'altcontactaddress3'} )
758				. ",altcontactzipcode=" . $dbh->quote( $data{'altcontactzipcode'} )
759				. ",altcontactphone=" . $dbh->quote( $data{'altcontactphone'} ) ;
760				$debug and print STDERR "AddMember SQL: ($query)\n";
761				my $sth = $dbh->prepare($query);
762				# print "Executing SQL: $query\n";
763				$sth->execute();
764				$sth->finish;
765				$data{'borrowernumber'} = $dbh->{'mysql_insertid'}; # unneeded w/ autoincrement ?
766				# mysql_insertid is probably bad. not necessarily accurate and mysql-specific at best.
767
768				logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");
769
770				# check for enrollment fee & add it if needed
771				$sth = $dbh->prepare("SELECT enrolmentfee FROM categories WHERE categorycode=?");
772				$sth->execute($data{'categorycode'});
773				my ($enrolmentfee) = $sth->fetchrow;
774				if ($enrolmentfee) {
775				# insert fee in patron debts
776				manualinvoice($data{'borrowernumber'}, '', '', 'A', $enrolmentfee);
777				}
778				return $data{'borrowernumber'};
779				}
780
781				sub Check_Userid {
782				my ($uid,$member) = @_;
783				my $dbh = C4::Context->dbh;
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 $sth =
787				$dbh->prepare(
788				"SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
789				$sth->execute( $uid, $member );
790				if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
791				return 0;
792				}
793				else {
794				return 1;
795				}
796				}
797
798
799				sub changepassword {
800				my ( $uid, $member, $digest ) = @_;
801				my $dbh = C4::Context->dbh;
802
803				#Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
804				#Then we need to tell the user and have them create a new one.
805				my $resultcode;
806				my $sth =
807				$dbh->prepare(
808				"SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
809				$sth->execute( $uid, $member );
810				if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
811				$resultcode=0;
812				}
813				else {
814				#Everything is good so we can update the information.
815				$sth =
816				$dbh->prepare(
817				"update borrowers set userid=?, password=? where borrowernumber=?");
818				$sth->execute( $uid, $digest, $member );
819				$resultcode=1;
820				}
821
822				logaction("MEMBERS", "CHANGE PASS", $member, "") if C4::Context->preference("BorrowersLog");
823				return $resultcode;
824				}
825
826
827
828				=head2 fixup_cardnumber
829
830				Warning: The caller is responsible for locking the members table in write
831				mode, to avoid database corruption.
832
833				=cut
834
835				use vars qw( @weightings );
836				my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
837
838				sub fixup_cardnumber ($) {
839				my ($cardnumber) = @_;
840				my $autonumber_members = C4::Context->boolean_preference('autoMemberNum');
841				$autonumber_members = 0 unless defined $autonumber_members;
842
843				# Find out whether member numbers should be generated
844				# automatically. Should be either "1" or something else.
845				# Defaults to "0", which is interpreted as "no".
846
847				# if ($cardnumber !~ /\S/ && $autonumber_members) {
848				if ($autonumber_members) {
849				my $dbh = C4::Context->dbh;
850				if ( C4::Context->preference('checkdigit') eq 'katipo' ) {
851
852				# if checkdigit is selected, calculate katipo-style cardnumber.
853				# otherwise, just use the max()
854				# purpose: generate checksum'd member numbers.
855				# We'll assume we just got the max value of digits 2-8 of member #'s
856				# from the database and our job is to increment that by one,
857				# determine the 1st and 9th digits and return the full string.
858				my $sth =
859				$dbh->prepare(
860				"select max(substring(borrowers.cardnumber,2,7)) from borrowers"