BUG FIXING : Using LEFT JOIN in replacement of implicit inner joins. WARN NOT FULLY...
[koha.git] / C4 / Members.pm
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 # $Id$
21
22 use strict;
23 require Exporter;
24 use C4::Context;
25 use C4::Date;
26 use Digest::MD5 qw(md5_base64);
27 use Date::Calc qw/Today Add_Delta_YM/;
28 use C4::Log; # logaction
29 use C4::Overdues;
30 use C4::Reserves;
31
32 our ($VERSION,@ISA,@EXPORT,@EXPORT_OK);
33
34 $VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); };
35
36 =head1 NAME
37
38 C4::Members - Perl Module containing convenience functions for member handling
39
40 =head1 SYNOPSIS
41
42 use C4::Members;
43
44 =head1 DESCRIPTION
45
46 This module contains routines for adding, modifying and deleting members/patrons/borrowers 
47
48 =head1 FUNCTIONS
49
50 =over 2
51
52 =cut
53
54 @ISA = qw(Exporter);
55
56 #Get data
57 push @EXPORT, qw(
58   &SearchMember 
59   &GetMemberDetails
60   &GetMember
61   
62   &GetGuarantees 
63   
64   &GetMemberIssuesAndFines
65   &GetPendingIssues
66   &GetAllIssues
67   
68   &get_institutions 
69   &getzipnamecity 
70   &getidcity
71    
72   &GetAge 
73   &GetCities 
74   &GetRoadTypes 
75   &GetRoadTypeDetails 
76   &GetSortDetails
77   &GetTitles    
78   
79   &GetMemberAccountRecords
80   &GetBorNotifyAcctRecord
81   
82   &GetborCatFromCatType 
83   &GetBorrowercategory
84   
85   
86   &GetBorrowersWhoHaveNotBorrowedSince
87   &GetBorrowersWhoHaveNeverBorrowed
88   &GetBorrowersWithIssuesHistoryOlderThan
89   
90   &GetExpiryDate
91 );
92
93 #Modify data
94 push @EXPORT, qw(
95   &ModMember
96   &changepassword
97 );
98   
99 #Delete data
100 push @EXPORT, qw(
101   &DelMember
102 );
103
104 #Insert data
105 push @EXPORT, qw(
106   &AddMember
107   &add_member_orgs
108   &MoveMemberToDeleted
109   &ExtendMemberSubscriptionTo 
110 );
111
112 #Check data
113 push @EXPORT, qw(
114   &checkuniquemember 
115   &checkuserpassword
116         &Check_Userid
117   &fixEthnicity
118   &ethnicitycategories 
119   &fixup_cardnumber
120         &checkcardnumber
121 );
122
123 =item SearchMember
124
125   ($count, $borrowers) = &SearchMember($searchstring, $type,$category_type);
126
127 Looks up patrons (borrowers) by name.
128
129 BUGFIX 499: C<$type> is now used to determine type of search.
130 if $type is "simple", search is performed on the first letter of the
131 surname only.
132
133 $category_type is used to get a specified type of user. 
134 (mainly adults when creating a child.)
135
136 C<$searchstring> is a space-separated list of search terms. Each term
137 must match the beginning a borrower's surname, first name, or other
138 name.
139
140 C<&SearchMember> returns a two-element list. C<$borrowers> is a
141 reference-to-array; each element is a reference-to-hash, whose keys
142 are the fields of the C<borrowers> table in the Koha database.
143 C<$count> is the number of elements in C<$borrowers>.
144
145 =cut
146
147 #'
148 #used by member enquiries from the intranet
149 #called by member.pl
150 sub SearchMember {
151     my ($searchstring, $orderby, $type,$category_type ) = @_;
152     my $dbh   = C4::Context->dbh;
153     my $query = "";
154     my $count;
155     my @data;
156     my @bind = ();
157
158     if ( $type eq "simple" )    # simple search for one letter only
159     {
160         $query =
161           "SELECT * FROM borrowers
162                   LEFT JOIN categories ON borrowers.categorycode=categories.categorycode ".
163                   ($category_type?" AND category_type = ".$dbh->quote($category_type):"").
164                   " WHERE surname LIKE ? OR cardnumber like ? ORDER BY $orderby";
165         @bind = ("$searchstring%","$searchstring");
166     }
167     else    # advanced search looking in surname, firstname and othernames
168     {
169         @data  = split( ' ', $searchstring );
170         $count = @data;
171         $query = "SELECT * FROM borrowers
172                     LEFT JOIN categories ON borrowers.categorycode=categories.categorycode
173                 WHERE ((surname LIKE ? OR surname LIKE ?
174                 OR firstname  LIKE ? OR firstname LIKE ?
175                 OR othernames LIKE ? OR othernames LIKE ?)
176                 ".
177                   ($category_type?" AND category_type = ".$dbh->quote($category_type):"");
178         @bind = (
179             "$data[0]%", "% $data[0]%", "$data[0]%", "% $data[0]%",
180             "$data[0]%", "% $data[0]%"
181         );
182         for ( my $i = 1 ; $i < $count ; $i++ ) {
183             $query = $query . " AND (" . " surname LIKE ? OR surname LIKE ?
184                         OR firstname  LIKE ? OR firstname LIKE ?
185                         OR othernames LIKE ? OR othernames LIKE ?)";
186             push( @bind,
187                 "$data[$i]%",   "% $data[$i]%", "$data[$i]%",
188                 "% $data[$i]%", "$data[$i]%",   "% $data[$i]%" );
189
190             # FIXME - .= <<EOT;
191         }
192         $query = $query . ") OR cardnumber LIKE ?
193                 order by $orderby";
194         push( @bind, $searchstring );
195
196         # FIXME - .= <<EOT;
197     }
198
199     my $sth = $dbh->prepare($query);
200
201     #   warn "Q $orderby : $query";
202     $sth->execute(@bind);
203     my @results;
204     my $data = $sth->fetchall_arrayref({});
205
206     $sth->finish;
207     return ( scalar(@$data), $data );
208 }
209
210 =head2 GetMemberDetails
211
212 ($borrower, $flags) = &GetMemberDetails($borrowernumber, $cardnumber);
213
214 Looks up a patron and returns information about him or her. If
215 C<$borrowernumber> is true (nonzero), C<&GetMemberDetails> looks
216 up the borrower by number; otherwise, it looks up the borrower by card
217 number.
218
219 C<$borrower> is a reference-to-hash whose keys are the fields of the
220 borrowers table in the Koha database. In addition,
221 C<$borrower-E<gt>{flags}> is a hash giving more detailed information
222 about the patron. Its keys act as flags :
223
224     if $borrower->{flags}->{LOST} {
225         # Patron's card was reported lost
226     }
227
228 Each flag has a C<message> key, giving a human-readable explanation of
229 the flag. If the state of a flag means that the patron should not be
230 allowed to borrow any more books, then it will have a C<noissues> key
231 with a true value.
232
233 The possible flags are:
234
235 =head3 CHARGES
236
237 =over 4
238
239 =item Shows the patron's credit or debt, if any.
240
241 =back
242
243 =head3 GNA
244
245 =over 4
246
247 =item (Gone, no address.) Set if the patron has left without giving a
248 forwarding address.
249
250 =back
251
252 =head3 LOST
253
254 =over 4
255
256 =item Set if the patron's card has been reported as lost.
257
258 =back
259
260 =head3 DBARRED
261
262 =over 4
263
264 =item Set if the patron has been debarred.
265
266 =back
267
268 =head3 NOTES
269
270 =over 4
271
272 =item Any additional notes about the patron.
273
274 =back
275
276 =head3 ODUES
277
278 =over 4
279
280 =item Set if the patron has overdue items. This flag has several keys:
281
282 C<$flags-E<gt>{ODUES}{itemlist}> is a reference-to-array listing the
283 overdue items. Its elements are references-to-hash, each describing an
284 overdue item. The keys are selected fields from the issues, biblio,
285 biblioitems, and items tables of the Koha database.
286
287 C<$flags-E<gt>{ODUES}{itemlist}> is a string giving a text listing of
288 the overdue items, one per line.
289
290 =back
291
292 =head3 WAITING
293
294 =over 4
295
296 =item Set if any items that the patron has reserved are available.
297
298 C<$flags-E<gt>{WAITING}{itemlist}> is a reference-to-array listing the
299 available items. Each element is a reference-to-hash whose keys are
300 fields from the reserves table of the Koha database.
301
302 =back
303
304 =cut
305
306 sub GetMemberDetails {
307     my ( $borrowernumber, $cardnumber ) = @_;
308     my $dbh = C4::Context->dbh;
309     my $query;
310     my $sth;
311     if ($borrowernumber) {
312         $sth = $dbh->prepare("select * from borrowers where borrowernumber=?");
313         $sth->execute($borrowernumber);
314     }
315     elsif ($cardnumber) {
316         $sth = $dbh->prepare("select * from borrowers where cardnumber=?");
317         $sth->execute($cardnumber);
318     }
319     else {
320         return undef;
321     }
322     my $borrower = $sth->fetchrow_hashref;
323     my ($amount) = GetMemberAccountRecords( $borrowernumber);
324     $borrower->{'amountoutstanding'} = $amount;
325     my $flags = patronflags( $borrower);
326     my $accessflagshash;
327
328     $sth = $dbh->prepare("select bit,flag from userflags");
329     $sth->execute;
330     while ( my ( $bit, $flag ) = $sth->fetchrow ) {
331         if ( $borrower->{'flags'} && $borrower->{'flags'} & 2**$bit ) {
332             $accessflagshash->{$flag} = 1;
333         }
334     }
335     $sth->finish;
336     $borrower->{'flags'}     = $flags;
337     $borrower->{'authflags'} = $accessflagshash;
338
339     # find out how long the membership lasts
340     $sth =
341       $dbh->prepare(
342         "select enrolmentperiod from categories where categorycode = ?");
343     $sth->execute( $borrower->{'categorycode'} );
344     my $enrolment = $sth->fetchrow;
345     $borrower->{'enrolmentperiod'} = $enrolment;
346     return ($borrower);    #, $flags, $accessflagshash);
347 }
348
349 =head2 patronflags
350
351  Not exported
352
353  NOTE!: If you change this function, be sure to update the POD for
354  &GetMemberDetails.
355
356  $flags = &patronflags($patron);
357
358  $flags->{CHARGES}
359         {message}    Message showing patron's credit or debt
360        {noissues}    Set if patron owes >$5.00
361          {GNA}            Set if patron gone w/o address
362         {message}    "Borrower has no valid address"
363         {noissues}    Set.
364         {LOST}        Set if patron's card reported lost
365         {message}    Message to this effect
366         {noissues}    Set.
367         {DBARRED}        Set is patron is debarred
368         {message}    Message to this effect
369         {noissues}    Set.
370          {NOTES}        Set if patron has notes
371         {message}    Notes about patron
372          {ODUES}        Set if patron has overdue books
373         {message}    "Yes"
374         {itemlist}    ref-to-array: list of overdue books
375         {itemlisttext}    Text list of overdue items
376          {WAITING}        Set if there are items available that the
377                 patron reserved
378         {message}    Message to this effect
379         {itemlist}    ref-to-array: list of available items
380
381 =cut
382
383 sub patronflags {
384     my %flags;
385     my ( $patroninformation) = @_;
386     my $dbh=C4::Context->dbh;
387     my ($amount) = GetMemberAccountRecords( $patroninformation->{'borrowernumber'});
388     if ( $amount > 0 ) {
389         my %flaginfo;
390         my $noissuescharge = C4::Context->preference("noissuescharge");
391         $flaginfo{'message'} = sprintf "Patron owes \$%.02f", $amount;
392         if ( $amount > $noissuescharge ) {
393             $flaginfo{'noissues'} = 1;
394         }
395         $flags{'CHARGES'} = \%flaginfo;
396     }
397     elsif ( $amount < 0 ) {
398         my %flaginfo;
399         $flaginfo{'message'} = sprintf "Patron has credit of \$%.02f", -$amount;
400         $flags{'CHARGES'} = \%flaginfo;
401     }
402     if (   $patroninformation->{'gonenoaddress'}
403         && $patroninformation->{'gonenoaddress'} == 1 )
404     {
405         my %flaginfo;
406         $flaginfo{'message'}  = 'Borrower has no valid address.';
407         $flaginfo{'noissues'} = 1;
408         $flags{'GNA'}         = \%flaginfo;
409     }
410     if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
411         my %flaginfo;
412         $flaginfo{'message'}  = 'Borrower\'s card reported lost.';
413         $flaginfo{'noissues'} = 1;
414         $flags{'LOST'}        = \%flaginfo;
415     }
416     if (   $patroninformation->{'debarred'}
417         && $patroninformation->{'debarred'} == 1 )
418     {
419         my %flaginfo;
420         $flaginfo{'message'}  = 'Borrower is Debarred.';
421         $flaginfo{'noissues'} = 1;
422         $flags{'DBARRED'}     = \%flaginfo;
423     }
424     if (   $patroninformation->{'borrowernotes'}
425         && $patroninformation->{'borrowernotes'} )
426     {
427         my %flaginfo;
428         $flaginfo{'message'} = "$patroninformation->{'borrowernotes'}";
429         $flags{'NOTES'}      = \%flaginfo;
430     }
431     my ( $odues, $itemsoverdue ) =
432       checkoverdues( $patroninformation->{'borrowernumber'}, $dbh );
433     if ( $odues > 0 ) {
434         my %flaginfo;
435         $flaginfo{'message'}  = "Yes";
436         $flaginfo{'itemlist'} = $itemsoverdue;
437         foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
438             @$itemsoverdue )
439         {
440             $flaginfo{'itemlisttext'} .=
441               "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n";
442         }
443         $flags{'ODUES'} = \%flaginfo;
444     }
445     my @itemswaiting = C4::Reserves::GetReservesFromBorrowernumber( $patroninformation->{'borrowernumber'},'W' );
446     my $nowaiting = scalar @itemswaiting;
447     if ( $nowaiting > 0 ) {
448         my %flaginfo;
449         $flaginfo{'message'}  = "Reserved items available";
450         $flaginfo{'itemlist'} = \@itemswaiting;
451         $flags{'WAITING'}     = \%flaginfo;
452     }
453     return ( \%flags );
454 }
455
456
457 =item GetMember
458
459   $borrower = &GetMember($information, $type);
460
461 Looks up information about a patron (borrower) by either card number
462 ,firstname, or borrower number, depending on $type value.
463 If C<$type> == 'cardnumber', C<&GetBorrower>
464 searches by cardnumber then by firstname if not found in cardnumber; 
465 otherwise, it searches by borrowernumber.
466
467 C<&GetBorrower> returns a reference-to-hash whose keys are the fields of
468 the C<borrowers> table in the Koha database.
469
470 =cut
471
472 #'
473 sub GetMember {
474     my ( $information, $type ) = @_;
475     my $dbh = C4::Context->dbh;
476     my $sth;
477     if ($type eq 'cardnumber' || $type eq 'firstname'|| $type eq 'userid'|| $type eq 'borrowernumber'){
478       $information = uc $information;
479       $sth =
480           $dbh->prepare(
481 "Select borrowers.*,categories.category_type,categories.description  from borrowers left join categories on borrowers.categorycode=categories.categorycode where $type=?"
482           );
483         $sth->execute($information);
484     }
485     else {
486         $sth =
487           $dbh->prepare(
488 "Select borrowers.*,categories.category_type, categories.description from borrowers left join categories on borrowers.categorycode=categories.categorycode where borrowernumber=?"
489           );
490         $sth->execute($information);
491     }
492     my $data = $sth->fetchrow_hashref;
493
494     $sth->finish;
495     if ($data) {
496         return ($data);
497     }
498     elsif ($type eq 'cardnumber' ||$type eq 'firstname') {    # try with firstname
499         my $sth =
500               $dbh->prepare(
501 "Select borrowers.*,categories.category_type,categories.description from borrowers left join categories on borrowers.categorycode=categories.categorycode  where firstname like ?"
502             );
503             $sth->execute($information);
504             my $data = $sth->fetchrow_hashref;
505             $sth->finish;
506             return ($data);
507     }
508     else {
509         return undef;        
510     }
511 }
512
513 =item GetMemberIssuesAndFines
514
515   ($borrowed, $due, $fine) = &GetMemberIssuesAndFines($borrowernumber);
516
517 Returns aggregate data about items borrowed by the patron with the
518 given borrowernumber.
519
520 C<&GetMemberIssuesAndFines> returns a three-element array. C<$borrowed> is the
521 number of books the patron currently has borrowed. C<$due> is the
522 number of overdue items the patron currently has borrowed. C<$fine> is
523 the total fine currently due by the borrower.
524
525 =cut
526
527 #'
528 sub GetMemberIssuesAndFines {
529     my ( $borrowernumber ) = @_;
530     my $dbh   = C4::Context->dbh;
531     my $query =
532       "Select count(*) from issues where borrowernumber='$borrowernumber' and
533     returndate is NULL";
534
535     # print $query;
536     my $sth = $dbh->prepare($query);
537     $sth->execute;
538     my $data = $sth->fetchrow_hashref;
539     $sth->finish;
540     $sth = $dbh->prepare(
541         "Select count(*) from issues where
542     borrowernumber='$borrowernumber' and date_due < now() and returndate is NULL"
543     );
544     $sth->execute;
545     my $data2 = $sth->fetchrow_hashref;
546     $sth->finish;
547     $sth = $dbh->prepare(
548         "Select sum(amountoutstanding) from accountlines where
549     borrowernumber='$borrowernumber'"
550     );
551     $sth->execute;
552     my $data3 = $sth->fetchrow_hashref;
553     $sth->finish;
554
555     return ( $data2->{'count(*)'}, $data->{'count(*)'},
556         $data3->{'sum(amountoutstanding)'} );
557 }
558
559 =head2
560
561 =item ModMember
562
563   &ModMember($borrowernumber);
564
565 Modify borrower's data
566
567 =cut
568
569 #'
570 sub ModMember {
571     my (%data) = @_;
572     my $dbh = C4::Context->dbh;
573     $data{'dateofbirth'}  = format_date_in_iso( $data{'dateofbirth'} ) if ($data{'dateofbirth'} );
574     $data{'dateexpiry'}   = format_date_in_iso( $data{'dateexpiry'} ) if ($data{'dateexpiry'} );
575     $data{'dateenrolled'} = format_date_in_iso( $data{'dateenrolled'} ) if ($data{'dateenrolled'} );
576 #     warn Data::Dumper::Dumper(%data);
577     #   warn "num user".$data{'borrowernumber'};
578     my $qborrower=$dbh->prepare("SHOW columns from borrowers");
579     $qborrower->execute;
580     my %hashborrowerfields;  
581     while (my ($field)=$qborrower->fetchrow){
582       $hashborrowerfields{$field}=1;
583     }  
584     my $query;
585     my $sth;
586     $data{'userid'} = '' if ( $data{'password'} eq '' );  
587     my @parameters;  
588     
589     # test to know if u must update or not the borrower password
590     if ( $data{'password'} eq '****' ) {
591         delete $data{'password'};
592         foreach (keys %data)
593         {push @parameters,"$_ = ".$dbh->quote($data{$_}) if ($_ ne "borrowernumber" and $hashborrowerfields{$_}) } ;
594         $query = "UPDATE borrowers SET ".join (",",@parameters)
595     ." WHERE borrowernumber=$data{'borrowernumber'}";
596 #         warn "$query";
597         $sth = $dbh->prepare($query);
598         $sth->execute;
599     }
600     else {
601         $data{'password'} = md5_base64( $data{'password'} )   if ( $data{'password'} ne '' );
602         delete $data{'password'} if ($data{password} eq "");
603         foreach (keys %data)
604         {push @parameters,"$_ = ".$dbh->quote($data{$_}) if ($_ ne "borrowernumber" and $hashborrowerfields{$_})} ;
605         
606         $query = "UPDATE borrowers SET ".join (",",@parameters)." WHERE borrowernumber=$data{'borrowernumber'}";
607 #         warn "$query";
608         $sth = $dbh->prepare($query);
609         $sth->execute;
610     }
611     $sth->finish;
612
613 # ok if its an adult (type) it may have borrowers that depend on it as a guarantor
614 # so when we update information for an adult we should check for guarantees and update the relevant part
615 # of their records, ie addresses and phone numbers
616     my $borrowercategory= GetBorrowercategory( $data{'category_type'} );
617     if ( $borrowercategory->{'category_type'} eq 'A' ) {
618         # is adult check guarantees;
619         UpdateGuarantees(%data);
620
621     }
622     &logaction(C4::Context->userenv->{'number'},"MEMBERS","MODIFY",$data{'borrowernumber'},"") 
623         if C4::Context->preference("BorrowersLog");
624 }
625
626
627 =head2
628
629 =item AddMember
630
631   $borrowernumber = &AddMember(%borrower);
632
633 insert new borrower into table
634 Returns the borrowernumber
635
636 =cut
637
638 #'
639 sub AddMember {
640     my (%data) = @_;
641     my $dbh = C4::Context->dbh;
642     $data{'userid'} = '' unless $data{'password'};
643     $data{'password'} = md5_base64( $data{'password'} ) if $data{'password'};
644     $data{'dateofbirth'} = format_date_in_iso( $data{'dateofbirth'} );
645     $data{'dateenrolled'} = format_date_in_iso( $data{'dateenrolled'} );
646     $data{'dateexpiry'}   = format_date_in_iso( $data{'dateexpiry'} );
647     my $query =
648         "insert into borrowers set cardnumber="
649       . $dbh->quote( $data{'cardnumber'} )
650       . ",surname="
651       . $dbh->quote( $data{'surname'} )
652       . ",firstname="
653       . $dbh->quote( $data{'firstname'} )
654       . ",title="
655       . $dbh->quote( $data{'title'} )
656       . ",othernames="
657       . $dbh->quote( $data{'othernames'} )
658       . ",initials="
659       . $dbh->quote( $data{'initials'} )
660       . ",streetnumber="
661       . $dbh->quote( $data{'streetnumber'} )
662       . ",streettype="
663       . $dbh->quote( $data{'streettype'} )
664       . ",address="
665       . $dbh->quote( $data{'address'} )
666       . ",address2="
667       . $dbh->quote( $data{'address2'} )
668       . ",zipcode="
669       . $dbh->quote( $data{'zipcode'} )
670       . ",city="
671       . $dbh->quote( $data{'city'} )
672       . ",phone="
673       . $dbh->quote( $data{'phone'} )
674       . ",email="
675       . $dbh->quote( $data{'email'} )
676       . ",mobile="
677       . $dbh->quote( $data{'mobile'} )
678       . ",phonepro="
679       . $dbh->quote( $data{'phonepro'} )
680       . ",opacnote="
681       . $dbh->quote( $data{'opacnote'} )
682       . ",guarantorid="
683       . $dbh->quote( $data{'guarantorid'} )
684       . ",dateofbirth="
685       . $dbh->quote( $data{'dateofbirth'} )
686       . ",branchcode="
687       . $dbh->quote( $data{'branchcode'} )
688       . ",categorycode="
689       . $dbh->quote( $data{'categorycode'} )
690       . ",dateenrolled="
691       . $dbh->quote( $data{'dateenrolled'} )
692       . ",contactname="
693       . $dbh->quote( $data{'contactname'} )
694       . ",borrowernotes="
695       . $dbh->quote( $data{'borrowernotes'} )
696       . ",dateexpiry="
697       . $dbh->quote( $data{'dateexpiry'} )
698       . ",contactnote="
699       . $dbh->quote( $data{'contactnote'} )
700       . ",B_address="
701       . $dbh->quote( $data{'B_address'} )
702       . ",B_zipcode="
703       . $dbh->quote( $data{'B_zipcode'} )
704       . ",B_city="
705       . $dbh->quote( $data{'B_city'} )
706       . ",B_phone="
707       . $dbh->quote( $data{'B_phone'} )
708       . ",B_email="
709       . $dbh->quote( $data{'B_email'}, )
710       . ",password="
711       . $dbh->quote( $data{'password'} )
712       . ",userid="
713       . $dbh->quote( $data{'userid'} )
714       . ",sort1="
715       . $dbh->quote( $data{'sort1'} )
716       . ",sort2="
717       . $dbh->quote( $data{'sort2'} )
718       . ",contacttitle="
719       . $dbh->quote( $data{'contacttitle'} )
720       . ",emailpro="
721       . $dbh->quote( $data{'emailpro'} )
722       . ",contactfirstname="
723       . $dbh->quote( $data{'contactfirstname'} ) . ",sex="
724       . $dbh->quote( $data{'sex'} ) . ",fax="
725       . $dbh->quote( $data{'fax'} )
726       . ",relationship="
727       . $dbh->quote( $data{'relationship'} )
728       . ",B_streetnumber="
729       . $dbh->quote( $data{'B_streetnumber'} )
730       . ",B_streettype="
731       . $dbh->quote( $data{'B_streettype'} )
732       . ",gonenoaddress="
733       . $dbh->quote( $data{'gonenoaddress'} )
734       . ",lost="
735       . $dbh->quote( $data{'lost'} )
736       . ",debarred="
737       . $dbh->quote( $data{'debarred'} )
738       . ",ethnicity="
739       . $dbh->quote( $data{'ethnicity'} )
740       . ",ethnotes="
741       . $dbh->quote( $data{'ethnotes'} );
742
743     my $sth = $dbh->prepare($query);
744     $sth->execute;
745     $sth->finish;
746     $data{'borrowernumber'} = $dbh->{'mysql_insertid'};
747     
748     &logaction(C4::Context->userenv->{'number'},"MEMBERS","CREATE",$data{'borrowernumber'},"") 
749         if C4::Context->preference("BorrowersLog");
750         
751     return $data{'borrowernumber'};
752 }
753
754 sub Check_Userid {
755         my ($uid,$member) = @_;
756         my $dbh = C4::Context->dbh;
757     # Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
758     # Then we need to tell the user and have them create a new one.
759     my $sth =
760       $dbh->prepare(
761         "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
762     $sth->execute( $uid, $member );
763     if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
764         return 0;
765     }
766         else {
767                 return 1;
768         }
769 }
770
771
772 sub changepassword {
773     my ( $uid, $member, $digest ) = @_;
774     my $dbh = C4::Context->dbh;
775
776 #Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
777 #Then we need to tell the user and have them create a new one.
778     my $sth =
779       $dbh->prepare(
780         "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
781     $sth->execute( $uid, $member );
782     if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
783         return 0;
784     }
785     else {
786         #Everything is good so we can update the information.
787         $sth =
788           $dbh->prepare(
789             "update borrowers set userid=?, password=? where borrowernumber=?");
790         $sth->execute( $uid, $digest, $member );
791         return 1;
792     }
793     
794     &logaction(C4::Context->userenv->{'number'},"MEMBERS","CHANGE PASS",$member,"") 
795         if C4::Context->preference("BorrowersLog");
796 }
797
798
799
800 =item fixup_cardnumber
801
802 Warning: The caller is responsible for locking the members table in write
803 mode, to avoid database corruption.
804
805 =cut
806
807 use vars qw( @weightings );
808 my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
809
810 sub fixup_cardnumber ($) {
811     my ($cardnumber) = @_;
812     my $autonumber_members = C4::Context->boolean_preference('autoMemberNum');
813     $autonumber_members = 0 unless defined $autonumber_members;
814
815     # Find out whether member numbers should be generated
816     # automatically. Should be either "1" or something else.
817     # Defaults to "0", which is interpreted as "no".
818
819     #     if ($cardnumber !~ /\S/ && $autonumber_members) {
820     if ($autonumber_members) {
821         my $dbh = C4::Context->dbh;
822         if ( C4::Context->preference('checkdigit') eq 'katipo' ) {
823
824             # if checkdigit is selected, calculate katipo-style cardnumber.
825             # otherwise, just use the max()
826             # purpose: generate checksum'd member numbers.
827             # We'll assume we just got the max value of digits 2-8 of member #'s
828             # from the database and our job is to increment that by one,
829             # determine the 1st and 9th digits and return the full string.
830             my $sth =
831               $dbh->prepare(
832                 "select max(substring(borrowers.cardnumber,2,7)) from borrowers"
833               );
834             $sth->execute;
835
836             my $data = $sth->fetchrow_hashref;
837             $cardnumber = $data->{'max(substring(borrowers.cardnumber,2,7))'};
838             $sth->finish;
839             if ( !$cardnumber ) {    # If DB has no values,
840                 $cardnumber = 1000000;    # start at 1000000
841             }
842             else {
843                 $cardnumber += 1;
844             }
845
846             my $sum = 0;
847             for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
848
849                 # read weightings, left to right, 1 char at a time
850                 my $temp1 = $weightings[$i];
851
852                 # sequence left to right, 1 char at a time
853                 my $temp2 = substr( $cardnumber, $i, 1 );
854
855                 # mult each char 1-7 by its corresponding weighting
856                 $sum += $temp1 * $temp2;
857             }
858
859             my $rem = ( $sum % 11 );
860             $rem = 'X' if $rem == 10;
861
862             $cardnumber = "V$cardnumber$rem";
863         }
864         else {
865
866      # MODIFIED BY JF: mysql4.1 allows casting as an integer, which is probably
867      # better. I'll leave the original in in case it needs to be changed for you
868             my $sth =
869               $dbh->prepare(
870                 "select max(cast(cardnumber as signed)) from borrowers");
871
872       #my $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers");
873
874             $sth->execute;
875
876             my ($result) = $sth->fetchrow;
877             $sth->finish;
878             $cardnumber = $result + 1;
879         }
880     }
881     return $cardnumber;
882 }
883
884 =head2 GetGuarantees
885
886   ($num_children, $children_arrayref) = &GetGuarantees($parent_borrno);
887   $child0_cardno = $children_arrayref->[0]{"cardnumber"};
888   $child0_borrno = $children_arrayref->[0]{"borrowernumber"};
889
890 C<&GetGuarantees> takes a borrower number (e.g., that of a patron
891 with children) and looks up the borrowers who are guaranteed by that
892 borrower (i.e., the patron's children).
893
894 C<&GetGuarantees> returns two values: an integer giving the number of
895 borrowers guaranteed by C<$parent_borrno>, and a reference to an array
896 of references to hash, which gives the actual results.
897
898 =cut
899
900 #'
901 sub GetGuarantees {
902     my ($borrowernumber) = @_;
903     my $dbh              = C4::Context->dbh;
904     my $sth              =
905       $dbh->prepare(
906 "select cardnumber,borrowernumber, firstname, surname from borrowers where guarantorid=?"
907       );
908     $sth->execute($borrowernumber);
909
910     my @dat;
911     my $data = $sth->fetchall_arrayref({}); 
912     $sth->finish;
913     return ( scalar(@$data), $data );
914 }
915
916 =head2 UpdateGuarantees
917
918   &UpdateGuarantees($parent_borrno);
919   
920
921 C<&UpdateGuarantees> borrower data for an adulte and updates all the guarantees
922 with the modified information
923
924 =cut
925
926 #'
927 sub UpdateGuarantees {
928     my (%data) = @_;
929     my $dbh = C4::Context->dbh;
930     my ( $count, $guarantees ) = GetGuarantees( $data{'borrowernumber'} );
931     for ( my $i = 0 ; $i < $count ; $i++ ) {
932
933         # FIXME
934         # It looks like the $i is only being returned to handle walking through
935         # the array, which is probably better done as a foreach loop.
936         #
937         my $guaquery = qq|UPDATE borrowers 
938                           SET address='$data{'address'}',fax='$data{'fax'}',
939                               B_city='$data{'B_city'}',mobile='$data{'mobile'}',city='$data{'city'}',phone='$data{'phone'}'
940                           WHERE borrowernumber='$guarantees->[$i]->{'borrowernumber'}'
941                 |;
942         my $sth3 = $dbh->prepare($guaquery);
943         $sth3->execute;
944         $sth3->finish;
945     }
946 }
947 =head2 GetPendingIssues
948
949   ($count, $issues) = &GetPendingIssues($borrowernumber);
950
951 Looks up what the patron with the given borrowernumber has borrowed.
952
953 C<&GetPendingIssues> returns a two-element array. C<$issues> is a
954 reference-to-array, where each element is a reference-to-hash; the
955 keys are the fields from the C<issues>, C<biblio>, and C<items> tables
956 in the Koha database. C<$count> is the number of elements in
957 C<$issues>.
958
959 =cut
960
961 #'
962 sub GetPendingIssues {
963     my ($borrowernumber) = @_;
964     my $dbh              = C4::Context->dbh;
965
966     my $sth              = $dbh->prepare(
967    "SELECT * FROM issues 
968       LEFT JOIN items ON issues.itemnumber=items.itemnumber
969       LEFT JOIN biblio ON     items.biblionumber=biblio.biblionumber 
970       LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
971     WHERE
972       borrowernumber=? 
973       AND returndate IS NULL
974     ORDER BY issues.issuedate"
975     );
976     $sth->execute($borrowernumber);
977     my $data = $sth->fetchall_arrayref({});
978     my $today = POSIX::strftime("%Y%m%d", localtime);
979     foreach( @$data ) {
980         my $datedue = $_->{'date_due'};
981         $datedue =~ s/-//g;
982         if ( $datedue < $today ) {
983             $_->{'overdue'} = 1;
984         }
985     }
986     $sth->finish;
987     return ( scalar(@$data), $data );
988 }
989
990 =head2 GetAllIssues
991
992   ($count, $issues) = &GetAllIssues($borrowernumber, $sortkey, $limit);
993
994 Looks up what the patron with the given borrowernumber has borrowed,
995 and sorts the results.
996
997 C<$sortkey> is the name of a field on which to sort the results. This
998 should be the name of a field in the C<issues>, C<biblio>,
999 C<biblioitems>, or C<items> table in the Koha database.
1000
1001 C<$limit> is the maximum number of results to return.
1002
1003 C<&GetAllIssues> returns a two-element array. C<$issues> is a
1004 reference-to-array, where each element is a reference-to-hash; the
1005 keys are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
1006 C<items> tables of the Koha database. C<$count> is the number of
1007 elements in C<$issues>
1008
1009 =cut
1010
1011 #'
1012 sub GetAllIssues {
1013     my ( $borrowernumber, $order, $limit ) = @_;
1014
1015     #FIXME: sanity-check order and limit
1016     my $dbh   = C4::Context->dbh;
1017     my $count = 0;
1018     my $query =
1019   "Select *,items.timestamp AS itemstimestamp from 
1020   issues 
1021   LEFT JOIN items on items.itemnumber=issues.itemnumber
1022   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1023   LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1024   where borrowernumber=? 
1025   order by $order";
1026     if ( $limit != 0 ) {
1027         $query .= " limit $limit";
1028     }
1029
1030     #print $query;
1031     my $sth = $dbh->prepare($query);
1032     $sth->execute($borrowernumber);
1033     my @result;
1034     my $i = 0;
1035     while ( my $data = $sth->fetchrow_hashref ) {
1036         $result[$i] = $data;
1037         $i++;
1038         $count++;
1039     }
1040
1041     # get all issued items for borrowernumber from oldissues table
1042     # large chunk of older issues data put into table oldissues
1043     # to speed up db calls for issuing items
1044     if ( C4::Context->preference("ReadingHistory") ) {
1045         my $query2 = "SELECT * FROM oldissues
1046                       LEFT JOIN items ON items.itemnumber=oldissues.itemnumber
1047                       LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1048                       LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1049                       WHERE borrowernumber=? 
1050                       ORDER BY $order";
1051         if ( $limit != 0 ) {
1052             $limit = $limit - $count;
1053             $query2 .= " limit $limit";
1054         }
1055
1056         my $sth2 = $dbh->prepare($query2);
1057         $sth2->execute($borrowernumber);
1058
1059         while ( my $data2 = $sth2->fetchrow_hashref ) {
1060             $result[$i] = $data2;
1061             $i++;
1062         }
1063         $sth2->finish;
1064     }
1065     $sth->finish;
1066
1067     return ( $i, \@result );
1068 }
1069
1070
1071 =head2 GetMemberAccountRecords
1072
1073   ($total, $acctlines, $count) = &GetMemberAccountRecords($borrowernumber);
1074
1075 Looks up accounting data for the patron with the given borrowernumber.
1076
1077 C<&GetMemberAccountRecords> returns a three-element array. C<$acctlines> is a
1078 reference-to-array, where each element is a reference-to-hash; the
1079 keys are the fields of the C<accountlines> table in the Koha database.
1080 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1081 total amount outstanding for all of the account lines.
1082
1083 =cut
1084
1085 #'
1086 sub GetMemberAccountRecords {
1087     my ($borrowernumber,$date) = @_;
1088     my $dbh = C4::Context->dbh;
1089     my @acctlines;
1090     my $numlines = 0;
1091     my $strsth      = qq(
1092 SELECT * 
1093 FROM accountlines 
1094 WHERE borrowernumber=?);
1095     my @bind = ($borrowernumber);
1096     if ($date && $date ne ''){
1097     $strsth.="
1098 AND date < ? ";
1099     push(@bind,$date);
1100     }
1101     $strsth.="
1102 ORDER BY date desc,timestamp DESC";
1103     my $sth= $dbh->prepare( $strsth );
1104     $sth->execute( @bind );
1105     my $total = 0;
1106     while ( my $data = $sth->fetchrow_hashref ) {
1107         $acctlines[$numlines] = $data;
1108         $numlines++;
1109         $total += $data->{'amountoutstanding'};
1110     }
1111     $sth->finish;
1112     return ( $total, \@acctlines,$numlines);
1113 }
1114
1115 =head2 GetBorNotifyAcctRecord
1116
1117   ($count, $acctlines, $total) = &GetBorNotifyAcctRecord($params,$notifyid);
1118
1119 Looks up accounting data for the patron with the given borrowernumber per file number.
1120
1121 (FIXME - I'm not at all sure what this is about.)
1122
1123 C<&GetBorNotifyAcctRecord> returns a three-element array. C<$acctlines> is a
1124 reference-to-array, where each element is a reference-to-hash; the
1125 keys are the fields of the C<accountlines> table in the Koha database.
1126 C<$count> is the number of elements in C<$acctlines>. C<$total> is the
1127 total amount outstanding for all of the account lines.
1128
1129 =cut
1130
1131 sub GetBorNotifyAcctRecord {
1132     my ( $borrowernumber, $notifyid ) = @_;
1133     my $dbh = C4::Context->dbh;
1134     my @acctlines;
1135     my $numlines = 0;
1136     my $query    = qq|  SELECT * 
1137                         FROM accountlines 
1138                         WHERE borrowernumber=? 
1139                         AND notify_id=? 
1140                         AND (accounttype='FU' OR accounttype='N' OR accounttype='M'OR accounttype='A'OR accounttype='F'OR accounttype='L' OR accounttype='IP' OR accounttype='CH' OR accounttype='RE' OR accounttype='RL')
1141                         AND amountoutstanding != '0' 
1142                         ORDER BY notify_id,accounttype
1143                 |;
1144     my $sth = $dbh->prepare($query);
1145
1146     $sth->execute( $borrowernumber, $notifyid );
1147     my $total = 0;
1148     while ( my $data = $sth->fetchrow_hashref ) {
1149         $acctlines[$numlines] = $data;
1150         $numlines++;
1151         $total += $data->{'amountoutstanding'};
1152     }
1153     $sth->finish;
1154     return ( $total, \@acctlines, $numlines );
1155 }
1156
1157 =head2 checkuniquemember (OUEST-PROVENCE)
1158
1159   $result = &checkuniquemember($collectivity,$surname,$categorycode,$firstname,$dateofbirth);
1160
1161 Checks that a member exists or not in the database.
1162
1163 C<&result> is 1 (=exist) or 0 (=does not exist)
1164 C<&collectivity> is 1 (= we add a collectivity) or 0 (= we add a physical member)
1165 C<&surname> is the surname
1166 C<&categorycode> is from categorycode table
1167 C<&firstname> is the firstname (only if collectivity=0)
1168 C<&dateofbirth> is the date of birth (only if collectivity=0)
1169
1170 =cut
1171
1172 sub checkuniquemember {
1173     my ( $collectivity, $surname, $firstname, $dateofbirth ) = @_;
1174     my $dbh = C4::Context->dbh;
1175     my $request;
1176     if ($collectivity) {
1177
1178 #                               $request="select count(*) from borrowers where surname=? and categorycode=?";
1179         $request =
1180           "select borrowernumber,categorycode from borrowers where surname=? ";
1181     }
1182     else {
1183
1184 #                               $request="select count(*) from borrowers where surname=? and categorycode=? and firstname=? and dateofbirth=?";
1185         $request =
1186 "select borrowernumber,categorycode from borrowers where surname=?  and firstname=? and dateofbirth=?";
1187     }
1188     my $sth = $dbh->prepare($request);
1189     if ($collectivity) {
1190         $sth->execute( uc($surname) );
1191     }
1192     else {
1193         $sth->execute( uc($surname), ucfirst($firstname), $dateofbirth );
1194     }
1195     my @data = $sth->fetchrow;
1196     if ( $data[0] ) {
1197         $sth->finish;
1198         return $data[0], $data[1];
1199
1200         #
1201     }
1202     else {
1203         $sth->finish;
1204         return 0;
1205     }
1206 }
1207
1208 sub checkcardnumber {
1209         my ($cardnumber) = @_;
1210         my $dbh = C4::Context->dbh;
1211         my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
1212         my $sth = $dbh->prepare($query);
1213         $sth->execute($cardnumber);
1214         if (my $data= $sth->fetchrow_hashref()){
1215                 return 1;
1216         }
1217         else {
1218                 return 0;
1219         }
1220         $sth->finish();
1221 }  
1222
1223
1224 =head2 getzipnamecity (OUEST-PROVENCE)
1225
1226 take all info from table city for the fields city and  zip
1227 check for the name and the zip code of the city selected
1228
1229 =cut
1230
1231 sub getzipnamecity {
1232     my ($cityid) = @_;
1233     my $dbh      = C4::Context->dbh;
1234     my $sth      =
1235       $dbh->prepare(
1236         "select city_name,city_zipcode from cities where cityid=? ");
1237     $sth->execute($cityid);
1238     my @data = $sth->fetchrow;
1239     return $data[0], $data[1];
1240 }
1241
1242
1243 =head2 getdcity (OUEST-PROVENCE)
1244
1245 recover cityid  with city_name condition
1246
1247 =cut
1248
1249 sub getidcity {
1250     my ($city_name) = @_;
1251     my $dbh = C4::Context->dbh;
1252     my $sth = $dbh->prepare("select cityid from cities where city_name=? ");
1253     $sth->execute($city_name);
1254     my $data = $sth->fetchrow;
1255     return $data;
1256 }
1257
1258
1259 =head2 GetExpiryDate 
1260
1261   $expirydate = GetExpiryDate($categorycode, $dateenrolled);
1262 process expiry date given a date and a categorycode
1263
1264 =cut
1265 sub GetExpiryDate {
1266     my ( $categorycode, $dateenrolled ) = @_;
1267     my $dbh = C4::Context->dbh;
1268     my $sth =
1269       $dbh->prepare(
1270         "select enrolmentperiod from categories where categorycode=?");
1271     $sth->execute($categorycode);
1272     my ($enrolmentperiod) = $sth->fetchrow;
1273     $enrolmentperiod = 12 unless ($enrolmentperiod);
1274     my @date=split /-/,format_date_in_iso($dateenrolled);
1275     @date=Add_Delta_YM($date[0],$date[1],$date[2],0,$enrolmentperiod);
1276     return sprintf("%04d-%02d-%02d",$date[0],$date[1],$date[2]);
1277 }
1278
1279 =head2 checkuserpassword (OUEST-PROVENCE)
1280
1281 check for the password and login are not used
1282 return the number of record 
1283 0=> NOT USED 1=> USED
1284
1285 =cut
1286
1287 sub checkuserpassword {
1288     my ( $borrowernumber, $userid, $password ) = @_;
1289     $password = md5_base64($password);
1290     my $dbh = C4::Context->dbh;
1291     my $sth =
1292       $dbh->prepare(
1293 "Select count(*) from borrowers where borrowernumber !=? and userid =? and password=? "
1294       );
1295     $sth->execute( $borrowernumber, $userid, $password );
1296     my $number_rows = $sth->fetchrow;
1297     return $number_rows;
1298
1299 }
1300
1301 =head2 GetborCatFromCatType
1302
1303   ($codes_arrayref, $labels_hashref) = &GetborCatFromCatType();
1304
1305 Looks up the different types of borrowers in the database. Returns two
1306 elements: a reference-to-array, which lists the borrower category
1307 codes, and a reference-to-hash, which maps the borrower category codes
1308 to category descriptions.
1309
1310 =cut
1311
1312 #'
1313 sub GetborCatFromCatType {
1314     my ( $category_type, $action ) = @_;
1315     my $dbh     = C4::Context->dbh;
1316     my $request = qq|   SELECT categorycode,description 
1317                         FROM categories 
1318                         $action
1319                         ORDER BY categorycode|;
1320     my $sth = $dbh->prepare($request);
1321     if ($action) {
1322         $sth->execute($category_type);
1323     }
1324     else {
1325         $sth->execute();
1326     }
1327
1328     my %labels;
1329     my @codes;
1330
1331     while ( my $data = $sth->fetchrow_hashref ) {
1332         push @codes, $data->{'categorycode'};
1333         $labels{ $data->{'categorycode'} } = $data->{'description'};
1334     }
1335     $sth->finish;
1336     return ( \@codes, \%labels );
1337 }
1338
1339 =head2 GetBorrowercategory
1340
1341   $hashref = &GetBorrowercategory($categorycode);
1342
1343 Given the borrower's category code, the function returns the corresponding
1344 data hashref for a comprehensive information display.
1345
1346 =cut
1347
1348 sub GetBorrowercategory {
1349     my ($catcode) = @_;
1350     my $dbh       = C4::Context->dbh;
1351     my $sth       =
1352       $dbh->prepare(
1353 "SELECT description,dateofbirthrequired,upperagelimit,category_type 
1354  FROM categories 
1355  WHERE categorycode = ?"
1356       );
1357     $sth->execute($catcode);
1358     my $data =
1359       $sth->fetchrow_hashref;
1360     $sth->finish();
1361     return $data;
1362 }    # sub getborrowercategory
1363
1364 =head2 ethnicitycategories
1365
1366   ($codes_arrayref, $labels_hashref) = &ethnicitycategories();
1367
1368 Looks up the different ethnic types in the database. Returns two
1369 elements: a reference-to-array, which lists the ethnicity codes, and a
1370 reference-to-hash, which maps the ethnicity codes to ethnicity
1371 descriptions.
1372
1373 =cut
1374
1375 #'
1376
1377 sub ethnicitycategories {
1378     my $dbh = C4::Context->dbh;
1379     my $sth = $dbh->prepare("Select code,name from ethnicity order by name");
1380     $sth->execute;
1381     my %labels;
1382     my @codes;
1383     while ( my $data = $sth->fetchrow_hashref ) {
1384         push @codes, $data->{'code'};
1385         $labels{ $data->{'code'} } = $data->{'name'};
1386     }
1387     $sth->finish;
1388     return ( \@codes, \%labels );
1389 }
1390
1391 =head2 fixEthnicity
1392
1393   $ethn_name = &fixEthnicity($ethn_code);
1394
1395 Takes an ethnicity code (e.g., "european" or "pi") and returns the
1396 corresponding descriptive name from the C<ethnicity> table in the
1397 Koha database ("European" or "Pacific Islander").
1398
1399 =cut
1400
1401 #'
1402
1403 sub fixEthnicity {
1404     my $ethnicity = shift;
1405     return unless $ethnicity;
1406     my $dbh       = C4::Context->dbh;
1407     my $sth       = $dbh->prepare("Select name from ethnicity where code = ?");
1408     $sth->execute($ethnicity);
1409     my $data = $sth->fetchrow_hashref;
1410     $sth->finish;
1411     return $data->{'name'};
1412 }    # sub fixEthnicity
1413
1414 =head2 GetAge
1415
1416   $dateofbirth,$date = &GetAge($date);
1417
1418 this function return the borrowers age with the value of dateofbirth
1419
1420 =cut
1421
1422 #'
1423 sub GetAge{
1424     my ( $date, $date_ref ) = @_;
1425
1426     if ( not defined $date_ref ) {
1427         $date_ref = sprintf( '%04d-%02d-%02d', Today() );
1428     }
1429
1430     my ( $year1, $month1, $day1 ) = split /-/, $date;
1431     my ( $year2, $month2, $day2 ) = split /-/, $date_ref;
1432
1433     my $age = $year2 - $year1;
1434     if ( $month1 . $day1 > $month2 . $day2 ) {
1435         $age--;
1436     }
1437
1438     return $age;
1439 }    # sub get_age
1440
1441 =head2 get_institutions
1442   $insitutions = get_institutions();
1443
1444 Just returns a list of all the borrowers of type I, borrownumber and name
1445
1446 =cut
1447
1448 #'
1449 sub get_institutions {
1450     my $dbh = C4::Context->dbh();
1451     my $sth =
1452       $dbh->prepare(
1453 "SELECT borrowernumber,surname FROM borrowers WHERE categorycode=? ORDER BY surname"
1454       );
1455     $sth->execute('I');
1456     my %orgs;
1457     while ( my $data = $sth->fetchrow_hashref() ) {
1458         $orgs{ $data->{'borrowernumber'} } = $data;
1459     }
1460     $sth->finish();
1461     return ( \%orgs );
1462
1463 }    # sub get_institutions
1464
1465 =head2 add_member_orgs
1466
1467   add_member_orgs($borrowernumber,$borrowernumbers);
1468
1469 Takes a borrowernumber and a list of other borrowernumbers and inserts them into the borrowers_to_borrowers table
1470
1471 =cut
1472
1473 #'
1474 sub add_member_orgs {
1475     my ( $borrowernumber, $otherborrowers ) = @_;
1476     my $dbh   = C4::Context->dbh();
1477     my $query =
1478       "INSERT INTO borrowers_to_borrowers (borrower1,borrower2) VALUES (?,?)";
1479     my $sth = $dbh->prepare($query);
1480     foreach my $otherborrowernumber (@$otherborrowers) {
1481         $sth->execute( $borrowernumber, $otherborrowernumber );
1482     }
1483     $sth->finish();
1484
1485 }    # sub add_member_orgs
1486
1487 =head2 GetCities (OUEST-PROVENCE)
1488
1489   ($id_cityarrayref, $city_hashref) = &GetCities();
1490
1491 Looks up the different city and zip in the database. Returns two
1492 elements: a reference-to-array, which lists the zip city
1493 codes, and a reference-to-hash, which maps the name of the city.
1494 WHERE =>OUEST PROVENCE OR EXTERIEUR
1495
1496 =cut
1497
1498 sub GetCities {
1499
1500     #my ($type_city) = @_;
1501     my $dbh   = C4::Context->dbh;
1502     my $query = qq|SELECT cityid,city_name 
1503                 FROM cities 
1504                 ORDER BY city_name|;
1505     my $sth = $dbh->prepare($query);
1506
1507     #$sth->execute($type_city);
1508     $sth->execute();
1509     my %city;
1510     my @id;
1511
1512     #    insert empty value to create a empty choice in cgi popup
1513
1514     while ( my $data = $sth->fetchrow_hashref ) {
1515
1516         push @id, $data->{'cityid'};
1517         $city{ $data->{'cityid'} } = $data->{'city_name'};
1518     }
1519
1520 #test to know if the table contain some records if no the function return nothing
1521     my $id = @id;
1522     $sth->finish;
1523     if ( $id eq 0 ) {
1524         return ();
1525     }
1526     else {
1527         unshift( @id, "" );
1528         return ( \@id, \%city );
1529     }
1530 }
1531
1532 =head2 GetSortDetails (OUEST-PROVENCE)
1533
1534   ($lib) = &GetSortDetails($category,$sortvalue);
1535
1536 Returns the authorized value  details
1537 C<&$lib>return value of authorized value details
1538 C<&$sortvalue>this is the value of authorized value 
1539 C<&$category>this is the value of authorized value category
1540
1541 =cut
1542
1543 sub GetSortDetails {
1544     my ( $category, $sortvalue ) = @_;
1545     my $dbh   = C4::Context->dbh;
1546     my $query = qq|SELECT lib 
1547                 FROM authorised_values 
1548                 WHERE category=?
1549                 AND authorised_value=? |;
1550     my $sth = $dbh->prepare($query);
1551     $sth->execute( $category, $sortvalue );
1552     my $lib = $sth->fetchrow;
1553     return ($lib);
1554 }
1555
1556 =head2 DeleteBorrower 
1557
1558   () = &DeleteBorrower($member);
1559
1560 delete all data fo borrowers and add record to deletedborrowers table
1561 C<&$member>this is the borrowernumber
1562
1563 =cut
1564
1565 sub MoveMemberToDeleted {
1566     my ($member) = @_;
1567     my $dbh = C4::Context->dbh;
1568     my $query;
1569     $query = qq|SELECT * 
1570                   FROM borrowers 
1571                   WHERE borrowernumber=?|;
1572     my $sth = $dbh->prepare($query);
1573     $sth->execute($member);
1574     my @data = $sth->fetchrow_array;
1575     $sth->finish;
1576     $sth =
1577       $dbh->prepare( "INSERT INTO deletedborrowers VALUES ("
1578           . ( "?," x ( scalar(@data) - 1 ) )
1579           . "?)" );
1580     $sth->execute(@data);
1581     $sth->finish;
1582 }
1583
1584 =head2 DelMember
1585
1586 DelMember($borrowernumber);
1587
1588 This function remove directly a borrower whitout writing it on deleteborrower.
1589 + Deletes reserves for the borrower
1590
1591 =cut
1592
1593 sub DelMember {
1594     my $dbh            = C4::Context->dbh;
1595     my $borrowernumber = shift;
1596         warn "in delmember with $borrowernumber";
1597     return unless $borrowernumber;    # borrowernumber is mandatory.
1598
1599     my $query = qq|DELETE 
1600                   FROM  reserves 
1601                   WHERE borrowernumber=?|;
1602     my $sth = $dbh->prepare($query);
1603     $sth->execute($borrowernumber);
1604     $sth->finish;
1605     $query = "
1606        DELETE
1607        FROM borrowers
1608        WHERE borrowernumber = ?
1609    ";
1610     $sth = $dbh->prepare($query);
1611     $sth->execute($borrowernumber);
1612     $sth->finish;
1613     &logaction(C4::Context->userenv->{'number'},"MEMBERS","DELETE",$borrowernumber,"") 
1614         if C4::Context->preference("BorrowersLog");
1615     return $sth->rows;
1616 }
1617
1618 =head2 ExtendMemberSubscriptionTo (OUEST-PROVENCE)
1619
1620 $date= ExtendMemberSubscriptionTo($borrowerid, $date);
1621 Extending the subscription to a given date or to the expiry date calculated on local date.
1622 returns date 
1623 =cut
1624
1625 sub ExtendMemberSubscriptionTo {
1626     my ( $borrowerid,$date) = @_;
1627     my $dbh = C4::Context->dbh;
1628     unless ($date){
1629       $date=POSIX::strftime("%Y-%m-%d",localtime(time));
1630       my $borrower = GetMember($borrowerid,'borrowernumber');
1631       $date = GetExpiryDate( $borrower->{'categorycode'}, $date );
1632     }
1633     my $sth = $dbh->do(<<EOF);
1634 UPDATE borrowers 
1635 SET  dateexpiry='$date' 
1636 WHERE borrowernumber='$borrowerid'
1637 EOF
1638     return $date if ($sth);
1639     return 0;
1640 }
1641
1642 =head2 GetRoadTypes (OUEST-PROVENCE)
1643
1644   ($idroadtypearrayref, $roadttype_hashref) = &GetRoadTypes();
1645
1646 Looks up the different road type . Returns two
1647 elements: a reference-to-array, which lists the id_roadtype
1648 codes, and a reference-to-hash, which maps the road type of the road .
1649
1650
1651 =cut
1652
1653 sub GetRoadTypes {
1654     my $dbh   = C4::Context->dbh;
1655     my $query = qq|
1656 SELECT roadtypeid,road_type 
1657 FROM roadtype 
1658 ORDER BY road_type|;
1659     my $sth = $dbh->prepare($query);
1660     $sth->execute();
1661     my %roadtype;
1662     my @id;
1663
1664     #    insert empty value to create a empty choice in cgi popup
1665
1666     while ( my $data = $sth->fetchrow_hashref ) {
1667
1668         push @id, $data->{'roadtypeid'};
1669         $roadtype{ $data->{'roadtypeid'} } = $data->{'road_type'};
1670     }
1671
1672 #test to know if the table contain some records if no the function return nothing
1673     my $id = @id;
1674     $sth->finish;
1675     if ( $id eq 0 ) {
1676         return ();
1677     }
1678     else {
1679         unshift( @id, "" );
1680         return ( \@id, \%roadtype );
1681     }
1682 }
1683
1684
1685
1686 =head2 GetTitles (OUEST-PROVENCE)
1687
1688   ($borrowertitle)= &GetTitles();
1689
1690 Looks up the different title . Returns array  with all borrowers title
1691
1692 =cut
1693
1694 sub GetTitles {
1695     my @borrowerTitle = split /,|\|/,C4::Context->preference('BorrowersTitles');
1696     unshift( @borrowerTitle, "" );
1697     return ( \@borrowerTitle);
1698     }
1699
1700
1701
1702 =head2 GetRoadTypeDetails (OUEST-PROVENCE)
1703
1704   ($roadtype) = &GetRoadTypeDetails($roadtypeid);
1705
1706 Returns the description of roadtype
1707 C<&$roadtype>return description of road type
1708 C<&$roadtypeid>this is the value of roadtype s
1709
1710 =cut
1711
1712 sub GetRoadTypeDetails {
1713     my ($roadtypeid) = @_;
1714     my $dbh          = C4::Context->dbh;
1715     my $query        = qq|
1716 SELECT road_type 
1717 FROM roadtype 
1718 WHERE roadtypeid=?|;
1719     my $sth = $dbh->prepare($query);
1720     $sth->execute($roadtypeid);
1721     my $roadtype = $sth->fetchrow;
1722     return ($roadtype);
1723 }
1724
1725 =head2 GetBorrowersWhoHaveNotBorrowedSince
1726
1727 &GetBorrowersWhoHaveNotBorrowedSince($date)
1728
1729 this function get all borrowers who haven't borrowed since the date given on input arg.
1730
1731 =cut
1732
1733 sub GetBorrowersWhoHaveNotBorrowedSince {
1734     my $date = shift;
1735     return unless $date;    # date is mandatory.
1736     my $dbh   = C4::Context->dbh;
1737     my $query = "
1738         SELECT borrowers.borrowernumber,max(timestamp)
1739         FROM   borrowers
1740           LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
1741         WHERE issues.borrowernumber IS NOT NULL
1742         GROUP BY borrowers.borrowernumber
1743    ";
1744     my $sth = $dbh->prepare($query);
1745     $sth->execute;
1746     my @results;
1747
1748     while ( my $data = $sth->fetchrow_hashref ) {
1749         push @results, $data;
1750     }
1751     return \@results;
1752 }
1753
1754 =head2 GetBorrowersWhoHaveNeverBorrowed
1755
1756 $results = &GetBorrowersWhoHaveNeverBorrowed
1757
1758 this function get all borrowers who have never borrowed.
1759
1760 I<$result> is a ref to an array which all elements are a hasref.
1761
1762 =cut
1763
1764 sub GetBorrowersWhoHaveNeverBorrowed {
1765     my $dbh   = C4::Context->dbh;
1766     my $query = "
1767         SELECT borrowers.borrowernumber,max(timestamp)
1768         FROM   borrowers
1769           LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
1770         WHERE issues.borrowernumber IS NULL
1771    ";
1772     my $sth = $dbh->prepare($query);
1773     $sth->execute;
1774     my @results;
1775     while ( my $data = $sth->fetchrow_hashref ) {
1776         push @results, $data;
1777     }
1778     return \@results;
1779 }
1780
1781 =head2 GetBorrowersWithIssuesHistoryOlderThan
1782
1783 $results = &GetBorrowersWithIssuesHistoryOlderThan($date)
1784
1785 this function get all borrowers who has an issue history older than I<$date> given on input arg.
1786
1787 I<$result> is a ref to an array which all elements are a hashref.
1788 This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.
1789
1790 =cut
1791
1792 sub GetBorrowersWithIssuesHistoryOlderThan {
1793     my $dbh  = C4::Context->dbh;
1794     my $date = shift;
1795     return unless $date;    # date is mandatory.
1796     my $query = "
1797        SELECT count(borrowernumber) as n,borrowernumber
1798        FROM issues
1799        WHERE returndate < ?
1800          AND borrowernumber IS NOT NULL 
1801        GROUP BY borrowernumber
1802    ";
1803     my $sth = $dbh->prepare($query);
1804     $sth->execute($date);
1805     my @results;
1806
1807     while ( my $data = $sth->fetchrow_hashref ) {
1808         push @results, $data;
1809     }
1810     return \@results;
1811 }
1812
1813 END { }    # module clean-up code here (global destructor)
1814
1815 1;
1816
1817 __END__
1818
1819 =back
1820
1821 =head1 AUTHOR
1822
1823 Koha Team
1824
1825 =cut