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