Bug 22990: Add CSRF protection to boraccount, pay and suggestion
[koha.git] / suggestion / suggestion.pl
1 #!/usr/bin/perl
2
3 # This file is part of Koha.
4 # Copyright 2006-2010 BibLibre
5
6 #
7 # Koha is free software; you can redistribute it and/or modify it
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
11 #
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
16 #
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
19
20 use Modern::Perl;
21 require Exporter;
22 use CGI qw ( -utf8 );
23 use C4::Auth qw( get_template_and_user );
24 use C4::Output qw( output_html_with_http_headers output_and_exit_if_error );
25 use C4::Suggestions;
26 use C4::Koha qw( GetAuthorisedValues );
27 use C4::Budgets qw( GetBudget GetBudgets GetBudgetHierarchy CanUserUseBudget );
28 use C4::Search qw( FindDuplicate GetDistinctValues );
29 use C4::Members;
30 use Koha::DateUtils qw( dt_from_string );
31 use Koha::AuthorisedValues;
32 use Koha::Acquisition::Currencies;
33 use Koha::Libraries;
34 use Koha::Patrons;
35
36 use URI::Escape qw( uri_escape );
37
38 sub Init{
39     my $suggestion= shift @_;
40     # "Managed by" is used only when a suggestion is being edited (not when created)
41     if ($suggestion->{'suggesteddate'} eq "") {
42         # new suggestion
43         $suggestion->{suggesteddate} = dt_from_string;
44         $suggestion->{'suggestedby'} = C4::Context->userenv->{"number"} unless ($suggestion->{'suggestedby'});
45     }
46     else {
47         # editing of an existing suggestion
48         $suggestion->{manageddate} = dt_from_string;
49         $suggestion->{'managedby'} = C4::Context->userenv->{"number"} unless ($suggestion->{'managedby'});
50     }
51     $suggestion->{'branchcode'}=C4::Context->userenv->{"branch"} unless ($suggestion->{'branchcode'});
52 }
53
54 sub GetCriteriumDesc{
55     my ($criteriumvalue,$displayby)=@_;
56     if ($displayby =~ /status/i) {
57         unless ( grep { /$criteriumvalue/ } qw(ASKED ACCEPTED REJECTED CHECKED ORDERED AVAILABLE) ) {
58             my $av = Koha::AuthorisedValues->search({ category => 'SUGGEST_STATUS', authorised_value => $criteriumvalue });
59             return $av->count ? $av->next->lib : 'Unknown';
60         }
61         return ($criteriumvalue eq 'ASKED'?"Pending":ucfirst(lc( $criteriumvalue))) if ($displayby =~/status/i);
62     }
63     if ( $displayby =~ /branchcode/ ) {
64         return $criteriumvalue ? Koha::Libraries->find($criteriumvalue)->branchname : "__ANY__";
65     }
66     if ( $displayby =~ /itemtype/ ) {
67         my $av = Koha::AuthorisedValues->search({ category => 'SUGGEST_FORMAT', authorised_value => $criteriumvalue });
68         return $av->count ? $av->next->lib : 'Unknown';
69     }
70     if ($displayby =~/suggestedby/||$displayby =~/managedby/||$displayby =~/acceptedby/){
71         my $patron = Koha::Patrons->find( $criteriumvalue );
72         return "" unless $patron;
73         return $patron->surname . ", " . $patron->firstname;
74     }
75     if ( $displayby =~ /budgetid/) {
76         my $budget = GetBudget($criteriumvalue);
77         return "" unless $budget;
78         return $$budget{budget_name};
79     }
80 }
81
82 my $input           = CGI->new;
83 my $redirect  = $input->param('redirect');
84 my $suggestedbyme   = (defined $input->param('suggestedbyme')? $input->param('suggestedbyme'):1);
85 my $op              = $input->param('op')||'else';
86 my @editsuggestions = $input->multi_param('suggestionid');
87 my $suggestedby     = $input->param('suggestedby');
88 my $returnsuggestedby = $input->param('returnsuggestedby');
89 my $returnsuggested = $input->param('returnsuggested');
90 my $managedby       = $input->param('managedby');
91 my $displayby       = $input->param('displayby') || '';
92 my $tabcode         = $input->param('tabcode');
93 my $save_confirmed  = $input->param('save_confirmed') || 0;
94 my $notify          = $input->param('notify');
95 my $filter_archived = $input->param('filter_archived') || 0;
96
97 my $reasonsloop     = GetAuthorisedValues("SUGGEST");
98
99 # filter informations which are not suggestion related.
100 my $suggestion_ref  = { %{$input->Vars} }; # Copying, otherwise $input will be modified
101
102 # get only the columns of Suggestion
103 my $schema = Koha::Database->new()->schema;
104 my $columns = ' '.join(' ', $schema->source('Suggestion')->columns).' ';
105 my $suggestion_only = { map { $columns =~ / $_ / ? ($_ => $suggestion_ref->{$_}) : () } keys %$suggestion_ref };
106 $suggestion_only->{STATUS} = $suggestion_ref->{STATUS};
107
108 delete $$suggestion_ref{$_} foreach qw( suggestedbyme op displayby tabcode notify filter_archived );
109 foreach (keys %$suggestion_ref){
110     delete $$suggestion_ref{$_} if (!$$suggestion_ref{$_} && ($op eq 'else' ));
111 }
112 delete $suggestion_only->{branchcode} if $suggestion_only->{branchcode} eq '__ANY__';
113 delete $suggestion_only->{budgetid}   if $suggestion_only->{budgetid}   eq '__ANY__';
114 while ( my ( $k, $v ) = each %$suggestion_only ) {
115     delete $suggestion_only->{$k} if $v eq '';
116 }
117
118 my ( $template, $borrowernumber, $cookie, $userflags ) = get_template_and_user(
119         {
120             template_name   => "suggestion/suggestion.tt",
121             query           => $input,
122             type            => "intranet",
123             flagsrequired   => { suggestions => 'suggestions_manage' },
124         }
125     );
126
127 $borrowernumber = $input->param('borrowernumber') if ( $input->param('borrowernumber') );
128 $template->param('borrowernumber' => $borrowernumber);
129 my $branchfilter = $input->param('branchcode') || C4::Context->userenv->{'branch'};
130
131 #########################################
132 ##  Operations
133 ##
134
135 if ( $op =~ /save/i ) {
136     output_and_exit_if_error($input, $cookie, $template, { check => 'csrf_token' });
137     my @messages;
138     my $biblio = MarcRecordFromNewSuggestion({
139             title => $suggestion_only->{title},
140             author => $suggestion_only->{author},
141             itemtype => $suggestion_only->{itemtype},
142             isbn => $suggestion_only->{isbn},
143     });
144
145     my $manager = Koha::Patrons->find( $suggestion_only->{managedby} );
146     if ( $manager && not $manager->has_permission({suggestions => 'suggestions_manage'})) {
147         push @messages, { type => 'error', code => 'manager_not_enough_permissions' };
148         $template->param(
149             messages => \@messages,
150         );
151         delete $suggestion_ref->{suggesteddate};
152         delete $suggestion_ref->{manageddate};
153         delete $suggestion_ref->{managedby};
154         Init($suggestion_ref);
155     }
156     elsif ( !$suggestion_only->{suggestionid} && ( my ($duplicatebiblionumber, $duplicatetitle) = FindDuplicate($biblio) ) && !$save_confirmed ) {
157         push @messages, { type => 'error', code => 'biblio_exists', id => $duplicatebiblionumber, title => $duplicatetitle };
158         $template->param(
159             messages => \@messages,
160             need_confirm => 1
161         );
162         delete $suggestion_ref->{suggesteddate};
163         delete $suggestion_ref->{manageddate};
164         Init($suggestion_ref);
165     }
166     else {
167
168         for my $date_key ( qw( suggesteddate manageddate accepteddate rejecteddate ) ) {
169             # FIXME Do we need this?
170             $suggestion_only->{$date_key} = dt_from_string( $suggestion_only->{$date_key} )
171                 if $suggestion_only->{$date_key};
172         }
173
174         if ( $suggestion_only->{"STATUS"} ) {
175             if ( my $tmpstatus = lc( $suggestion_only->{"STATUS"} ) =~ /ACCEPTED|REJECTED/i ) {
176                 $suggestion_only->{ lc( $suggestion_only->{"STATUS"}) . "date" } = dt_from_string;
177                 $suggestion_only->{ lc( $suggestion_only->{"STATUS"}) . "by" }   = C4::Context->userenv->{number};
178             }
179             $suggestion_only->{manageddate} = dt_from_string;
180             $suggestion_only->{"managedby"} ||= C4::Context->userenv->{number};
181         }
182
183         my $otherreason = $input->param('other_reason');
184         if ($suggestion_only->{reason} eq 'other' && $otherreason) {
185             $suggestion_only->{reason} = $otherreason;
186         }
187
188         if ( $suggestion_only->{'suggestionid'} > 0 ) {
189
190             $suggestion_only->{lastmodificationdate} = dt_from_string;
191             $suggestion_only->{lastmodificationby}   = C4::Context->userenv->{number};
192             $suggestion_only->{branchcode} = undef
193               if exists $suggestion_only->{branchcode}
194               && $suggestion_only->{branchcode} eq "";
195
196             &ModSuggestion($suggestion_only);
197
198             if ( $notify ) {
199                 my $patron = Koha::Patrons->find( $suggestion_only->{managedby} );
200                 my $email_address = $patron->notice_email_address;
201                 if ($patron->notice_email_address) {
202
203                     my $letter = C4::Letters::GetPreparedLetter(
204                         module      => 'suggestions',
205                         letter_code => 'NOTIFY_MANAGER',
206                         branchcode  => $patron->branchcode,
207                         lang        => $patron->lang,
208                         tables      => {
209                             suggestions => $suggestion_only->{suggestionid},
210                             branches    => $patron->branchcode,
211                             borrowers   => $patron->borrowernumber,
212                         },
213                     );
214                     C4::Letters::EnqueueLetter(
215                         {
216                             letter                 => $letter,
217                             borrowernumber         => $patron->borrowernumber,
218                             message_transport_type => 'email'
219                         }
220                     );
221                 }
222             }
223         } else {
224             ###FIXME:Search here if suggestion already exists.
225             my $suggestions= Koha::Suggestions->search_limited( $suggestion_only );
226             if ( $suggestions->count ) {
227                 #some suggestion are answering the request Donot Add
228                 my @messages;
229                 while ( my $suggestion = $suggestions->next ) {
230                     push @messages, { type => 'error', code => 'already_exists', id => $suggestion->suggestionid };
231                 }
232                 $template->param( messages => \@messages );
233             }
234             else {
235                 ## Adding some informations related to suggestion
236                 &NewSuggestion($suggestion_only);
237             }
238             # empty fields, to avoid filter in "SearchSuggestion"
239         }
240         map{delete $$suggestion_ref{$_} unless $_ eq 'branchcode' } keys %$suggestion_ref;
241         $op = 'else';
242
243         if( $redirect eq 'purchase_suggestions' ) {
244             print $input->redirect("/cgi-bin/koha/members/purchase-suggestions.pl?borrowernumber=$borrowernumber");
245         }
246     }
247 }
248 elsif ($op=~/add/) {
249     #Adds suggestion
250     Init($suggestion_ref);
251     $op ='save';
252 }
253 elsif ($op=~/edit/) {
254     #Edit suggestion
255     output_and_exit_if_error($input, $cookie, $template, { check => 'csrf_token' });
256     $suggestion_ref=&GetSuggestion($$suggestion_ref{'suggestionid'});
257     $suggestion_ref->{reasonsloop} = $reasonsloop;
258     my $other_reason = 1;
259     foreach my $reason ( @{ $reasonsloop } ) {
260         if ($suggestion_ref->{reason} eq $reason->{lib}) {
261             $other_reason = 0;
262         }
263     }
264     $other_reason = 0 unless $suggestion_ref->{reason};
265     $template->param(other_reason => $other_reason);
266     Init($suggestion_ref);
267     $op ='save';
268 }  
269 elsif ($op eq "update_status" ) {
270     output_and_exit_if_error($input, $cookie, $template, { check => 'csrf_token' });
271     my $suggestion;
272     # set accepted/rejected/managed informations if applicable
273     # ie= if the librarian has chosen some action on the suggestions
274     my $STATUS      = $input->param('STATUS');
275     my $accepted_by = $input->param('acceptedby');
276     if ( $STATUS eq "ACCEPTED" ) {
277         $suggestion = {
278             accepteddate => dt_from_string,
279             acceptedby => C4::Context->userenv->{number},
280         };
281     }
282     elsif ( $STATUS eq "REJECTED" ) {
283         $suggestion = {
284             rejecteddate => dt_from_string,
285             rejectedby   => C4::Context->userenv->{number},
286         };
287     }
288     if ($STATUS) {
289         $suggestion->{manageddate} = dt_from_string;
290         $suggestion->{managedby}   = C4::Context->userenv->{number};
291         $suggestion->{STATUS}      = $STATUS;
292     }
293     if ( my $reason = $input->param("reason") ) {
294         if ( $reason eq "other" ) {
295             $reason = $input->param("other_reason");
296         }
297         $suggestion->{reason} = $reason;
298     }
299
300     foreach my $suggestionid (@editsuggestions) {
301         next unless $suggestionid;
302         $suggestion->{suggestionid} = $suggestionid;
303         &ModSuggestion($suggestion);
304     }
305     redirect_with_params($input);
306 }elsif ($op eq "delete" ) {
307     output_and_exit_if_error($input, $cookie, $template, { check => 'csrf_token' });
308     foreach my $delete_field (@editsuggestions) {
309         &DelSuggestion( $borrowernumber, $delete_field,'intranet' );
310     }
311     redirect_with_params($input);
312 }
313 elsif ($op eq "archive" ) {
314     Koha::Suggestions->find($_)->update({ archived => 1 }) for @editsuggestions;
315
316     redirect_with_params($input);
317 }
318 elsif ($op eq "unarchive" ) {
319     Koha::Suggestions->find($_)->update({ archived => 0 }) for @editsuggestions;
320
321     redirect_with_params($input);
322 }
323 elsif ( $op eq 'update_itemtype' ) {
324     my $new_itemtype = $input->param('suggestion_itemtype');
325     foreach my $suggestionid (@editsuggestions) {
326         next unless $suggestionid;
327         &ModSuggestion({ suggestionid => $suggestionid, itemtype => $new_itemtype });
328     }
329     redirect_with_params($input);
330 }
331 elsif ( $op eq 'update_manager' ) {
332     my $managedby = $input->param('suggestion_managedby');
333     foreach my $suggestionid (@editsuggestions) {
334         next unless $suggestionid;
335         &ModSuggestion({ suggestionid => $suggestionid, managedby => $managedby });
336     }
337     redirect_with_params($input);
338 }
339 elsif ( $op eq 'show' ) {
340     $suggestion_ref=&GetSuggestion($$suggestion_ref{'suggestionid'});
341     my $budget = GetBudget $$suggestion_ref{budgetid};
342     $$suggestion_ref{budgetname} = $$budget{budget_name};
343     Init($suggestion_ref);
344 }
345 if ($op=~/else/) {
346     $op='else';
347
348     $displayby||="STATUS";
349     # distinct values of display by
350     my $criteria_list=GetDistinctValues("suggestions.".$displayby);
351     my (@criteria_dv, $criteria_has_empty);
352     foreach (@$criteria_list) {
353         if ($_->{value}) {
354             push @criteria_dv, $_->{value};
355         } else {
356             $criteria_has_empty = 1;
357         }
358     }
359     # aggregate null and empty values under empty value
360     push @criteria_dv, '' if $criteria_has_empty;
361
362     # Hack to not modify GetDistinctValues for this specific case
363     if (   $displayby eq 'branchcode'
364         && C4::Context->preference('IndependentBranches')
365         && not C4::Context->IsSuperLibrarian )
366     {
367         @criteria_dv = ( C4::Context->userenv->{'branch'} );
368     }
369     # Pending tab first
370     if ( $displayby eq 'STATUS' ) {
371         @criteria_dv = grep { $_ ne 'ASKED' } @criteria_dv;
372         unshift @criteria_dv, 'ASKED';
373     }
374
375     unless ( exists $suggestion_ref->{branchcode} ) {
376         $suggestion_ref->{branchcode} = C4::Context->userenv->{'branch'};
377     }
378
379     my @allsuggestions;
380     foreach my $criteriumvalue ( @criteria_dv ) {
381         my $search_params = {%$suggestion_ref};
382
383         next
384           if $search_params->{STATUS}
385           && $displayby eq 'STATUS'
386           && $criteriumvalue ne $search_params->{STATUS};
387
388         # By default, display suggestions from current working branch
389         my $definedvalue = defined $$suggestion_ref{$displayby} && $$suggestion_ref{$displayby} ne "";
390
391         next if ( $definedvalue && $$suggestion_ref{$displayby} ne $criteriumvalue ) and ($displayby ne 'branchcode' && $branchfilter ne '__ANY__' );
392
393         $search_params->{$displayby} = $criteriumvalue;
394
395         # filter on date fields
396         foreach my $field (qw( suggesteddate manageddate accepteddate )) {
397             my $from    = delete $search_params->{"${field}_from"};
398             my $to      = delete $search_params->{"${field}_to"};
399
400             my $from_dt = $from && eval { dt_from_string($from) };
401             my $to_dt   = $to && eval { dt_from_string($to) };
402
403             if ( $from_dt || $to_dt ) {
404                 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
405                 if ( $from_dt && $to_dt ) {
406                     $search_params->{$field} = { -between => [ $dtf->format_date($from_dt), $dtf->format_date($to_dt) ] };
407                 } elsif ( $from_dt ) {
408                     $search_params->{$field} = { '>=' => $dtf->format_date($from_dt) };
409                 } elsif ( $to_dt ) {
410                     $search_params->{$field} = { '<=' => $dtf->format_date($to_dt) };
411                 }
412             }
413         }
414         if ( $search_params->{budgetid} && $search_params->{budgetid} eq '__NONE__' ) {
415             $search_params->{budgetid} = [undef, '' ];
416         }
417         for my $f (qw (branchcode budgetid)) {
418             delete $search_params->{$f}
419               if $search_params->{$f} eq '__ANY__'
420               || $search_params->{$f} eq '';
421         }
422
423         $search_params->{archived} = 0 if !$filter_archived;
424         my @suggestions = Koha::Suggestions->search_limited($search_params)->as_list;
425
426         push @allsuggestions,
427           {
428             "suggestiontype"      => $criteriumvalue || "suggest",
429             "suggestiontypelabel" => GetCriteriumDesc( $criteriumvalue, $displayby ) || "",
430             'suggestions'         => \@suggestions,
431             'reasonsloop'         => $reasonsloop,
432           }
433           if scalar @suggestions > 0;
434
435         delete $$suggestion_ref{$displayby} unless $definedvalue;
436     }
437
438     $template->param(
439         "displayby"=> $displayby,
440         "notabs"=> $displayby eq "",
441         suggestions       => \@allsuggestions,
442     );
443 }
444
445 $template->param(
446     "${_}_patron" => scalar Koha::Patrons->find( $suggestion_ref->{$_} ) )
447   for qw(managedby suggestedby acceptedby lastmodificationby);
448
449 $template->param(
450     %$suggestion_ref,
451     filter_archived => $filter_archived,
452     "op"             =>$op,
453 );
454
455 if(defined($returnsuggested) and $returnsuggested ne "noone")
456 {
457     print $input->redirect("/cgi-bin/koha/members/moremember.pl?borrowernumber=".$returnsuggested."#suggestions");
458 }
459
460 $template->param(
461     branchfilter => $branchfilter,
462 );
463
464 $template->param( returnsuggestedby => $returnsuggestedby );
465
466 my $patron_reason_loop = GetAuthorisedValues("OPAC_SUG");
467 $template->param(patron_reason_loop=>$patron_reason_loop);
468
469 # Budgets for filtering
470 my $budgets = GetBudgets;
471 my @budgets_loop;
472 foreach my $budget ( @{$budgets} ) {
473     next unless (CanUserUseBudget($borrowernumber, $budget, $userflags));
474
475     ## Please see file perltidy.ERR
476     $budget->{'selected'} = 1
477         if ($$suggestion_ref{'budgetid'}
478         && $budget->{'budget_id'} eq $$suggestion_ref{'budgetid'});
479
480     push @budgets_loop, $budget;
481 }
482 $template->param( budgetsloop => \@budgets_loop);
483
484 # Budgets for suggestion add or edition
485 my $sugg_budget_loop = [];
486 my $sugg_budgets     = GetBudgetHierarchy();
487 foreach my $r ( @{$sugg_budgets} ) {
488     next unless ( CanUserUseBudget( $borrowernumber, $r, $userflags ) );
489     my $selected = ( $$suggestion_ref{budgetid} && $r->{budget_id} eq $$suggestion_ref{budgetid} ) ? 1 : 0;
490     push @{$sugg_budget_loop},
491       {
492         b_id     => $r->{budget_id},
493         b_txt    => $r->{budget_name},
494         b_active => $r->{budget_period_active},
495         selected => $selected,
496       };
497 }
498 @{$sugg_budget_loop} = sort { uc( $a->{b_txt} ) cmp uc( $b->{b_txt} ) } @{$sugg_budget_loop};
499 $template->param( sugg_budgets => $sugg_budget_loop);
500
501 if( $suggestion_ref->{STATUS} ) {
502     $template->param(
503         "statusselected_".$suggestion_ref->{STATUS} => 1,
504         selected_status => $suggestion_ref->{STATUS}, # We need template var selected_status in the second part of the template where template var suggestion.STATUS is out of scope
505     );
506 }
507
508 my $currencies = Koha::Acquisition::Currencies->search;
509 $template->param(
510     currencies   => $currencies,
511     suggestion   => $suggestion_ref,
512     price        => sprintf("%.2f", $$suggestion_ref{'price'}||0),
513     total            => sprintf("%.2f", $$suggestion_ref{'total'}||0),
514 );
515
516 # lists of distinct values (without empty) for filters
517 my %hashlists;
518 foreach my $field ( qw(managedby acceptedby suggestedby budgetid) ) {
519     my $values_list;
520     $values_list = GetDistinctValues( "suggestions." . $field );
521     my @codes_list = map {
522         {   'code' => $$_{'value'},
523             'desc' => GetCriteriumDesc( $$_{'value'}, $field ) || $$_{'value'},
524             'selected' => ($$suggestion_ref{$field}) ? $$_{'value'} eq $$suggestion_ref{$field} : 0,
525         }
526     } grep {
527         $$_{'value'}
528     } @$values_list;
529     $hashlists{ lc($field) . "_loop" } = \@codes_list;
530 }
531
532 $template->param(
533     %hashlists,
534     borrowernumber           => ($input->param('borrowernumber') // undef),
535     SuggestionStatuses       => GetAuthorisedValues('SUGGEST_STATUS'),
536 );
537 output_html_with_http_headers $input, $cookie, $template->output;
538
539 sub redirect_with_params {
540     my ( $input ) = @_;
541     my $params = '';
542     foreach my $key (
543         qw(
544         displayby branchcode title author isbn publishercode copyrightdate
545         collectiontitle suggestedby suggesteddate_from suggesteddate_to
546         manageddate_from manageddate_to accepteddate_from
547         accepteddate_to budgetid filter_archived
548         )
549       )
550     {
551         $params .= $key . '=' . uri_escape(scalar $input->param($key)) . '&'
552           if defined($input->param($key));
553     }
554     print $input->redirect("/cgi-bin/koha/suggestion/suggestion.pl?$params");
555 }