← Index
Performance Profile   « block view • line view • sub view »
For opac/opac-main.pl
  Run on Thu Jul 17 22:22:09 2008
Reported on Thu Jul 17 22:22:22 2008

FileC4/Members.pm
Statements Executed15
Total Time0.000221 seconds

Subroutines — ordered by inclusive time then name
CallsInclusive
Time		Subroutine
10.00044C4::Members::GetMember
00C4::Members::AddMember
00C4::Members::BEGIN
00C4::Members::Check_Userid
00C4::Members::DebarMember
00C4::Members::DelMember
00C4::Members::END
00C4::Members::ExtendMemberSubscriptionTo
00C4::Members::GetAge
00C4::Members::GetAllIssues
00C4::Members::GetBorNotifyAcctRecord
00C4::Members::GetBorrowercategory
00C4::Members::GetBorrowercategoryList
00C4::Members::GetBorrowersNamesAndLatestIssue
00C4::Members::GetBorrowersWhoHaveNeverBorrowed
00C4::Members::GetBorrowersWhoHaveNotBorrowedSince
00C4::Members::GetBorrowersWithIssuesHistoryOlderThan
00C4::Members::GetCities
00C4::Members::GetExpiryDate
00C4::Members::GetGuarantees
00C4::Members::GetMemberAccountRecords
00C4::Members::GetMemberDetails
00C4::Members::GetMemberIssuesAndFines
00C4::Members::GetPatronImage
00C4::Members::GetPendingIssues
00C4::Members::GetRoadTypeDetails
00C4::Members::GetRoadTypes
00C4::Members::GetSortDetails
00C4::Members::GetTitles
00C4::Members::GetborCatFromCatType
00C4::Members::ModMember
00C4::Members::MoveMemberToDeleted
00C4::Members::PutPatronImage
00C4::Members::RmPatronImage
00C4::Members::SearchMember
00C4::Members::UpdateGuarantees
00C4::Members::add_member_orgs
00C4::Members::changepassword
00C4::Members::checkcardnumber
00C4::Members::checkuniquemember
00C4::Members::checkuserpassword
00C4::Members::ethnicitycategories
00C4::Members::fixEthnicity
00C4::Members::fixup_cardnumber
00C4::Members::get_institutions
00C4::Members::getidcity
00C4::Members::getzipnamecity
00C4::Members::patronflags

LineStmts.Exclusive
Time		Avg.Code
1package 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
21use strict;
22use C4::Context;
23use C4::Dates qw(format_date_in_iso);
24use Digest::MD5 qw(md5_base64);
25use Date::Calc qw/Today Add_Delta_YM/;
26use C4::Log; # logaction
27use C4::Overdues;
28use C4::Reserves;
29use C4::Accounts;
30
31our ($VERSION,@ISA,@EXPORT,@EXPORT_OK,$debug);
32
33BEGIN {
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
112C4::Members - Perl Module containing convenience functions for member handling
113
114=head1 SYNOPSIS
115
116use C4::Members;
117
118=head1 DESCRIPTION
119
120This 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
132Looks up patrons (borrowers) by name.
133
134BUGFIX 499: C<$type> is now used to determine type of search.
135if $type is "simple", search is performed on the first letter of the
136surname only.
137
138$category_type is used to get a specified type of user.
139(mainly adults when creating a child.)
140
141C<$searchstring> is a space-separated list of search terms. Each term
142must match the beginning a borrower's surname, first name, or other
143name.
144
145C<$filter> is assumed to be a list of elements to filter results on
146
147C<$showallbranches> is used in IndependantBranches Context to display all branches results.
148
149C<&SearchMember> returns a two-element list. C<$borrowers> is a
150reference-to-array; each element is a reference-to-hash, whose keys
151are the fields of the C<borrowers> table in the Koha database.
152C<$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
159sub 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 (
225SELECT borrowernumber
226FROM borrower_attributes
227JOIN borrower_attribute_types USING (code)
228WHERE staff_searchable = 1
229AND 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
253Looks up a patron and returns information about him or her. If
254C<$borrowernumber> is true (nonzero), C<&GetMemberDetails> looks
255up the borrower by number; otherwise, it looks up the borrower by card
256number.
257
258C<$borrower> is a reference-to-hash whose keys are the fields of the
259borrowers table in the Koha database. In addition,
260C<$borrower-E<gt>{flags}> is a hash giving more detailed information
261about the patron. Its keys act as flags :
262
263 if $borrower->{flags}->{LOST} {
264 # Patron's card was reported lost
265 }
266
267Each flag has a C<message> key, giving a human-readable explanation of
268the flag. If the state of a flag means that the patron should not be
269allowed to borrow any more books, then it will have a C<noissues> key
270with a true value.
271
272The 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
287forwarding 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
321C<$flags-E<gt>{ODUES}{itemlist}> is a reference-to-array listing the
322overdue items. Its elements are references-to-hash, each describing an
323overdue item. The keys are selected fields from the issues, biblio,
324biblioitems, and items tables of the Koha database.
325
326C<$flags-E<gt>{ODUES}{itemlist}> is a string giving a text listing of
327the 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
337C<$flags-E<gt>{WAITING}{itemlist}> is a reference-to-array listing the
338available items. Each element is a reference-to-hash whose keys are
339fields from the reserves table of the Koha database.
340
341=back
342
343C<$borrower-E<gt>{authflags}> is a hash giving more detailed information
344about the top-level permissions flags set for the borrower. For example,
345if a user has the "editcatalogue" permission,
346C<$borrower-E<gt>{authflags}-E<gt>{editcatalogue}> will exist and have
347the value "1".
348
349=cut
350
351sub 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.
429sub 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
508Looks up information about a patron (borrower) by either card number
509,firstname, or borrower number, depending on $type value.
510If C<$type> == 'cardnumber', C<&GetBorrower>
511searches by cardnumber then by firstname if not found in cardnumber;
512otherwise, it searches by borrowernumber.
513
514C<&GetBorrower> returns a reference-to-hash whose keys are the fields of
515the 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 {
521130.000210.00002 my ( $information, $type ) = @_;
522 my $dbh = C4::Context->dbh;
# spent 0.00015s making 1 calls to C4::Context::dbh
523 my $sth;
524 my $select = "
525SELECT borrowers.*, categories.category_type, categories.description
526FROM borrowers
527LEFT JOIN categories on borrowers.categorycode=categories.categorycode
528";
529 if ( defined $type && ( $type eq 'cardnumber' || $type eq 'firstname'|| $type eq 'userid'|| $type eq 'borrowernumber' ) ){
530 $information = uc $information;
53117e-067e-06 $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 $sth->execute($information);
# spent 0.00011s making 1 calls to DBI::st::execute
536 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 $sth->finish;
# spent 0.00001s making 1 calls to DBI::st::finish
538 ($data) and return ($data);
539
540 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 return undef;
548}
549
550=head2 GetMemberIssuesAndFines
551
552 ($overdue_count, $issue_count, $total_fines) = &GetMemberIssuesAndFines($borrowernumber);
553
554Returns aggregate data about items borrowed by the patron with the
555given borrowernumber.
556
557C<&GetMemberIssuesAndFines> returns a three-element array. C<$overdue_count> is the
558number of overdue items the patron currently has borrowed. C<$issue_count> is the
559number of books the patron currently has borrowed. C<$total_fines> is
560the total fine currently due by the borrower.
561
562=cut
563
564#'
565sub 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
599my $success = ModMember(borrowernumber => $borrowernumber, [ field => value ]... );
600
601Modify borrower's data. All date fields should ALREADY be in ISO format.
602
603return :
604true on success, or false on failure
605
606=back
607
608=cut
609
610#'
611sub 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
683insert new borrower into table
684Returns the borrowernumber
685
686=cut
687
688#'
689sub 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
781sub 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
799sub 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
830Warning: The caller is responsible for locking the members table in write
831mode, to avoid database corruption.
832
833=cut
834
835use vars qw( @weightings );
836my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
837
838sub 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"
861 );
862 $sth->execute;
863
864 my $data = $sth->fetchrow_hashref;
<