memberentry.pl - $debug-ify warn messages
[koha.git] / members / memberentry.pl
1 #!/usr/bin/perl
2
3 # Copyright 2006 SAN OUEST PROVENCE et Paul POULAIN
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 # pragma
21 use strict;
22
23 # external modules
24 use Date::Calc qw/Today/;
25 use CGI;
26 use Digest::MD5 qw(md5_base64);
27
28 # internal modules
29 use C4::Auth;
30 use C4::Context;
31 use C4::Output;
32 use C4::Members;
33 use C4::Koha;
34 use C4::Dates qw/format_date format_date_in_iso/;
35 use C4::Input;
36 use C4::Log;
37 use C4::Branch; # GetBranches
38
39 use vars qw($debug);
40
41 BEGIN {
42         $debug = $ENV{DEBUG} || 0;
43 }
44         
45 my $input = new CGI;
46 my %data;
47
48 my $dbh = C4::Context->dbh;
49
50 my ($template, $loggedinuser, $cookie)
51     = get_template_and_user({template_name => "members/memberentrygen.tmpl",
52            query => $input,
53            type => "intranet",
54            authnotrequired => 0,
55            flagsrequired => {borrowers => 1},
56            debug => 1,
57            });
58 my $guarantorid=$input->param('guarantorid');
59 my $borrowernumber=$input->param('borrowernumber');
60 my $actionType=$input->param('actionType') || '';
61 my $modify=$input->param('modify');
62 my $delete=$input->param('delete');
63 my $op=$input->param('op');
64 my $destination=$input->param('destination');
65 my $cardnumber=$input->param('cardnumber');
66 my $check_member=$input->param('check_member');
67 my $name_city=$input->param('name_city');
68 my $nodouble=$input->param('nodouble');
69 my $select_city=$input->param('select_city');
70 my $nok=$input->param('nok');
71 my $guarantorinfo=$input->param('guarantorinfo');
72 my $step=$input->param('step') || 0;
73 my @errors;
74 my $default_city;
75 # $check_categorytype contains the value of duplicate borrowers category type to redirect in good template in step =2
76 my $check_categorytype=$input->param('check_categorytype');
77 # NOTE: Alert for ethnicity and ethnotes fields, they are unvalided in all borrowers form
78 my $borrower_data;
79 my $NoUpdateLogin;
80 my $userenv = C4::Context->userenv;
81
82 $template->param("uppercasesurnames" => C4::Context->preference('uppercasesurnames'));
83
84 #function  to automatic setup the mandatory  fields (visual with css)
85 my $check_BorrowerMandatoryField=C4::Context->preference("BorrowerMandatoryField");
86 my @field_check=split(/\|/,$check_BorrowerMandatoryField);
87 foreach (@field_check) {
88 $template->param( "mandatory$_" => 1);    
89 }
90 $template->param("add"=>1) if ($op eq 'add');
91 $template->param("checked" => 1) if ($nodouble eq 1);
92 ($borrower_data = GetMember($borrowernumber,'borrowernumber')) if ($op eq 'modify' or $op eq 'save');
93 my $categorycode = $input->param('categorycode') || $borrower_data->{'categorycode'};
94 my $category_type = $input->param('category_type');
95 unless ($category_type or !($categorycode)){
96   my $borrowercategory= GetBorrowercategory($categorycode);
97   $category_type = $borrowercategory->{'category_type'};
98 }
99 $category_type="A" unless $category_type; # FIXME we should display a error message instead of a 500 error !
100
101 # if a add or modify is requested => check validity of data.
102 %data= %$borrower_data if ($borrower_data);
103
104 my %newdata;
105 if ($op eq 'insert' || $op eq 'modify' || $op eq 'save') {
106     my @names= ($borrower_data && $op ne 'save') ? keys %$borrower_data : $input->param();
107     foreach my $key (@names) {
108         $newdata{$key} = $input->param($key) if (defined $input->param($key));
109         $newdata{$key} =~ s/\"/"/gg unless $key eq 'borrowernotes' or $key eq 'opacnote';
110     }
111 #    $newdata{'dateenrolled'}=format_date_in_iso($newdata{'dateenrolled'}) if ($newdata{dateenrolled});  
112 #    $newdata{'dateexpiry'}  =format_date_in_iso($newdata{'dateexpiry'}  ) if ($newdata{dateexpiry});  
113 #    $newdata{'dateofbirth'} =format_date_in_iso($newdata{'dateofbirth'} ) if ($newdata{dateofbirth});  
114   # check permission to modify login info.
115     if (ref($borrower_data) && ($borrower_data->{'category_type'} eq 'S') && ! (C4::Auth::haspermission($dbh,$userenv->{'id'},{'staffaccess'=>1})) )  {
116                 $NoUpdateLogin =1;
117         }
118 }
119
120 #############test for member being unique #############
121 if ($op eq 'insert'){
122         my $category_type_send=$category_type if ($category_type eq 'I'); 
123         my $check_category; # recover the category code of the doublon suspect borrowers
124         ($check_member,$check_category)= checkuniquemember($category_type_send,($newdata{'surname'}?$newdata{'surname'}:$data{'surname'}),($newdata{'firstname'}?$newdata{'firstname'}:$data{'firstname'}),($newdata{'dateofbirth'}?$newdata{'dateofbirth'}:$data{'dateofbirth'}));
125           
126   #   recover the category type if the borrowers is a doublon 
127         my $tmpborrowercategory=GetBorrowercategory($check_category);
128         $check_categorytype=$tmpborrowercategory->{'category_type'};
129 }
130
131   #recover all data from guarantor address phone ,fax... 
132 if (($category_type eq 'C' || $category_type eq 'P') and $guarantorid ne '' ){
133   my $guarantordata=GetMember($guarantorid);
134   $guarantorinfo=$guarantordata->{'surname'}." , ".$guarantordata->{'firstname'};
135   if (($data{'contactname'} eq '' or $data{'contactname'} ne $guarantordata->{'surname'})) {
136     $data{'contactfirstname'}=$guarantordata->{'firstname'}; 
137     $data{'contactname'}=$guarantordata->{'surname'};
138     $data{'contacttitle'}=$guarantordata->{'title'};  
139     map {$data{$_}=$guarantordata->{$_}}('streetnumber','address','streettype','address2','zipcode','city','phone','phonepro','mobile','fax','email','emailpro');
140   }
141 }
142
143 ###############test to take the right zipcode and city name ##############
144 if ( $guarantorid eq ''){
145   if ($select_city){
146     my ($borrower_city,$borrower_zipcode)=&getzipnamecity($select_city);
147     $newdata{'city'}= $borrower_city;
148     $newdata{'zipcode'}=$borrower_zipcode;
149     }
150 }
151 #builds default userid
152 if ( (defined $newdata{'userid'}) && ($newdata{'userid'} eq '')){
153   my $onefirstnameletter=substr($data{'firstname'},0,1);
154   my $fivesurnameletter=substr($data{'surname'},0,9);
155   $newdata{'userid'}=lc($onefirstnameletter.$fivesurnameletter);
156 }
157   
158 my $loginexist=0;
159 if ($op eq 'save' || $op eq 'insert'){
160   if (checkcardnumber($newdata{cardnumber},$newdata{borrowernumber})){ 
161     push @errors, 'ERROR_cardnumber';
162     $nok = 1;
163   } 
164   my $dateofbirthmandatory=0;
165   map {$dateofbirthmandatory=1 if $_ eq "dateofbirth"} @field_check;
166   if ($newdata{dateofbirth} && $dateofbirthmandatory) {
167     my $age = GetAge($newdata{dateofbirth});
168     my $borrowercategory=GetBorrowercategory($newdata{'categorycode'});   
169     if (($age > $borrowercategory->{'upperagelimit'}) or ($age < $borrowercategory->{'dateofbirthrequired'})) {
170       push @errors, 'ERROR_age_limitations';
171       $nok = 1;
172     }
173   }
174         $debug and warn "dateofbirth: " . $newdata{'dateofbirth'};
175     
176   if (C4::Context->preference("IndependantBranches")) {
177     if ($userenv && $userenv->{flags} != 1){
178       $debug and print STDERR "  $newdata{'branchcode'} : ".$userenv->{flags}.":".$userenv->{branch};
179       unless (!$newdata{'branchcode'} || $userenv->{branch} eq $newdata{'branchcode'}){
180         push @errors, "ERROR_branch";
181         $nok=1;
182       }
183     }
184   }
185   # Check if the userid is unique
186   if (($op eq 'insert' || $op eq 'save') && !Check_Userid($newdata{'userid'},$borrowernumber)) {
187     push @errors, "ERROR_login_exist";
188     $nok=1;
189     $loginexist=1; 
190   }
191 }
192
193 if ($op eq 'modify' || $op eq 'insert'){
194   unless ($newdata{'dateexpiry'}){
195         my $arg2 = $newdata{'dateenrolled'} || sprintf('%04d-%02d-%02d', Today());
196     $newdata{'dateexpiry'} = GetExpiryDate($newdata{'categorycode'},$arg2);
197   }
198 }
199
200 if ($op eq 'insert'){
201   # Check if the userid is unique
202   unless ($nok){
203     $borrowernumber = &AddMember(%newdata);
204     if ($data{'organisations'}){            
205       # need to add the members organisations
206       my @orgs=split(/\|/,$data{'organisations'});
207       add_member_orgs($borrowernumber,\@orgs);
208     }
209     if ($destination eq "circ") {
210         print $input->redirect("/cgi-bin/koha/circ/circulation.pl?findborrower=$data{'cardnumber'}");
211     } else {
212         if ($loginexist == 0) {
213             print $input->redirect("/cgi-bin/koha/members/moremember.pl?borrowernumber=$borrowernumber");
214         }
215     }
216   }
217 }
218 if ($op eq 'save'){
219         # test to know if another user have the same password and same login                                
220         unless ($nok){
221             if($NoUpdateLogin) {
222                         delete $newdata{'password'};
223                         delete $newdata{'userid'};
224                 }
225                 $debug and warn "dateofbirth: " . $newdata{'dateofbirth'};
226                 &ModMember(%newdata);    
227             if ($destination eq "circ") {
228                 print $input->redirect("/cgi-bin/koha/circ/circulation.pl?findborrower=$data{'cardnumber'}");
229             } else {
230                 print $input->redirect("/cgi-bin/koha/members/moremember.pl?borrowernumber=$borrowernumber");
231             }
232         }
233 }
234
235 if ($delete){
236         print $input->redirect("/cgi-bin/koha/deletemem.pl?member=$borrowernumber");
237 }
238
239 if ($nok){
240   $op="add" if ($op eq "insert");
241   $op="modify" if ($op eq "save");
242   %data=%newdata; 
243   $template->param( updtype => ($op eq "insert"?'I':'M'));
244   unless ($step){  
245     $template->param( step_1 => 1,step_2 => 1,step_3 => 1);
246   }  
247
248 if (C4::Context->preference("IndependantBranches")) {
249   my $userenv = C4::Context->userenv;
250   if ($userenv->{flags} != 1 && $data{branchcode}){
251     unless ($userenv->{branch} eq $data{'branchcode'}){
252       print $input->redirect("/cgi-bin/koha/members/members-home.pl");
253     }
254   }
255 }
256 if ($op eq 'add'){
257   $template->param( updtype => 'I',step_1=>1,step_2=>1,step_3=>1);
258
259 if ($op eq "modify")  {
260   $template->param( updtype => 'M',modify => 1 );
261   $template->param( step_1=>1,step_2=>1,step_3=>1) unless $step;
262 }
263 # my $cardnumber=$data{'cardnumber'};
264 $data{'cardnumber'}=fixup_cardnumber($data{'cardnumber'}) if $op eq 'add';
265 if ($data{'sex'} eq 'F'){
266   $template->param(female => 1);
267 } elsif ($data{'sex'} eq 'M'){
268     $template->param(male => 1);
269 } else {
270     $template->param(none => 1);
271 }
272
273 ##Now all the data to modify a member.
274 my ($categories,$labels)=ethnicitycategories();
275   
276 my $ethnicitycategoriescount=$#{$categories};
277 my $ethcatpopup;
278 if ($ethnicitycategoriescount>=0) {
279   $ethcatpopup = CGI::popup_menu(-name=>'ethnicity',
280         -id => 'ethnicity',
281         -tabindex=>'',
282         -values=>$categories,
283         -default=>$data{'ethnicity'},
284         -labels=>$labels);
285   $template->param(ethcatpopup => $ethcatpopup); # bad style, has to be fixed
286 }
287   
288   
289 my $action="WHERE category_type=?";
290 ($categories,$labels)=GetborCatFromCatType($category_type,$action);
291   
292 if(scalar(@$categories)){
293       #if you modify the borrowers you must have the right value for his category code
294   my $default_category=$newdata{'categorycode'} if ($op  eq 'modify');
295   my $catcodepopup = CGI::popup_menu(
296       -name=>'categorycode',
297   -id => 'categorycode',
298   -values=>$categories,
299     -labels=>$labels,
300   -default=>$default_category
301   );
302   $template->param(catcodepopup=>$catcodepopup);
303 }
304   #test in city
305 $select_city=getidcity($data{'city'}) if ($guarantorid ne '0');
306 ($default_city=$select_city) if ($step eq 0);
307 if ($select_city eq '' ){
308 my $selectcity=&getidcity($data{'city'});
309 $default_city=$selectcity;
310 }
311 my($cityid);
312 ($cityid,$name_city)=GetCities();
313 $template->param( city_cgipopup => 1) if ($cityid );
314 my $citypopup = CGI::popup_menu(-name=>'select_city',
315         -id => 'select_city',
316         -values=>$name_city,
317         -labels=>$name_city,
318         -default=>$default_city,
319         -onChange => "javascript:changecity()",
320         );  
321   
322 my $default_roadtype;
323 $default_roadtype=$data{'streettype'} ;
324 my($roadtypeid,$road_type)=GetRoadTypes();
325   $template->param( road_cgipopup => 1) if ($roadtypeid );
326 my $roadpopup = CGI::popup_menu(-name=>'streettype',
327         -id => 'streettype',
328         -values=>$roadtypeid,
329         -labels=>$road_type,
330         -override => 1,
331         -default=>$default_roadtype
332         );  
333
334 my $default_borrowertitle;
335 $default_borrowertitle=$data{'title'} ;
336 my($borrowertitle)=GetTitles();
337 my $borrotitlepopup = CGI::popup_menu(-name=>'title',
338         -id => 'btitle',
339         -values=>$borrowertitle,
340         -override => 1,
341         -default=>$default_borrowertitle
342         );    
343
344
345 my @relationships = split /,|\|/,C4::Context->preference('BorrowerRelationship');
346 my @relshipdata;
347 while (@relationships) {
348   my $relship = shift @relationships || '';
349   my %row = ('relationship' => $relship);
350   if ($data{'relationship'} eq $relship) {
351     $row{'selected'}=' selected';
352   } else {
353     $row{'selected'}='';
354   }
355   push(@relshipdata, \%row);
356 }
357 my %flags = ( 'gonenoaddress' => ['gonenoaddress', 'Gone no address '],
358         'lost'          => ['lost', 'Lost'],
359         'debarred'      => ['debarred', 'Debarred']);
360
361 my @flagdata;
362 foreach (keys(%flags)) {
363 my $key = $_;
364 my %row =  ('key'   => $key,
365     'name'  => $flags{$key}[0],
366     'html'  => $flags{$key}[1]);
367 if ($data{$key}) {
368   $row{'yes'}=' checked';
369   $row{'no'}='';
370 } else {
371   $row{'yes'}='';
372   $row{'no'}=' checked';
373 }
374 push(@flagdata, \%row);
375 }
376
377
378 #get Branches
379 my @branches;
380 my @select_branch;
381 my %select_branches;
382
383 my $onlymine=(C4::Context->preference('IndependantBranches') && 
384               C4::Context->userenv && 
385               C4::Context->userenv->{flags} !=1  && 
386               C4::Context->userenv->{branch}?1:0);
387               
388 my $branches=GetBranches($onlymine);
389 my $default;
390
391 foreach my $branch (sort keys %$branches) {
392     push @select_branch,$branch;
393     $select_branches{$branch} = $branches->{$branch}->{'branchname'};
394     $default = C4::Context->userenv->{'branch'} if (C4::Context->userenv && C4::Context->userenv->{'branch'});
395 }
396 # --------------------------------------------------------------------------------------------------------
397   #in modify mod :default value from $CGIbranch comes from borrowers table
398   #in add mod: default value come from branches table (ip correspendence)
399 $default=$data{'branchcode'}  if ($op eq 'modify');
400 my $CGIbranch = CGI::scrolling_list(-id    => 'branchcode',
401             -name   => 'branchcode',
402             -values => \@select_branch,
403             -labels => \%select_branches,
404             -size   => 1,
405             -override => 1,  
406             -multiple =>0,
407             -default => $default,
408         );
409 my $CGIorganisations;
410 my $member_of_institution;
411 if (C4::Context->preference("memberofinstitution")){
412     my $organisations=get_institutions();
413     my @orgs;
414     my %org_labels;
415     foreach my $organisation (keys %$organisations) {
416         push @orgs,$organisation;
417         $org_labels{$organisation}=$organisations->{$organisation}->{'surname'};
418     }
419     $member_of_institution=1;
420     
421     $CGIorganisations = CGI::scrolling_list( -id => 'organisations',
422         -name     => 'organisations',
423         -labels   => \%org_labels,
424         -values   => \@orgs,
425         -size     => 5,
426         -multiple => 'true'
427
428     );
429 }
430
431
432 # --------------------------------------------------------------------------------------------------------
433
434 my $CGIsort1 = buildCGIsort("Bsort1","sort1",$data{'sort1'});
435 if ($CGIsort1) {
436   $template->param(CGIsort1 => $CGIsort1);
437 }
438 $template->param( sort1 => $data{'sort1'});
439
440 my $CGIsort2 = buildCGIsort("Bsort2","sort2",$data{'sort2'});
441 if ($CGIsort2) {
442   $template->param(CGIsort2 =>$CGIsort2);
443 } else {
444   $template->param( sort2 => $data{'sort2'});
445 }
446 if ($nok) {
447     foreach my $error (@errors) {
448         $template->param( $error => 1);
449     }
450     $template->param(nok => 1);
451 }
452   
453   #Formatting data for display    
454   
455 if ($data{'dateenrolled'} eq ''){
456   my $today= sprintf('%04d-%02d-%02d', Today());
457   $data{'dateenrolled'}=$today;
458 }
459 if (C4::Context->preference('uppercasesurnames')) {
460         $data{'surname'}    =uc($data{'surname'}    );
461         $data{'contactname'}=uc($data{'contactname'});
462 }
463 $data{'dateenrolled'} = format_date($data{'dateenrolled'});
464 $data{'dateexpiry'}   = format_date($data{'dateexpiry'});
465 $data{'dateofbirth'}  = format_date($data{'dateofbirth'});
466
467 $template->param( "showguarantor"  => ($category_type=~/A|I|S/) ? 0 : 1); # associate with step to know where you are
468 $debug and warn "memberentry step: $step";
469 $template->param(%data);
470 $template->param( "step_$step"  => 1) if $step;# associate with step to know where u are
471 $template->param( "step"  => $step) if $step;# associate with step to know where u are
472 $template->param(
473   BorrowerMandatoryField => C4::Context->preference("BorrowerMandatoryField"),#field to test with javascript
474   category_type => $category_type,#to know the category type of the borrower
475   DHTMLcalendar_dateformat => C4::Dates->DHTMLcalendar(),
476   select_city => $select_city,
477   "$category_type"  => 1,# associate with step to know where u are
478   destination   => $destination,#to know wher u come from and wher u must go in redirect
479   check_member    => $check_member,#to know if the borrower already exist(=>1) or not (=>0) 
480   flags   =>$data{'flags'},   
481   "op$op"   => 1,
482   nodouble  => $nodouble,
483   borrowernumber  => $borrowernumber,#register number
484   "contacttitle_".$data{'contacttitle'} => "SELECTED" ,
485   guarantorid => $guarantorid,
486   ethcatpopup => $ethcatpopup,
487   relshiploop => \@relshipdata,
488   citypopup => $citypopup,
489   roadpopup => $roadpopup,  
490   borrotitlepopup => $borrotitlepopup,
491   guarantorinfo   => $guarantorinfo,
492   flagloop  => \@flagdata,
493   dateformat      => C4::Dates->new()->visual(),
494   C4::Context->preference('dateformat') => 1,
495   check_categorytype =>$check_categorytype,#to recover the category type with checkcategorytype function
496   modify          => $modify,
497   nok     => $nok,#flag to konw if an error 
498   CGIbranch => $CGIbranch,
499   memberofinstution => $member_of_institution,
500   CGIorganisations => $CGIorganisations,
501   NoUpdateLogin =>  $NoUpdateLogin
502   );
503   
504 output_html_with_http_headers $input, $cookie, $template->output;
505
506 # Local Variables:
507 # tab-width: 8
508 # End: