Bug 26265: (QA follow-up) Remove g option from regex, add few dirs
[koha.git] / admin / smart-rules.pl
1 #!/usr/bin/perl
2 # Copyright 2000-2002 Katipo Communications
3 # copyright 2010 BibLibre
4 #
5 # This file is part of Koha.
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 use CGI qw ( -utf8 );
22 use C4::Context;
23 use C4::Output;
24 use C4::Auth;
25 use C4::Koha;
26 use C4::Debug;
27 use Koha::DateUtils;
28 use Koha::Database;
29 use Koha::Logger;
30 use Koha::Libraries;
31 use Koha::CirculationRules;
32 use Koha::Patron::Categories;
33 use Koha::Caches;
34 use Koha::Patrons;
35
36 my $input = CGI->new;
37 my $dbh = C4::Context->dbh;
38
39 # my $flagsrequired;
40 # $flagsrequired->{circulation}=1;
41 my ($template, $loggedinuser, $cookie)
42     = get_template_and_user({template_name => "admin/smart-rules.tt",
43                             query => $input,
44                             type => "intranet",
45                             authnotrequired => 0,
46                             flagsrequired => {parameters => 'manage_circ_rules'},
47                             debug => 1,
48                             });
49
50 my $type=$input->param('type');
51
52 my $branch = $input->param('branch');
53 unless ( $branch ) {
54     if ( C4::Context->preference('DefaultToLoggedInLibraryCircRules') ) {
55         $branch = Koha::Libraries->search->count() == 1 ? undef : C4::Context::mybranch();
56     }
57     else {
58         $branch = C4::Context::only_my_library() ? ( C4::Context::mybranch() || '*' ) : '*';
59     }
60 }
61
62 my $logged_in_patron = Koha::Patrons->find( $loggedinuser );
63
64 my $can_edit_from_any_library = $logged_in_patron->has_permission( {parameters => 'manage_circ_rules_from_any_libraries' } );
65 $template->param( restricted_to_own_library => not $can_edit_from_any_library );
66 $branch = C4::Context::mybranch() unless $can_edit_from_any_library;
67
68 my $op = $input->param('op') || q{};
69 my $language = C4::Languages::getlanguage();
70
71 my $cache = Koha::Caches->get_instance;
72 $cache->clear_from_cache( Koha::CirculationRules::GUESSED_ITEMTYPES_KEY );
73
74 if ($op eq 'delete') {
75     my $itemtype     = $input->param('itemtype');
76     my $categorycode = $input->param('categorycode');
77     $debug and warn "deleting $1 $2 $branch";
78
79     Koha::CirculationRules->set_rules(
80         {
81             categorycode => $categorycode eq '*' ? undef : $categorycode,
82             branchcode   => $branch eq '*' ? undef : $branch,
83             itemtype     => $itemtype eq '*' ? undef : $itemtype,
84             rules        => {
85                 maxissueqty                      => undef,
86                 maxonsiteissueqty                => undef,
87                 rentaldiscount                   => undef,
88                 fine                             => undef,
89                 finedays                         => undef,
90                 maxsuspensiondays                => undef,
91                 suspension_chargeperiod          => undef,
92                 firstremind                      => undef,
93                 chargeperiod                     => undef,
94                 chargeperiod_charge_at           => undef,
95                 issuelength                      => undef,
96                 daysmode                         => undef,
97                 lengthunit                       => undef,
98                 hardduedate                      => undef,
99                 hardduedatecompare               => undef,
100                 renewalsallowed                  => undef,
101                 renewalperiod                    => undef,
102                 norenewalbefore                  => undef,
103                 auto_renew                       => undef,
104                 no_auto_renewal_after            => undef,
105                 no_auto_renewal_after_hard_limit => undef,
106                 reservesallowed                  => undef,
107                 holds_per_record                 => undef,
108                 holds_per_day                    => undef,
109                 onshelfholds                     => undef,
110                 opacitemholds                    => undef,
111                 overduefinescap                  => undef,
112                 cap_fine_to_replacement_price    => undef,
113                 article_requests                 => undef,
114                 note                             => undef,
115             }
116         }
117     );
118 }
119 elsif ($op eq 'delete-branch-cat') {
120     my $categorycode  = $input->param('categorycode');
121     if ($branch eq "*") {
122         if ($categorycode eq "*") {
123             Koha::CirculationRules->set_rules(
124                 {
125                     branchcode   => undef,
126                     categorycode => undef,
127                     rules        => {
128                         max_holds                      => undef,
129                         patron_maxissueqty             => undef,
130                         patron_maxonsiteissueqty       => undef,
131                     }
132                 }
133             );
134             Koha::CirculationRules->set_rules(
135                 {
136                     branchcode   => undef,
137                     itemtype     => undef,
138                     rules        => {
139                         holdallowed             => undef,
140                         hold_fulfillment_policy => undef,
141                         returnbranch            => undef,
142                     }
143                 }
144             );
145         } else {
146             Koha::CirculationRules->set_rules(
147                 {
148                     categorycode => $categorycode,
149                     branchcode   => undef,
150                     rules        => {
151                         max_holds                => undef,
152                         patron_maxissueqty       => undef,
153                         patron_maxonsiteissueqty => undef,
154                     }
155                 }
156             );
157         }
158     } elsif ($categorycode eq "*") {
159         Koha::CirculationRules->set_rules(
160             {
161                 branchcode   => $branch,
162                 categorycode => undef,
163                 rules        => {
164                     max_holds                => undef,
165                     patron_maxissueqty       => undef,
166                     patron_maxonsiteissueqty => undef,
167                 }
168             }
169         );
170         Koha::CirculationRules->set_rules(
171             {
172                 branchcode   => $branch,
173                 itemtype     => undef,
174                 rules        => {
175                     holdallowed             => undef,
176                     hold_fulfillment_policy => undef,
177                     returnbranch            => undef,
178                 }
179             }
180         );
181     } else {
182         Koha::CirculationRules->set_rules(
183             {
184                 categorycode => $categorycode,
185                 branchcode   => $branch,
186                 rules        => {
187                     max_holds         => undef,
188                     patron_maxissueqty       => undef,
189                     patron_maxonsiteissueqty => undef,
190                 }
191             }
192         );
193     }
194 }
195 elsif ($op eq 'delete-branch-item') {
196     my $itemtype  = $input->param('itemtype');
197     if ($branch eq "*") {
198         if ($itemtype eq "*") {
199             Koha::CirculationRules->set_rules(
200                 {
201                     branchcode   => undef,
202                     itemtype     => undef,
203                     rules        => {
204                         holdallowed             => undef,
205                         hold_fulfillment_policy => undef,
206                         returnbranch            => undef,
207                     }
208                 }
209             );
210         } else {
211             Koha::CirculationRules->set_rules(
212                 {
213                     branchcode   => undef,
214                     itemtype     => $itemtype,
215                     rules        => {
216                         holdallowed             => undef,
217                         hold_fulfillment_policy => undef,
218                         returnbranch            => undef,
219                     }
220                 }
221             );
222         }
223     } elsif ($itemtype eq "*") {
224         Koha::CirculationRules->set_rules(
225             {
226                 branchcode   => $branch,
227                 itemtype     => undef,
228                 rules        => {
229                     holdallowed             => undef,
230                     hold_fulfillment_policy => undef,
231                     returnbranch            => undef,
232                 }
233             }
234         );
235     } else {
236         Koha::CirculationRules->set_rules(
237             {
238                 branchcode   => $branch,
239                 itemtype     => $itemtype,
240                 rules        => {
241                     holdallowed             => undef,
242                     hold_fulfillment_policy => undef,
243                     returnbranch            => undef,
244                 }
245             }
246         );
247     }
248 }
249 # save the values entered
250 elsif ($op eq 'add') {
251     my $br = $branch; # branch
252     my $bor  = $input->param('categorycode'); # borrower category
253     my $itemtype  = $input->param('itemtype');     # item type
254     my $fine = $input->param('fine');
255     my $finedays     = $input->param('finedays');
256     my $maxsuspensiondays = $input->param('maxsuspensiondays') || '';
257     my $suspension_chargeperiod = $input->param('suspension_chargeperiod') || 1;
258     my $firstremind  = $input->param('firstremind');
259     my $chargeperiod = $input->param('chargeperiod');
260     my $chargeperiod_charge_at = $input->param('chargeperiod_charge_at');
261     my $maxissueqty = strip_non_numeric( scalar $input->param('maxissueqty') );
262     my $maxonsiteissueqty = strip_non_numeric( scalar $input->param('maxonsiteissueqty') );
263     my $renewalsallowed  = $input->param('renewalsallowed');
264     my $renewalperiod    = $input->param('renewalperiod');
265     my $norenewalbefore  = $input->param('norenewalbefore');
266     $norenewalbefore = '' if $norenewalbefore =~ /^\s*$/;
267     my $auto_renew = $input->param('auto_renew') eq 'yes' ? 1 : 0;
268     my $no_auto_renewal_after = $input->param('no_auto_renewal_after');
269     $no_auto_renewal_after = '' if $no_auto_renewal_after =~ /^\s*$/;
270     my $no_auto_renewal_after_hard_limit = $input->param('no_auto_renewal_after_hard_limit') || '';
271     $no_auto_renewal_after_hard_limit = eval { dt_from_string( scalar $no_auto_renewal_after_hard_limit ) } if ( $no_auto_renewal_after_hard_limit );
272     $no_auto_renewal_after_hard_limit = output_pref( { dt => $no_auto_renewal_after_hard_limit, dateonly => 1, dateformat => 'iso' } ) if ( $no_auto_renewal_after_hard_limit );
273     my $reservesallowed  = strip_non_numeric( scalar $input->param('reservesallowed') );
274     my $holds_per_record = strip_non_numeric( scalar $input->param('holds_per_record') );
275     my $holds_per_day    = strip_non_numeric( scalar $input->param('holds_per_day') );
276     my $onshelfholds     = $input->param('onshelfholds') || 0;
277     my $issuelength  = $input->param('issuelength');
278     $issuelength = $issuelength eq q{} ? undef : $issuelength;
279     my $daysmode = $input->param('daysmode');
280     my $lengthunit  = $input->param('lengthunit');
281     my $hardduedate = $input->param('hardduedate') || undef;
282     $hardduedate = eval { dt_from_string( scalar $hardduedate ) } if ( $hardduedate );
283     $hardduedate = output_pref( { dt => $hardduedate, dateonly => 1, dateformat => 'iso' } ) if ( $hardduedate );
284     my $hardduedatecompare = $input->param('hardduedatecompare');
285     my $rentaldiscount = $input->param('rentaldiscount');
286     my $opacitemholds = $input->param('opacitemholds') || 0;
287     my $article_requests = $input->param('article_requests') || 'no';
288     my $overduefinescap = $input->param('overduefinescap') || '';
289     my $cap_fine_to_replacement_price = ($input->param('cap_fine_to_replacement_price') || '') eq 'on';
290     my $note = $input->param('note');
291     $debug and warn "Adding $br, $bor, $itemtype, $fine, $maxissueqty, $maxonsiteissueqty, $cap_fine_to_replacement_price";
292
293     my $rules = {
294         maxissueqty                   => $maxissueqty,
295         maxonsiteissueqty             => $maxonsiteissueqty,
296         rentaldiscount                => $rentaldiscount,
297         fine                          => $fine,
298         finedays                      => $finedays,
299         maxsuspensiondays             => $maxsuspensiondays,
300         suspension_chargeperiod       => $suspension_chargeperiod,
301         firstremind                   => $firstremind,
302         chargeperiod                  => $chargeperiod,
303         chargeperiod_charge_at        => $chargeperiod_charge_at,
304         issuelength                   => $issuelength,
305         daysmode                      => $daysmode,
306         lengthunit                    => $lengthunit,
307         hardduedate                   => $hardduedate,
308         hardduedatecompare            => $hardduedatecompare,
309         renewalsallowed               => $renewalsallowed,
310         renewalperiod                 => $renewalperiod,
311         norenewalbefore               => $norenewalbefore,
312         auto_renew                    => $auto_renew,
313         no_auto_renewal_after         => $no_auto_renewal_after,
314         no_auto_renewal_after_hard_limit => $no_auto_renewal_after_hard_limit,
315         reservesallowed               => $reservesallowed,
316         holds_per_record              => $holds_per_record,
317         holds_per_day                 => $holds_per_day,
318         onshelfholds                  => $onshelfholds,
319         opacitemholds                 => $opacitemholds,
320         overduefinescap               => $overduefinescap,
321         cap_fine_to_replacement_price => $cap_fine_to_replacement_price,
322         article_requests              => $article_requests,
323         note                          => $note,
324     };
325
326     Koha::CirculationRules->set_rules(
327         {
328             categorycode => $bor eq '*' ? undef : $bor,
329             itemtype     => $itemtype eq '*' ? undef : $itemtype,
330             branchcode   => $br eq '*' ? undef : $br,
331             rules        => $rules,
332         }
333     );
334
335 }
336 elsif ($op eq "set-branch-defaults") {
337     my $categorycode  = $input->param('categorycode');
338     my $patron_maxissueqty = strip_non_numeric( scalar $input->param('patron_maxissueqty') );
339     my $patron_maxonsiteissueqty = $input->param('patron_maxonsiteissueqty');
340     $patron_maxonsiteissueqty = strip_non_numeric($patron_maxonsiteissueqty);
341     my $holdallowed   = $input->param('holdallowed');
342     my $hold_fulfillment_policy = $input->param('hold_fulfillment_policy');
343     my $returnbranch  = $input->param('returnbranch');
344     my $max_holds = strip_non_numeric( scalar $input->param('max_holds') );
345     $holdallowed =~ s/\s//g;
346     $holdallowed = undef if $holdallowed !~ /^\d+/;
347
348     if ($branch eq "*") {
349         Koha::CirculationRules->set_rules(
350             {
351                 itemtype     => undef,
352                 branchcode   => undef,
353                 rules        => {
354                     holdallowed             => $holdallowed,
355                     hold_fulfillment_policy => $hold_fulfillment_policy,
356                     returnbranch            => $returnbranch,
357                 }
358             }
359         );
360         Koha::CirculationRules->set_rules(
361             {
362                 categorycode => undef,
363                 branchcode   => undef,
364                 rules        => {
365                     patron_maxissueqty             => $patron_maxissueqty,
366                     patron_maxonsiteissueqty       => $patron_maxonsiteissueqty,
367                 }
368             }
369         );
370     } else {
371         Koha::CirculationRules->set_rules(
372             {
373                 itemtype     => undef,
374                 branchcode   => $branch,
375                 rules        => {
376                     holdallowed             => $holdallowed,
377                     hold_fulfillment_policy => $hold_fulfillment_policy,
378                     returnbranch            => $returnbranch,
379                 }
380             }
381         );
382         Koha::CirculationRules->set_rules(
383             {
384                 categorycode => undef,
385                 branchcode   => $branch,
386                 rules        => {
387                     patron_maxissueqty             => $patron_maxissueqty,
388                     patron_maxonsiteissueqty       => $patron_maxonsiteissueqty,
389                 }
390             }
391         );
392     }
393     Koha::CirculationRules->set_rule(
394         {
395             branchcode   => $branch,
396             categorycode => undef,
397             rule_name    => 'max_holds',
398             rule_value   => $max_holds,
399         }
400     );
401 }
402 elsif ($op eq "add-branch-cat") {
403     my $categorycode  = $input->param('categorycode');
404     my $patron_maxissueqty = strip_non_numeric( scalar $input->param('patron_maxissueqty') );
405     my $patron_maxonsiteissueqty = $input->param('patron_maxonsiteissueqty');
406     $patron_maxonsiteissueqty = strip_non_numeric($patron_maxonsiteissueqty);
407     my $max_holds = $input->param('max_holds');
408     $max_holds =~ s/\s//g;
409     $max_holds = undef if $max_holds !~ /^\d+/;
410
411     if ($branch eq "*") {
412         if ($categorycode eq "*") {
413             Koha::CirculationRules->set_rules(
414                 {
415                     categorycode => undef,
416                     branchcode   => undef,
417                     rules        => {
418                         max_holds         => $max_holds,
419                         patron_maxissueqty       => $patron_maxissueqty,
420                         patron_maxonsiteissueqty => $patron_maxonsiteissueqty,
421                     }
422                 }
423             );
424         } else {
425             Koha::CirculationRules->set_rules(
426                 {
427                     categorycode => $categorycode,
428                     branchcode   => undef,
429                     rules        => {
430                         max_holds         => $max_holds,
431                         patron_maxissueqty       => $patron_maxissueqty,
432                         patron_maxonsiteissueqty => $patron_maxonsiteissueqty,
433                     }
434                 }
435             );
436         }
437     } elsif ($categorycode eq "*") {
438         Koha::CirculationRules->set_rules(
439             {
440                 categorycode => undef,
441                 branchcode   => $branch,
442                 rules        => {
443                     max_holds         => $max_holds,
444                     patron_maxissueqty       => $patron_maxissueqty,
445                     patron_maxonsiteissueqty => $patron_maxonsiteissueqty,
446                 }
447             }
448         );
449     } else {
450         Koha::CirculationRules->set_rules(
451             {
452                 categorycode => $categorycode,
453                 branchcode   => $branch,
454                 rules        => {
455                     max_holds         => $max_holds,
456                     patron_maxissueqty       => $patron_maxissueqty,
457                     patron_maxonsiteissueqty => $patron_maxonsiteissueqty,
458                 }
459             }
460         );
461     }
462 }
463 elsif ($op eq "add-branch-item") {
464     my $itemtype                = $input->param('itemtype');
465     my $holdallowed             = $input->param('holdallowed');
466     my $hold_fulfillment_policy = $input->param('hold_fulfillment_policy');
467     my $returnbranch            = $input->param('returnbranch');
468
469     $holdallowed =~ s/\s//g;
470     $holdallowed = undef if $holdallowed !~ /^\d+/;
471
472     if ($branch eq "*") {
473         if ($itemtype eq "*") {
474             Koha::CirculationRules->set_rules(
475                 {
476                     itemtype     => undef,
477                     branchcode   => undef,
478                     rules        => {
479                         holdallowed             => $holdallowed,
480                         hold_fulfillment_policy => $hold_fulfillment_policy,
481                         returnbranch            => $returnbranch,
482                     }
483                 }
484             );
485         } else {
486             Koha::CirculationRules->set_rules(
487                 {
488                     itemtype     => $itemtype,
489                     branchcode   => undef,
490                     rules        => {
491                         holdallowed             => $holdallowed,
492                         hold_fulfillment_policy => $hold_fulfillment_policy,
493                         returnbranch            => $returnbranch,
494                     }
495                 }
496             );
497         }
498     } elsif ($itemtype eq "*") {
499             Koha::CirculationRules->set_rules(
500                 {
501                     itemtype     => undef,
502                     branchcode   => $branch,
503                     rules        => {
504                         holdallowed             => $holdallowed,
505                         hold_fulfillment_policy => $hold_fulfillment_policy,
506                         returnbranch            => $returnbranch,
507                     }
508                 }
509             );
510     } else {
511         Koha::CirculationRules->set_rules(
512             {
513                 itemtype     => $itemtype,
514                 branchcode   => $branch,
515                 rules        => {
516                     holdallowed             => $holdallowed,
517                     hold_fulfillment_policy => $hold_fulfillment_policy,
518                     returnbranch            => $returnbranch,
519                 }
520             }
521         );
522     }
523 }
524 elsif ( $op eq 'mod-refund-lost-item-fee-rule' ) {
525
526     my $refund = $input->param('refund');
527
528     if ( $refund eq '*' ) {
529         if ( $branch ne '*' ) {
530             # only do something for $refund eq '*' if branch-specific
531             Koha::CirculationRules->set_rules(
532                 {
533                     branchcode   => $branch,
534                     rules        => {
535                         refund => undef
536                     }
537                 }
538             );
539         }
540     } else {
541         Koha::CirculationRules->set_rules(
542             {
543                 branchcode   => $branch,
544                 rules        => {
545                     refund => $refund
546                 }
547             }
548         );
549     }
550 }
551
552 my $refundLostItemFeeRule = Koha::CirculationRules->find({ branchcode => ($branch eq '*') ? undef : $branch, rule_name => 'refund' });
553 my $defaultLostItemFeeRule = Koha::CirculationRules->find({ branchcode => undef, rule_name => 'refund' });
554 $template->param(
555     refundLostItemFeeRule => $refundLostItemFeeRule,
556     defaultRefundRule     => $defaultLostItemFeeRule ? $defaultLostItemFeeRule->rule_value : 1
557 );
558
559 my $patron_categories = Koha::Patron::Categories->search({}, { order_by => ['description'] });
560
561 my $itemtypes = Koha::ItemTypes->search_with_localization;
562
563 my $humanbranch = ( $branch ne '*' ? $branch : undef );
564
565 my $all_rules = Koha::CirculationRules->search({ branchcode => $humanbranch });
566 my $definedbranch = $all_rules->count ? 1 : 0;
567
568 my $rules = {};
569 while ( my $r = $all_rules->next ) {
570     $r = $r->unblessed;
571     $rules->{ $r->{categorycode} // '' }->{ $r->{itemtype} // '' }->{ $r->{rule_name} } = $r->{rule_value};
572 }
573
574 $template->param(show_branch_cat_rule_form => 1);
575
576 $template->param(
577     patron_categories => $patron_categories,
578     itemtypeloop      => $itemtypes,
579     humanbranch       => $humanbranch,
580     current_branch    => $branch,
581     definedbranch     => $definedbranch,
582     all_rules         => $rules,
583 );
584 output_html_with_http_headers $input, $cookie, $template->output;
585
586 exit 0;
587
588 # sort by patron category, then item type, putting
589 # default entries at the bottom
590 sub by_category_and_itemtype {
591     unless (by_category($a, $b)) {
592         return by_itemtype($a, $b);
593     }
594 }
595
596 sub by_category {
597     my ($a, $b) = @_;
598     if ($a->{'default_humancategorycode'}) {
599         return ($b->{'default_humancategorycode'} ? 0 : 1);
600     } elsif ($b->{'default_humancategorycode'}) {
601         return -1;
602     } else {
603         return $a->{'humancategorycode'} cmp $b->{'humancategorycode'};
604     }
605 }
606
607 sub by_itemtype {
608     my ($a, $b) = @_;
609     if ($a->{default_translated_description}) {
610         return ($b->{'default_translated_description'} ? 0 : 1);
611     } elsif ($b->{'default_translated_description'}) {
612         return -1;
613     } else {
614         return lc $a->{'translated_description'} cmp lc $b->{'translated_description'};
615     }
616 }
617
618 sub strip_non_numeric {
619     my $string = shift;
620     $string =~ s/\s//g;
621     $string = '' if $string !~ /^\d+/;
622     return $string;
623 }