5 # Copyright 2000-2003 Katipo Communications
7 # This file is part of Koha.
9 # Koha is free software; you can redistribute it and/or modify it under the
10 # terms of the GNU General Public License as published by the Free Software
11 # Foundation; either version 2 of the License, or (at your option) any later
14 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
15 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
16 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
18 # You should have received a copy of the GNU General Public License along with
19 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
20 # Suite 330, Boston, MA 02111-1307 USA
28 use Digest::MD5 qw(md5_base64);
34 use C4::Circulation::Circ2;
36 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
38 $VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); };
42 C4::Members - Perl Module containing convenience functions for member handling
50 This module contains routines for adding, modifying and deleting members/patrons/borrowers
94 &getborrowercategoryinfo
97 &GetBorrowersFromSurname
98 &GetBranchCodeFromBorrowers
99 &GetFlagsAndBranchFromBorrower
104 &expand_sex_into_predicate
109 =head2 borrowercategories
111 ($codes_arrayref, $labels_hashref) = &borrowercategories();
113 Looks up the different types of borrowers in the database. Returns two
114 elements: a reference-to-array, which lists the borrower category
115 codes, and a reference-to-hash, which maps the borrower category codes
116 to category descriptions.
121 sub borrowercategories {
122 my $dbh = C4::Context->dbh;
123 my $sth=$dbh->prepare("Select categorycode,description from categories order by description");
127 while (my $data=$sth->fetchrow_hashref){
128 push @codes,$data->{'categorycode'};
129 $labels{$data->{'categorycode'}}=$data->{'description'};
132 return(\@codes,\%labels);
137 ($count, $borrowers) = &BornameSearch($env, $searchstring, $type);
139 Looks up patrons (borrowers) by name.
143 BUGFIX 499: C<$type> is now used to determine type of search.
144 if $type is "simple", search is performed on the first letter of the
147 C<$searchstring> is a space-separated list of search terms. Each term
148 must match the beginning a borrower's surname, first name, or other
151 C<&BornameSearch> returns a two-element list. C<$borrowers> is a
152 reference-to-array; each element is a reference-to-hash, whose keys
153 are the fields of the C<borrowers> table in the Koha database.
154 C<$count> is the number of elements in C<$borrowers>.
158 #used by member enquiries from the intranet
161 my ($env,$searchstring,$orderby,$type)=@_;
162 my $dbh = C4::Context->dbh;
163 my $query = ""; my $count;
167 if($type eq "simple") # simple search for one letter only
169 $query="Select * from borrowers where surname like '$searchstring%' order by $orderby";
170 # @bind=("$searchstring%");
172 else # advanced search looking in surname, firstname and othernames
174 ### Try to determine whether numeric like cardnumber
175 if ($searchstring+1>1) {
176 $query="Select * from borrowers where cardnumber like '$searchstring%' ";
180 my @words=split / /,$searchstring;
181 foreach my $word(@words){
185 $searchstring=join " ",@words;
187 $query="Select * from borrowers where MATCH(surname,firstname,othernames) AGAINST('$searchstring' in boolean mode)";
190 $query=$query." order by $orderby";
193 my $sth=$dbh->prepare($query);
194 # warn "Q $orderby : $query";
198 while (my $data=$sth->fetchrow_hashref){
199 push(@results,$data);
203 return ($cnt,\@results);
205 =head2 getpatroninformation
207 ($borrower, $flags) = &getpatroninformation($env, $borrowernumber, $cardnumber);
208 Looks up a patron and returns information about him or her. If
209 C<$borrowernumber> is true (nonzero), C<&getpatroninformation> looks
210 up the borrower by number; otherwise, it looks up the borrower by card
212 C<$env> is effectively ignored, but should be a reference-to-hash.
213 C<$borrower> is a reference-to-hash whose keys are the fields of the
214 borrowers table in the Koha database. In addition,
215 C<$borrower-E<gt>{flags}> is a hash giving more detailed information
216 about the patron. Its keys act as flags :
218 if $borrower->{flags}->{LOST} {
219 # Patron's card was reported lost
222 Each flag has a C<message> key, giving a human-readable explanation of
223 the flag. If the state of a flag means that the patron should not be
224 allowed to borrow any more books, then it will have a C<noissues> key
227 The possible flags are:
233 Shows the patron's credit or debt, if any.
241 (Gone, no address.) Set if the patron has left without giving a
250 Set if the patron's card has been reported as lost.
258 Set if the patron has been debarred.
266 Any additional notes about the patron.
274 Set if the patron has overdue items. This flag has several keys:
276 C<$flags-E<gt>{ODUES}{itemlist}> is a reference-to-array listing the
277 overdue items. Its elements are references-to-hash, each describing an
278 overdue item. The keys are selected fields from the issues, biblio,
279 biblioitems, and items tables of the Koha database.
281 C<$flags-E<gt>{ODUES}{itemlist}> is a string giving a text listing of
282 the overdue items, one per line.
290 Set if any items that the patron has reserved are available.
292 C<$flags-E<gt>{WAITING}{itemlist}> is a reference-to-array listing the
293 available items. Each element is a reference-to-hash whose keys are
294 fields from the reserves table of the Koha database.
302 sub getpatroninformation {
304 my ($env, $borrowernumber,$cardnumber) = @_;
305 my $dbh = C4::Context->dbh;
308 if ($borrowernumber) {
309 $sth = $dbh->prepare("select * from borrowers where borrowernumber=?");
310 $sth->execute($borrowernumber);
311 } elsif ($cardnumber) {
312 $sth = $dbh->prepare("select * from borrowers where cardnumber=?");
313 $sth->execute($cardnumber);
315 $env->{'apierror'} = "invalid borrower information passed to getpatroninformation subroutine";
318 my $borrower = $sth->fetchrow_hashref;
319 my $amount = C4::Accounts2::checkaccount($env, $borrowernumber, $dbh);
320 $borrower->{'amountoutstanding'} = $amount;
321 my $flags = C4::Circulation::Circ2::patronflags($env, $borrower, $dbh);
324 $sth=$dbh->prepare("select bit,flag from userflags");
326 while (my ($bit, $flag) = $sth->fetchrow) {
327 if ($borrower->{'flags'} & 2**$bit) {
328 $accessflagshash->{$flag}=1;
332 $borrower->{'flags'}=$flags;
333 $borrower->{'authflags'} = $accessflagshash;
334 return ($borrower); #, $flags, $accessflagshash);
339 $borrower = &getmember($cardnumber, $borrowernumber);
341 Looks up information about a patron (borrower) by either card number
342 or borrower number. If $borrowernumber is specified, C<&borrdata>
343 searches by borrower number; otherwise, it searches by card number.
345 C<&getmember> returns a reference-to-hash whose keys are the fields of
346 the C<borrowers> table in the Koha database.
350 =head3 GetFlagsAndBranchFromBorrower
354 ($flags, $homebranch) = GetFlagsAndBranchFromBorrower($loggedinuser);
356 this function read on the database to get flags and homebranch for a user
360 it returns the $flags & the homebranch in scalar context.
370 ($count, $issues) = &borrissues($borrowernumber);
372 Looks up what the patron with the given borrowernumber has borrowed.
374 C<&borrissues> returns a two-element array. C<$issues> is a
375 reference-to-array, where each element is a reference-to-hash; the
376 keys are the fields from the C<issues>, C<biblio>, and C<items> tables
377 in the Koha database. C<$count> is the number of elements in
384 my $dbh = C4::Context->dbh;
385 my $sth=$dbh->prepare("Select * from issues,biblio,items where borrowernumber=?
386 and items.itemnumber=issues.itemnumber
387 and items.biblionumber=biblio.biblionumber
388 and issues.returndate is NULL order by date_due");
389 $sth->execute($bornum);
391 while (my $data = $sth->fetchrow_hashref) {
395 return(scalar(@result), \@result);
400 ($count, $issues) = &allissues($borrowernumber, $sortkey, $limit);
402 Looks up what the patron with the given borrowernumber has borrowed,
403 and sorts the results.
405 C<$sortkey> is the name of a field on which to sort the results. This
406 should be the name of a field in the C<issues>, C<biblio>,
407 C<biblioitems>, or C<items> table in the Koha database.
409 C<$limit> is the maximum number of results to return.
411 C<&allissues> returns a two-element array. C<$issues> is a
412 reference-to-array, where each element is a reference-to-hash; the
413 keys are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
414 C<items> tables of the Koha database. C<$count> is the number of
415 elements in C<$issues>
420 my ($bornum,$order,$limit)=@_;
421 #FIXME: sanity-check order and limit
422 my $dbh = C4::Context->dbh;
423 my $query="Select * from issues,biblio,items
424 where borrowernumber=? and
425 items.itemnumber=issues.itemnumber and
426 items.biblionumber=biblio.biblionumber order by $order";
428 $query.=" limit $limit";
431 my $sth=$dbh->prepare($query);
432 $sth->execute($bornum);
435 while (my $data=$sth->fetchrow_hashref){
445 ## NEU specific. used in Reserve section issues
446 my ($env,$bornum)=@_;
447 my $dbh = C4::Context->dbh;
448 my $query="Select count(*) from reserveissue as r where r.borrowernumber='$bornum'
449 and rettime is null";
451 my $sth=$dbh->prepare($query);
453 my $data=$sth->fetchrow_hashref;
455 $sth=$dbh->prepare("Select count(*),timediff(now(), duetime ) as elapsed, hour(timediff(now(), duetime )) as hours, MINUTE(timediff(now(), duetime )) as min from
456 reserveissue as r where r.borrowernumber='$bornum' and rettime is null and duetime< now() group by r.borrowernumber");
459 my $data2=$sth->fetchrow_hashref;
461 my $rescharge=C4::Context->preference('resmaterialcharge');
465 if ($data2->{'elapsed'}>0){
466 $resfine=($data2->{'hours'}+$data2->{'min'}/60)*$rescharge;
467 $resfine=sprintf ("%.1f",$resfine);
470 $sth=$dbh->prepare("Select sum(amountoutstanding) from accountlines where
471 borrowernumber='$bornum'");
473 my $data3=$sth->fetchrow_hashref;
477 return($data2->{'count(*)'},$data->{'count(*)'},$data3->{'sum(amountoutstanding)'},$resfine);
479 =item getboracctrecord
481 ($count, $acctlines, $total) = &getboracctrecord($env, $borrowernumber);
483 Looks up accounting data for the patron with the given borrowernumber.
488 C<&getboracctrecord> returns a three-element array. C<$acctlines> is a
489 reference-to-array, where each element is a reference-to-hash; the
490 keys are the fields of the C<accountlines> table in the Koha database.
491 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
492 total amount outstanding for all of the account lines.
496 sub getboracctrecord {
497 my ($env,$params) = @_;
498 my $dbh = C4::Context->dbh;
501 my $sth=$dbh->prepare("Select * from accountlines where
502 borrowernumber=? order by date desc,timestamp desc");
504 $sth->execute($params->{'borrowernumber'});
506 while (my $data=$sth->fetchrow_hashref){
507 $acctlines[$numlines] = $data;
509 $total += $data->{'amountoutstanding'};
512 return ($numlines,\@acctlines,$total);
515 sub getborrowercategory{
517 my $dbh = C4::Context->dbh;
518 my $sth = $dbh->prepare("SELECT description FROM categories WHERE categorycode = ?");
519 $sth->execute($catcode);
520 my $description = $sth->fetchrow();
523 } # sub getborrowercategory
525 sub getborrowercategoryinfo{
527 my $dbh = C4::Context->dbh;
528 my $sth = $dbh->prepare("SELECT * FROM categories WHERE categorycode = ?");
529 $sth->execute($catcode);
530 my $category = $sth->fetchrow_hashref;
533 } # sub getborrowercategoryinfo
536 sub GetFlagsAndBranchFromBorrower {
537 my $loggedinuser = @_;
538 my $dbh = C4::Context->dbh;
540 SELECT flags, branchcode
542 WHERE borrowernumber = ?
544 my $sth = $dbh->prepare($query);
545 $sth->execute($loggedinuser);
547 return $sth->fetchrow;
552 my ( $cardnumber, $bornum ) = @_;
553 $cardnumber = uc $cardnumber;
554 my $dbh = C4::Context->dbh;
556 if ( $bornum eq '' ) {
557 $sth = $dbh->prepare("Select * from borrowers where cardnumber=?");
558 $sth->execute($cardnumber);
560 $sth = $dbh->prepare("Select * from borrowers where borrowernumber=?");
561 $sth->execute($bornum);
563 my $data = $sth->fetchrow_hashref;
568 else { # try with firstname
571 $dbh->prepare("select * from borrowers where firstname=?");
572 $sth->execute($cardnumber);
573 my $data = $sth->fetchrow_hashref;
583 $borrower = &borrdata($cardnumber, $borrowernumber);
585 Looks up information about a patron (borrower) by either card number
586 or borrower number. If $borrowernumber is specified, C<&borrdata>
587 searches by borrower number; otherwise, it searches by card number.
589 C<&borrdata> returns a reference-to-hash whose keys are the fields of
590 the C<borrowers> table in the Koha database.
596 my ( $cardnumber, $bornum ) = @_;
597 $cardnumber = uc $cardnumber;
598 my $dbh = C4::Context->dbh;
600 if ( $bornum eq '' ) {
603 "Select borrowers.*,categories.category_type from borrowers left join categories on borrowers.categorycode=categories.categorycode where cardnumber=?"
605 $sth->execute($cardnumber);
610 "Select borrowers.*,categories.category_type from borrowers left join categories on borrowers.categorycode=categories.categorycode where borrowernumber=?"
612 $sth->execute($bornum);
614 my $data = $sth->fetchrow_hashref;
615 # warn "DATA" . $data->{category_type};
620 else { # try with firstname
624 "Select borrowers.*,categories.category_type from borrowers left join categories on borrowers.categorycode=categories.categorycode where firstname=?"
626 $sth->execute($cardnumber);
627 my $data = $sth->fetchrow_hashref;
637 ($borrowed, $due, $fine) = &borrdata2($env, $borrowernumber);
639 Returns aggregate data about items borrowed by the patron with the
640 given borrowernumber.
644 C<&borrdata2> returns a three-element array. C<$borrowed> is the
645 number of books the patron currently has borrowed. C<$due> is the
646 number of overdue items the patron currently has borrowed. C<$fine> is
647 the total fine currently due by the borrower.
653 my ( $env, $bornum ) = @_;
654 my $dbh = C4::Context->dbh;
655 my $query = "Select count(*) from issues where borrowernumber='$bornum' and
659 my $sth = $dbh->prepare($query);
661 my $data = $sth->fetchrow_hashref;
663 $sth = $dbh->prepare(
664 "Select count(*) from issues where
665 borrowernumber='$bornum' and date_due < now() and returndate is NULL"
668 my $data2 = $sth->fetchrow_hashref;
670 $sth = $dbh->prepare(
671 "Select sum(amountoutstanding) from accountlines where
672 borrowernumber='$bornum'"
675 my $data3 = $sth->fetchrow_hashref;
678 return ( $data2->{'count(*)'}, $data->{'count(*)'},
679 $data3->{'sum(amountoutstanding)'} );
684 my $dbh = C4::Context->dbh;
685 $data{'dateofbirth'}=format_date_in_iso($data{'dateofbirth'});
688 $data{'joining'}=format_date_in_iso($data{'joining'});
690 if ($data{'expiry'}) {
691 $data{'expiry'}=format_date_in_iso($data{'expiry'});
694 $data{'expiry'} = calcexpirydate($data{'categorycode'},$data{'joining'} );
698 my $query= "UPDATE borrowers SET
699 cardnumber = '$data{'cardnumber'}' ,
700 surname = '$data{'surname'}' ,
701 firstname = '$data{'firstname'}' ,
702 title = '$data{'title'}' ,
703 initials = '$data{'initials'}' ,
704 dateofbirth = '$data{'dateofbirth'}' ,
705 sex = '$data{'sex'}' ,
706 streetaddress = '$data{'streetaddress'}' ,
707 streetcity = '$data{'streetcity'}' ,
708 zipcode = '$data{'zipcode'}' ,
709 phoneday = '$data{'phoneday'}' ,
710 physstreet = '$data{'physstreet'}' ,
711 city = '$data{'city'}' ,
712 homezipcode = '$data{'homezipcode'}' ,
713 phone = '$data{'phone'}' ,
714 emailaddress = '$data{'emailaddress'}' ,
715 preferredcont = '$data{'preferredcont'}',
716 faxnumber = '$data{'faxnumber'}' ,
717 textmessaging = '$data{'textmessaging'}' ,
718 categorycode = '$data{'categorycode'}' ,
719 branchcode = '$data{'branchcode'}' ,
720 borrowernotes = '$data{'borrowernotes'}' ,
721 ethnicity = '$data{'ethnicity'}' ,
722 ethnotes = '$data{'ethnotes'}' ,
723 expiry = '$data{'expiry'}' ,
724 dateenrolled = '$data{'joining'}' ,
725 sort1 = '$data{'sort1'}' ,
726 sort2 = '$data{'sort2'}' ,
727 debarred = '$data{'debarred'}' ,
728 lost = '$data{'lost'}' ,
729 gonenoaddress = '$data{'gna'}'
730 WHERE borrowernumber = $data{'borrowernumber'}";
731 my $sth = $dbh->prepare($query);
734 # ok if its an adult (type) it may have borrowers that depend on it as a guarantor
735 # so when we update information for an adult we should check for guarantees and update the relevant part
736 # of their records, ie addresses and phone numbers
737 if ($data{'categorycode'} eq 'A' || $data{'categorycode'} eq 'W'){
738 # is adult check guarantees;
739 updateguarantees(%data);
745 my $dbh = C4::Context->dbh;
746 $data{'dateofbirth'}=format_date_in_iso($data{'dateofbirth'});
749 if ($data{'joining'}){
750 $data{'joining'}=format_date_in_iso($data{'joining'});
752 $data{'joining'} = get_today();
754 # if expirydate is not set, calculate it from borrower category subscription duration
755 if ($data{'expiry'}) {
756 $data{'expiry'}=format_date_in_iso($data{'expiry'});
759 $data{'expiry'} = calcexpirydate($data{'categorycode'},$data{'joining'});
762 my $query= "INSERT INTO borrowers (
793 '$data{'cardnumber'}',
795 '$data{'firstname'}',
798 '$data{'dateofbirth'}',
801 '$data{'streetaddress'}',
802 '$data{'streetcity'}',
806 '$data{'physstreet'}',
808 '$data{'homezipcode'}',
811 '$data{'emailaddress'}',
812 '$data{'faxnumber'}',
813 '$data{'textmessaging'}',
814 '$data{'preferredcont'}',
815 '$data{'categorycode'}',
816 '$data{'branchcode'}',
817 '$data{'borrowernotes'}',
818 '$data{'ethnicity'}',
825 my $sth=$dbh->prepare($query);
828 $data{'bornum'} =$dbh->{'mysql_insertid'};
829 return $data{'bornum'};
833 my ( $categorycode, $dateenrolled ) = @_;
834 my $dbh = C4::Context->dbh;
837 "select enrolmentperiod from categories where categorycode=?");
838 $sth->execute($categorycode);
839 my ($enrolmentperiod) = $sth->fetchrow;
840 $enrolmentperiod = 1 unless ($enrolmentperiod);#enrolmentperiod in years
841 my $duration=get_duration($enrolmentperiod." years");
842 return DATE_Add_Duration($dateenrolled,$duration);
846 =head2 checkuserpassword (OUEST-PROVENCE)
848 check for the password and login are not used
849 return the number of record
850 0=> NOT USED 1=> USED
854 sub checkuserpassword {
855 my ( $borrowernumber, $userid, $password ) = @_;
856 $password = md5_base64($password);
857 my $dbh = C4::Context->dbh;
860 "Select count(*) from borrowers where borrowernumber !=? and userid =? and password=? "
862 $sth->execute( $borrowernumber, $userid, $password );
863 my $number_rows = $sth->fetchrow;
867 sub getmemberfromuserid {
869 my $dbh = C4::Context->dbh;
870 my $sth = $dbh->prepare("select * from borrowers where userid=?");
871 $sth->execute($userid);
872 return $sth->fetchrow_hashref;
874 sub updateguarantees {
876 my $dbh = C4::Context->dbh;
877 my ( $count, $guarantees ) = findguarantees( $data{'borrowernumber'} );
878 for ( my $i = 0 ; $i < $count ; $i++ ) {
881 # It looks like the $i is only being returned to handle walking through
882 # the array, which is probably better done as a foreach loop.
885 "update borrowers set streetaddress='$data{'address'}',faxnumber='$data{'faxnumber'}',
886 streetcity='$data{'streetcity'}',phoneday='$data{'phoneday'}',city='$data{'city'}',area='$data{'area'}',phone='$data{'phone'}'
887 ,streetaddress='$data{'address'}'
888 where borrowernumber='$guarantees->[$i]->{'borrowernumber'}'";
889 my $sth3 = $dbh->prepare($guaquery);
894 ################################################################################
896 =item fixup_cardnumber
898 Warning: The caller is responsible for locking the members table in write
899 mode, to avoid database corruption.
903 use vars qw( @weightings );
904 my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
906 sub fixup_cardnumber ($) {
907 my ($cardnumber) = @_;
908 my $autonumber_members = C4::Context->boolean_preference('autoMemberNum');
909 $autonumber_members = 0 unless defined $autonumber_members;
911 # Find out whether member numbers should be generated
912 # automatically. Should be either "1" or something else.
913 # Defaults to "0", which is interpreted as "no".
915 # if ($cardnumber !~ /\S/ && $autonumber_members) {
916 if ($autonumber_members) {
917 my $dbh = C4::Context->dbh;
918 if ( C4::Context->preference('checkdigit') eq 'katipo' ) {
920 # if checkdigit is selected, calculate katipo-style cardnumber.
921 # otherwise, just use the max()
922 # purpose: generate checksum'd member numbers.
923 # We'll assume we just got the max value of digits 2-8 of member #'s
924 # from the database and our job is to increment that by one,
925 # determine the 1st and 9th digits and return the full string.
928 "select max(substring(borrowers.cardnumber,2,7)) from borrowers"
932 my $data = $sth->fetchrow_hashref;
933 $cardnumber = $data->{'max(substring(borrowers.cardnumber,2,7))'};
936 if ( !$cardnumber ) { # If DB has no values,
937 $cardnumber = 1000000; # start at 1000000
943 for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
945 # read weightings, left to right, 1 char at a time
946 my $temp1 = $weightings[$i];
948 # sequence left to right, 1 char at a time
949 my $temp2 = substr( $cardnumber, $i, 1 );
951 # mult each char 1-7 by its corresponding weighting
952 $sum += $temp1 * $temp2;
955 $rem = ( $sum % 11 );
956 $rem = 'X' if $rem == 10;
958 $cardnumber = "V$cardnumber$rem";
962 # MODIFIED BY JF: mysql4.1 allows casting as an integer, which is probably
963 # better. I'll leave the original in in case it needs to be changed for you
966 "select max(cast(cardnumber as signed)) from borrowers");
968 #my $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers");
972 $cardnumber="V$cardnumber$rem";
977 sub fixupneu_cardnumber{
978 my($cardnumber,$categorycode) = @_;
979 my $autonumber_members = C4::Context->boolean_preference('autoMemberNum');
980 $autonumber_members = 0 unless defined $autonumber_members;
981 # Find out whether member numbers should be generated
982 # automatically. Should be either "1" or something else.
983 # Defaults to "0", which is interpreted as "no".
984 my $dbh = C4::Context->dbh;
986 if (!$cardnumber && $autonumber_members && $categorycode) {
987 if ($categorycode eq "A" || $categorycode eq "W" ){
988 $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers where borrowers.cardnumber like '5%' ");
989 }elsif ($categorycode eq "L"){
990 $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers where borrowers.cardnumber like '10%' ");
991 }elsif ($categorycode eq "F" || $categorycode eq "E") {
992 $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers where borrowers.cardnumber like '30%' ");
993 }elsif ($categorycode eq "N"){
994 $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers where borrowers.cardnumber like '40%' ");
995 }elsif ($categorycode eq "C"){
996 $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers where borrowers.cardnumber like '80%' ");
999 $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers where borrowers.cardnumber like '6%' ");
1003 my $data=$sth->fetchrow_hashref;
1004 $cardnumber=$data->{'max(borrowers.cardnumber)'};
1007 # purpose: generate checksum'd member numbers.
1008 # We'll assume we just got the max value of digits 2-8 of member #'s
1009 # from the database and our job is to increment that by one,
1010 # determine the 1st and 9th digits and return the full string.
1012 if (! $cardnumber) { # If DB has no values,
1013 if ($categorycode eq "A" || $categorycode eq "W" ){ $cardnumber = 5000000;}
1014 elsif ($categorycode eq "L"){ $cardnumber = 1000000;}
1015 elsif ($categorycode eq "F"){ $cardnumber = 3000000;}
1016 elsif ($categorycode eq "C"){ $cardnumber = 8000000;}
1017 elsif ($categorycode eq "N"){ $cardnumber = 4000000;}
1018 else{$cardnumber = 6000000;}
1019 # start at 1000000 or 3000000 or 5000000
1029 =item GuarantornameSearch
1031 ($count, $borrowers) = &GuarantornameSearch($env, $searchstring, $type);
1033 Looks up guarantor by name.
1037 BUGFIX 499: C<$type> is now used to determine type of search.
1038 if $type is "simple", search is performed on the first letter of the
1041 C<$searchstring> is a space-separated list of search terms. Each term
1042 must match the beginning a borrower's surname, first name, or other
1045 C<&GuarantornameSearch> returns a two-element list. C<$borrowers> is a
1046 reference-to-array; each element is a reference-to-hash, whose keys
1047 are the fields of the C<borrowers> table in the Koha database.
1048 C<$count> is the number of elements in C<$borrowers>.
1050 return all info from guarantor =>only category_type A
1055 #used by member enquiries from the intranet
1056 #called by guarantor_search.pl
1057 sub GuarantornameSearch {
1058 my ( $env, $searchstring, $orderby, $type ) = @_;
1059 my $dbh = C4::Context->dbh;
1065 if ( $type eq "simple" ) # simple search for one letter only
1068 "Select * from borrowers,categories where borrowers.categorycode=categories.categorycode and category_type='A' and surname like ? order by $orderby";
1069 @bind = ("$searchstring%");
1071 else # advanced search looking in surname, firstname and othernames
1073 @data = split( ' ', $searchstring );
1075 $query = "Select * from borrowers,categories
1076 where ((surname like ? or surname like ?
1077 or firstname like ? or firstname like ?
1078 or othernames like ? or othernames like ?) and borrowers.categorycode=categories.categorycode and category_type='A'
1081 "$data[0]%", "% $data[0]%", "$data[0]%", "% $data[0]%",
1082 "$data[0]%", "% $data[0]%"
1084 for ( my $i = 1 ; $i < $count ; $i++ ) {
1085 $query = $query . " and (" . " surname like ? or surname like ?
1086 or firstname like ? or firstname like ?
1087 or othernames like ? or othernames like ?)";
1089 "$data[$i]%", "% $data[$i]%", "$data[$i]%",
1090 "% $data[$i]%", "$data[$i]%", "% $data[$i]%" );
1094 $query = $query . ") or cardnumber like ?
1096 push( @bind, $searchstring );
1101 my $sth = $dbh->prepare($query);
1102 $sth->execute(@bind);
1104 my $cnt = $sth->rows;
1105 while ( my $data = $sth->fetchrow_hashref ) {
1106 push( @results, $data );
1111 return ( $cnt, \@results );
1115 =item findguarantees
1117 ($num_children, $children_arrayref) = &findguarantees($parent_borrno);
1118 $child0_cardno = $children_arrayref->[0]{"cardnumber"};
1119 $child0_borrno = $children_arrayref->[0]{"borrowernumber"};
1121 C<&findguarantees> takes a borrower number (e.g., that of a patron
1122 with children) and looks up the borrowers who are guaranteed by that
1123 borrower (i.e., the patron's children).
1125 C<&findguarantees> returns two values: an integer giving the number of
1126 borrowers guaranteed by C<$parent_borrno>, and a reference to an array
1127 of references to hash, which gives the actual results.
1133 my $dbh = C4::Context->dbh;
1134 my $sth=$dbh->prepare("select cardnumber,borrowernumber, firstname, surname from borrowers where guarantor=?");
1135 $sth->execute($bornum);
1138 while (my $data = $sth->fetchrow_hashref)
1143 return (scalar(@dat), \@dat);
1148 $guarantor = &findguarantor($borrower_no);
1149 $guarantor_cardno = $guarantor->{"cardnumber"};
1150 $guarantor_surname = $guarantor->{"surname"};
1153 C<&findguarantor> takes a borrower number (presumably that of a child
1154 patron), finds the guarantor for C<$borrower_no> (the child's parent),
1155 and returns the record for the guarantor.
1157 C<&findguarantor> returns a reference-to-hash. Its keys are the fields
1158 from the C<borrowers> database table;
1164 my $dbh = C4::Context->dbh;
1165 my $sth=$dbh->prepare("select guarantor from borrowers where borrowernumber=?");
1166 $sth->execute($bornum);
1167 my $data=$sth->fetchrow_hashref;
1169 $sth=$dbh->prepare("Select * from borrowers where borrowernumber=?");
1170 $sth->execute($data->{'guarantor'});
1171 $data=$sth->fetchrow_hashref;
1176 sub borrowercard_active {
1178 my $dbh = C4::Context->dbh;
1179 my $sth = $dbh->prepare("SELECT expiry FROM borrowers WHERE (borrowernumber = ?) AND (NOW() <= expiry)");
1180 $sth->execute($bornum);
1181 if (my $data=$sth->fetchrow_hashref){
1188 # Search the member photo, in case that photo doesn´t exists, return a default photo.for NEU
1189 sub getMemberPhoto {
1190 my $cardnumber = shift @_;
1191 my $htdocs = C4::Context->config('opacdir');
1192 my $dirname = $htdocs."/htdocs/uploaded-files/users-photo/";
1193 # my $dirname = "$ENV{'DOCUMENT_ROOT'}/uploaded-files/users-photo";
1194 opendir(DIR, $dirname) or die "Can't open directory $dirname: $!";
1195 while (defined(my $file = readdir(DIR))) {
1196 if ($file =~ /^$cardnumber\..+/){
1197 return "/uploaded-files/users-photo/$file";
1201 return "http://cc.neu.edu.tr/stdpictures/".$cardnumber.".jpg";
1204 sub change_user_pass {
1205 my ($uid,$member,$digest) = @_;
1206 my $dbh = C4::Context->dbh;
1207 #Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
1208 #Then we need to tell the user and have them create a new one.
1209 my $sth=$dbh->prepare("select * from borrowers where userid=? and borrowernumber <> ?");
1210 $sth->execute($uid,$member);
1211 if ( ($uid ne '') && ($sth->fetchrow) ) {
1215 #Everything is good so we can update the information.
1216 $sth=$dbh->prepare("update borrowers set userid=?, password=? where borrowernumber=?");
1217 $sth->execute($uid, $digest, $member);
1223 =head2 checkuniquemember (OUEST-PROVENCE)
1225 $result = &checkuniquemember($collectivity,$surname,$categorycode,$firstname,$dateofbirth);
1227 Checks that a member exists or not in the database.
1229 C<&result> is 1 (=exist) or 0 (=does not exist)
1230 C<&collectivity> is 1 (= we add a collectivity) or 0 (= we add a physical member)
1231 C<&surname> is the surname
1232 C<&categorycode> is from categorycode table
1233 C<&firstname> is the firstname (only if collectivity=0)
1234 C<&dateofbirth> is the date of birth (only if collectivity=0)
1237 sub checkuniquemember {
1238 my ( $collectivity, $surname, $firstname, $dateofbirth ) = @_;
1239 my $dbh = C4::Context->dbh;
1241 if ($collectivity) {
1243 # $request="select count(*) from borrowers where surname=? and categorycode=?";
1245 "select borrowernumber,categorycode from borrowers where surname=? ";
1249 # $request="select count(*) from borrowers where surname=? and categorycode=? and firstname=? and dateofbirth=?";
1251 "select borrowernumber,categorycode from borrowers where surname=? and firstname=? and dateofbirth=?";
1253 my $sth = $dbh->prepare($request);
1254 if ($collectivity) {
1255 $sth->execute( uc($surname) );
1258 $sth->execute( uc($surname), ucfirst($firstname), $dateofbirth );
1260 my @data = $sth->fetchrow;
1263 return $data[0], $data[1];
1272 =head2 getzipnamecity (OUEST-PROVENCE)
1274 take all info from table city for the fields city and zip
1275 check for the name and the zip code of the city selected
1279 sub getzipnamecity {
1281 my $dbh = C4::Context->dbh;
1284 "select city_name,city_zipcode from cities where cityid=? ");
1285 $sth->execute($cityid);
1286 my @data = $sth->fetchrow;
1287 return $data[0], $data[1];
1290 =head2 updatechildguarantor (OUEST-PROVENCE)
1292 check for title,firstname,surname,adress,zip code and city from guarantor to
1299 sub getguarantordata {
1300 my ($borrowerid) = @_;
1301 my $dbh = C4::Context->dbh;
1304 "Select title,firstname,surname,streetnumber,address,streettype,address2,zipcode,city,phone,phonepro,mobile,email,emailpro,fax from borrowers where borrowernumber =? "
1306 $sth->execute($borrowerid);
1307 my $guarantor_data = $sth->fetchrow_hashref;
1309 return $guarantor_data;
1312 =head2 getdcity (OUEST-PROVENCE)
1313 recover cityid with city_name condition
1317 my ($city_name) = @_;
1318 my $dbh = C4::Context->dbh;
1319 my $sth = $dbh->prepare("select cityid from cities where city_name=? ");
1320 $sth->execute($city_name);
1321 my $data = $sth->fetchrow;
1325 =head2 getcategorytype (OUEST-PROVENCE)
1327 check for the category_type with categorycode
1328 and return the category_type
1332 sub getcategorytype {
1333 my ($categorycode) = @_;
1334 my $dbh = C4::Context->dbh;
1337 "Select category_type,description from categories where categorycode=? "
1339 $sth->execute($categorycode);
1340 my ( $category_type, $description ) = $sth->fetchrow;
1341 return $category_type, $description;
1350 # # A better approach might be to set borrowernumber autoincrement and
1352 sub NewBorrowerNumber {
1353 my $dbh = C4::Context->dbh;
1354 my $sth=$dbh->prepare("Select max(borrowernumber) from borrowers");
1356 my $data=$sth->fetchrow_hashref;
1358 $data->{'max(borrowernumber)'}++;
1359 return($data->{'max(borrowernumber)'});
1362 =head2 ethnicitycategories
1364 ($codes_arrayref, $labels_hashref) = ðnicitycategories();
1366 Looks up the different ethnic types in the database. Returns two
1367 elements: a reference-to-array, which lists the ethnicity codes, and a
1368 reference-to-hash, which maps the ethnicity codes to ethnicity
1375 sub ethnicitycategories {
1376 my $dbh = C4::Context->dbh;
1377 my $sth = $dbh->prepare("Select code,name from ethnicity order by name");
1381 while ( my $data = $sth->fetchrow_hashref ) {
1382 push @codes, $data->{'code'};
1383 $labels{ $data->{'code'} } = $data->{'name'};
1386 return ( \@codes, \%labels );
1391 $ethn_name = &fixEthnicity($ethn_code);
1393 Takes an ethnicity code (e.g., "european" or "pi") and returns the
1394 corresponding descriptive name from the C<ethnicity> table in the
1395 Koha database ("European" or "Pacific Islander").
1401 sub fixEthnicity($) {
1403 my $ethnicity = shift;
1404 my $dbh = C4::Context->dbh;
1405 my $sth = $dbh->prepare("Select name from ethnicity where code = ?");
1406 $sth->execute($ethnicity);
1407 my $data = $sth->fetchrow_hashref;
1409 return $data->{'name'};
1410 } # sub fixEthnicity
1416 $dateofbirth,$date = &get_age($date);
1418 this function return the borrowers age with the value of dateofbirth
1423 my ($date, $date_ref) = @_;
1425 if (not defined $date_ref) {
1426 $date_ref = get_today();
1429 my ($year1, $month1, $day1) = split /-/, $date;
1430 my ($year2, $month2, $day2) = split /-/, $date_ref;
1432 my $age = $year2 - $year1;
1433 if ($month1.$day1 > $month2.$day2) {
1442 =head2 get_institutions
1443 $insitutions = get_institutions();
1445 Just returns a list of all the borrowers of type I, borrownumber and name
1449 sub get_institutions {
1450 my $dbh = C4::Context->dbh();
1453 "SELECT borrowernumber,surname FROM borrowers WHERE categorycode=? ORDER BY surname"
1457 while ( my $data = $sth->fetchrow_hashref() ) {
1458 $orgs{ $data->{'borrowernumber'} } = $data;
1463 } # sub get_institutions
1465 =head2 add_member_orgs
1467 add_member_orgs($borrowernumber,$borrowernumbers);
1469 Takes a borrowernumber and a list of other borrowernumbers and inserts them into the borrowers_to_borrowers table
1474 sub add_member_orgs {
1475 my ( $borrowernumber, $otherborrowers ) = @_;
1476 my $dbh = C4::Context->dbh();
1478 "INSERT INTO borrowers_to_borrowers (borrower1,borrower2) VALUES (?,?)";
1479 my $sth = $dbh->prepare($query);
1480 foreach my $bornum (@$otherborrowers) {
1481 $sth->execute( $borrowernumber, $bornum );
1485 } # sub add_member_orgs
1487 =head2 GetBorrowersFromSurname
1491 \@resutlts = GetBorrowersFromSurname($surname)
1492 this function get the list of borrower names like $surname.
1494 the table of results in @results
1499 sub GetBorrowersFromSurname {
1500 my ($searchstring)=@_;
1501 my $dbh = C4::Context->dbh;
1502 $searchstring=~ s/\'/\\\'/g;
1503 my @data=split(' ',$searchstring);
1506 SELECT surname,firstname
1508 WHERE (surname like ?)
1511 my $sth=$dbh->prepare($query);
1512 $sth->execute("$data[0]%");
1515 while (my $data=$sth->fetchrow_hashref){
1516 push(@results,$data);
1520 return ($count,\@results);
1523 =head2 expand_sex_into_predicate
1525 $data{&expand_sex_into_predicate($data{sex})} = 1;
1527 Converts a single 'M' or 'F' into 'sex_M_p' or 'sex_F_p'
1530 In some languages, 'M' and 'F' are not appropriate. However,
1531 with HTML::Template, there is no way to localize 'M' or 'F'
1532 unless these are converted into variables that TMPL_IF can
1533 understand. This function provides this conversion.
1537 sub expand_sex_into_predicate ($) {
1539 return "sex_${sex}_p";
1540 } # expand_sex_into_predicate