Bug 11715: require authentication for various staff scripts
[koha.git] / tools / modborrowers.pl
1 #!/usr/bin/perl
2
3 # Copyright 2012 BibLibre
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
17 # with Koha; if not, write to the Free Software Foundation, Inc.,
18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20 # modborrowers.pl
21 #
22 # Batch Edit Patrons
23 # Modification for patron's fields:
24 # surname firstname branchcode categorycode sort1 sort2 dateenrolled dateexpiry borrowernotes
25 # And for patron attributes.
26
27 use Modern::Perl;
28 use CGI;
29 use C4::Auth;
30 use C4::Branch;
31 use C4::Koha;
32 use C4::Members;
33 use C4::Members::Attributes;
34 use C4::Members::AttributeTypes qw/GetAttributeTypes_hashref/;
35 use C4::Output;
36 use List::MoreUtils qw /any uniq/;
37 use Koha::List::Patron;
38
39 my $input = new CGI;
40 my $op = $input->param('op') || 'show_form';
41 my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
42     {   template_name   => "tools/modborrowers.tmpl",
43         query           => $input,
44         type            => "intranet",
45         authnotrequired => 0,
46         flagsrequired   => { tools => "edit_patrons" },
47     }
48 );
49
50 my %cookies   = parse CGI::Cookie($cookie);
51 my $sessionID = $cookies{'CGISESSID'}->value;
52 my $dbh       = C4::Context->dbh;
53
54 # Show borrower informations
55 if ( $op eq 'show' ) {
56     my $filefh         = $input->upload('uploadfile');
57     my $filecontent    = $input->param('filecontent');
58     my $patron_list_id = $input->param('patron_list_id');
59     my @borrowers;
60     my @cardnumbers;
61     my @notfoundcardnumbers;
62
63     # Get cardnumbers from a file or the input area
64     my @contentlist;
65     if ($filefh) {
66         while ( my $content = <$filefh> ) {
67             $content =~ s/[\r\n]*$//g;
68             push @cardnumbers, $content if $content;
69         }
70     } elsif ( $patron_list_id ) {
71         my ($list) = GetPatronLists( { patron_list_id => $patron_list_id } );
72
73         @cardnumbers =
74           $list->patron_list_patrons()->search_related('borrowernumber')
75           ->get_column('cardnumber')->all();
76
77     } else {
78         if ( my $list = $input->param('cardnumberlist') ) {
79             push @cardnumbers, split( /\s\n/, $list );
80         }
81     }
82
83     my $max_nb_attr = 0;
84     for my $cardnumber ( @cardnumbers ) {
85         my $borrower = GetBorrowerInfos( cardnumber => $cardnumber );
86         if ( $borrower ) {
87             $max_nb_attr = scalar( @{ $borrower->{patron_attributes} } )
88                 if scalar( @{ $borrower->{patron_attributes} } ) > $max_nb_attr;
89             push @borrowers, $borrower;
90         } else {
91             push @notfoundcardnumbers, $cardnumber;
92         }
93     }
94
95     # Just for a correct display
96     for my $borrower ( @borrowers ) {
97         my $length = scalar( @{ $borrower->{patron_attributes} } );
98         push @{ $borrower->{patron_attributes} }, {} for ( $length .. $max_nb_attr - 1);
99     }
100
101     # Construct the patron attributes list
102     my @patron_attributes_values;
103     my @patron_attributes_codes;
104     my $patron_attribute_types = C4::Members::AttributeTypes::GetAttributeTypes_hashref('all');
105     my $patron_categories = C4::Members::GetBorrowercategoryList;
106     for ( values %$patron_attribute_types ) {
107         my $attr_type = C4::Members::AttributeTypes->fetch( $_->{code} );
108         my $options = $attr_type->authorised_value_category
109             ? GetAuthorisedValues( $attr_type->authorised_value_category )
110             : undef;
111         push @patron_attributes_values,
112             {
113                 attribute_code => $_->{code},
114                 options        => $options,
115             };
116
117         my $category_code = $_->{category_code};
118         my ( $category_lib ) = map {
119             ( defined $category_code and $_->{categorycode} eq $category_code ) ? $_->{description} : ()
120         } @$patron_categories;
121         push @patron_attributes_codes,
122             {
123                 attribute_code => $_->{code},
124                 attribute_lib  => $_->{description},
125                 category_lib   => $category_lib,
126                 type           => $attr_type->authorised_value_category ? 'select' : 'text',
127             };
128     }
129
130     my @attributes_header = ();
131     for ( 1 .. scalar( $max_nb_attr ) ) {
132         push @attributes_header, { attribute => "Attributes $_" };
133     }
134     $template->param( borrowers => \@borrowers );
135     $template->param( attributes_header => \@attributes_header );
136     @notfoundcardnumbers = map { { cardnumber => $_ } } @notfoundcardnumbers;
137     $template->param( notfoundcardnumbers => \@notfoundcardnumbers )
138         if @notfoundcardnumbers;
139
140     # Construct drop-down list values
141     my $branches = GetBranchesLoop;
142     my @branches_option;
143     push @branches_option, { value => $_->{value}, lib => $_->{branchname} } for @$branches;
144     unshift @branches_option, { value => "", lib => "" };
145     my $categories = GetBorrowercategoryList;
146     my @categories_option;
147     push @categories_option, { value => $_->{categorycode}, lib => $_->{description} } for @$categories;
148     unshift @categories_option, { value => "", lib => "" };
149     my $bsort1 = GetAuthorisedValues("Bsort1");
150     my @sort1_option;
151     push @sort1_option, { value => $_->{authorised_value}, lib => $_->{lib} } for @$bsort1;
152     unshift @sort1_option, { value => "", lib => "" }
153         if @sort1_option;
154     my $bsort2 = GetAuthorisedValues("Bsort2");
155     my @sort2_option;
156     push @sort2_option, { value => $_->{authorised_value}, lib => $_->{lib} } for @$bsort2;
157     unshift @sort2_option, { value => "", lib => "" }
158         if @sort2_option;
159
160     my @mandatoryFields = split( /\|/, C4::Context->preference("BorrowerMandatoryField") );
161
162     my @fields = (
163         {
164             name => "surname",
165             type => "text",
166             mandatory => ( grep /surname/, @mandatoryFields ) ? 1 : 0
167         }
168         ,
169         {
170             name => "firstname",
171             type => "text",
172             mandatory => ( grep /surname/, @mandatoryFields ) ? 1 : 0,
173         }
174         ,
175         {
176             name => "branchcode",
177             type => "select",
178             option => \@branches_option,
179             mandatory => ( grep /branchcode/, @mandatoryFields ) ? 1 : 0,
180         }
181         ,
182         {
183             name => "categorycode",
184             type => "select",
185             option => \@categories_option,
186             mandatory => ( grep /categorycode/, @mandatoryFields ) ? 1 : 0,
187         }
188         ,
189         {
190             name => "sort1",
191             type => @sort1_option ? "select" : "text",
192             option => \@sort1_option,
193             mandatory => ( grep /sort1/, @mandatoryFields ) ? 1 : 0,
194         }
195         ,
196         {
197             name => "sort2",
198             type => @sort2_option ? "select" : "text",
199             option => \@sort2_option,
200             mandatory => ( grep /sort2/, @mandatoryFields ) ? 1 : 0,
201         }
202         ,
203         {
204             name => "dateenrolled",
205             type => "date",
206             mandatory => ( grep /dateenrolled/, @mandatoryFields ) ? 1 : 0,
207         }
208         ,
209         {
210             name => "dateexpiry",
211             type => "date",
212             mandatory => ( grep /dateexpiry/, @mandatoryFields ) ? 1 : 0,
213         }
214         ,
215         {
216             name => "borrowernotes",
217             type => "text",
218             mandatory => ( grep /borrowernotes/, @mandatoryFields ) ? 1 : 0,
219         }
220     );
221
222     $template->param('patron_attributes_codes', \@patron_attributes_codes);
223     $template->param('patron_attributes_values', \@patron_attributes_values);
224
225     $template->param( fields => \@fields );
226 }
227
228 # Process modifications
229 if ( $op eq 'do' ) {
230
231     my @disabled = $input->param('disable_input');
232     my $infos;
233     for my $field ( qw/surname firstname branchcode categorycode sort1 sort2 dateenrolled dateexpiry borrowernotes/ ) {
234         my $value = $input->param($field);
235         $infos->{$field} = $value if $value;
236         $infos->{$field} = "" if grep { /^$field$/ } @disabled;
237     }
238
239     my @attributes = $input->param('patron_attributes');
240     my @attr_values = $input->param('patron_attributes_value');
241
242     my @errors;
243     my @borrowernumbers = $input->param('borrowernumber');
244     # For each borrower selected
245     for my $borrowernumber ( @borrowernumbers ) {
246         # If at least one field are filled, we want to modify the borrower
247         if ( defined $infos ) {
248             $infos->{borrowernumber} = $borrowernumber;
249             my $success = ModMember(%$infos);
250             push @errors, { error => "can_not_update", borrowernumber => $infos->{borrowernumber} } if not $success;
251         }
252
253         #
254         my $borrower_categorycode = GetBorrowerCategorycode $borrowernumber;
255         my $i=0;
256         for ( @attributes ) {
257             my $attribute;
258             $attribute->{code} = $_;
259             $attribute->{attribute} = $attr_values[$i];
260             my $attr_type = C4::Members::AttributeTypes->fetch( $_ );
261             # If this borrower is not in the category of this attribute, we don't want to modify this attribute
262             ++$i and next if $attr_type->{category_code} and $attr_type->{category_code} ne $borrower_categorycode;
263             my $valuename = "attr" . $i . "_value";
264             if ( grep { /^$valuename$/ } @disabled ) {
265                 # The attribute is disabled, we remove it for this borrower !
266                 eval {
267                     C4::Members::Attributes::DeleteBorrowerAttribute( $borrowernumber, $attribute );
268                 };
269                 push @errors, { error => $@ } if $@;
270             } else {
271                 # Attribute's value is empty, we don't want to modify it
272                 ++$i and next if not $attribute->{attribute};
273
274                 eval {
275                     C4::Members::Attributes::UpdateBorrowerAttribute( $borrowernumber, $attribute );
276                 };
277                 push @errors, { error => $@ } if $@;
278             }
279             $i++;
280         }
281     }
282     $op = "show_results"; # We have process modifications, the user want to view its
283
284     # Construct the results list
285     my @borrowers;
286     my $max_nb_attr = 0;
287     for my $borrowernumber ( @borrowernumbers ) {
288         my $borrower = GetBorrowerInfos( borrowernumber => $borrowernumber );
289         if ( $borrower ) {
290             $max_nb_attr = scalar( @{ $borrower->{patron_attributes} } )
291                 if scalar( @{ $borrower->{patron_attributes} } ) > $max_nb_attr;
292             push @borrowers, $borrower;
293         }
294     }
295     my @patron_attributes_option;
296     for my $borrower ( @borrowers ) {
297         push @patron_attributes_option, { value => "$_->{code}", lib => $_->{code} } for @{ $borrower->{patron_attributes} };
298         my $length = scalar( @{ $borrower->{patron_attributes} } );
299         push @{ $borrower->{patron_attributes} }, {} for ( $length .. $max_nb_attr - 1);
300     }
301
302     my @attributes_header = ();
303     for ( 1 .. scalar( $max_nb_attr ) ) {
304         push @attributes_header, { attribute => "Attributes $_" };
305     }
306
307     $template->param( borrowers => \@borrowers );
308     $template->param( attributes_header => \@attributes_header );
309
310     $template->param( borrowers => \@borrowers );
311     $template->param( errors => \@errors );
312 } else {
313
314     $template->param( patron_lists => [ GetPatronLists() ] );
315 }
316
317 $template->param(
318     op => $op,
319 );
320 output_html_with_http_headers $input, $cookie, $template->output;
321 exit;
322
323 sub GetBorrowerInfos {
324     my ( %info ) = @_;
325     my $borrower = GetMember( %info );
326     if ( $borrower ) {
327         $borrower->{branchname} = GetBranchName( $borrower->{branchcode} );
328         for ( qw(dateenrolled dateexpiry) ) {
329             my $userdate = $borrower->{$_};
330             unless ($userdate && $userdate ne "0000-00-00" and $userdate ne "9999-12-31") {
331                 $borrower->{$_} = '';
332                 next;
333             }
334             $borrower->{$_} = $userdate || '';
335         }
336         $borrower->{category_description} = GetBorrowercategory( $borrower->{categorycode} )->{description};
337         my $attr_loop = C4::Members::Attributes::GetBorrowerAttributes( $borrower->{borrowernumber} );
338         $borrower->{patron_attributes} = $attr_loop;
339     }
340     return $borrower;
341 }