"Fossies" - the Fresh Open Source Software Archive 
Member "koha-19.11.15/misc/cronjobs/fines.pl" (23 Feb 2021, 5836 Bytes) of package /linux/misc/koha-19.11.15.tar.gz:
As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style:
standard) with prefixed line numbers and
code folding option.
Alternatively you can here
view or
download the uninterpreted source code file.
For more information about "fines.pl" see the
Fossies "Dox" file reference documentation and the last
Fossies "Diffs" side-by-side code changes report:
20.11.01_vs_20.11.02.
1 #!/usr/bin/perl
2
3 # This script loops through each overdue item, determines the fine,
4 # and updates the total amount of fines due by each user. It relies on
5 # the existence of /tmp/fines, which is created by ???
6 # Doesn't really rely on it, it relys on being able to write to /tmp/
7 # It creates the fines file
8 #
9 # This script is meant to be run nightly out of cron.
10
11 # Copyright 2000-2002 Katipo Communications
12 # Copyright 2011 PTFS-Europe Ltd
13 #
14 # This file is part of Koha.
15 #
16 # Koha is free software; you can redistribute it and/or modify it
17 # under the terms of the GNU General Public License as published by
18 # the Free Software Foundation; either version 3 of the License, or
19 # (at your option) any later version.
20 #
21 # Koha is distributed in the hope that it will be useful, but
22 # WITHOUT ANY WARRANTY; without even the implied warranty of
23 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24 # GNU General Public License for more details.
25 #
26 # You should have received a copy of the GNU General Public License
27 # along with Koha; if not, see <http://www.gnu.org/licenses>.
28
29 use strict;
30 use warnings;
31 use 5.010;
32
33 use Koha::Script -cron;
34 use C4::Context;
35 use C4::Overdues;
36 use Getopt::Long;
37 use Carp;
38 use File::Spec;
39
40 use Koha::Calendar;
41 use Koha::DateUtils;
42 use C4::Log;
43
44 my $help;
45 my $verbose;
46 my $output_dir;
47 my $log;
48
49 GetOptions(
50 'h|help' => \$help,
51 'v|verbose' => \$verbose,
52 'l|log' => \$log,
53 'o|out:s' => \$output_dir,
54 );
55 my $usage = << 'ENDUSAGE';
56
57 This script calculates and charges overdue fines
58 to patron accounts. The Koha system preference 'finesMode' controls
59 whether the fines are calculated and charged to the patron accounts ("Calculate and charge");
60 or not calculated ("Don't calculate").
61
62 This script has the following parameters :
63 -h --help: this message
64 -l --log: log the output to a file (optional if the -o parameter is given)
65 -o --out: ouput directory for logs (defaults to env or /tmp if !exist)
66 -v --verbose
67
68 ENDUSAGE
69
70 if ($help) {
71 print $usage;
72 exit;
73 }
74
75 cronlogaction();
76
77 my @borrower_fields =
78 qw(cardnumber categorycode surname firstname email phone address citystate);
79 my @item_fields = qw(itemnumber barcode date_due);
80 my @other_fields = qw(days_overdue fine);
81 my $libname = C4::Context->preference('LibraryName');
82 my $control = C4::Context->preference('CircControl');
83 my $mode = C4::Context->preference('finesMode');
84 my $delim = "\t"; # ? C4::Context->preference('delimiter') || "\t";
85
86 my %is_holiday;
87 my $today = dt_from_string();
88 my $filename;
89 if ($log or $output_dir) {
90 $filename = get_filename($output_dir);
91 }
92
93 my $fh;
94 if ($filename) {
95 open $fh, '>>', $filename or croak "Cannot write file $filename: $!";
96 print {$fh} join $delim, ( @borrower_fields, @item_fields, @other_fields );
97 print {$fh} "\n";
98 }
99 my $counted = 0;
100 my $overdues = Getoverdues();
101 for my $overdue ( @{$overdues} ) {
102 next if $overdue->{itemlost};
103
104 if ( !defined $overdue->{borrowernumber} ) {
105 carp
106 "ERROR in Getoverdues : issues.borrowernumber IS NULL. Repair 'issues' table now! Skipping record.\n";
107 next;
108 }
109 my $borrower = BorType( $overdue->{borrowernumber} );
110 my $branchcode =
111 ( $control eq 'ItemHomeLibrary' ) ? $overdue->{homebranch}
112 : ( $control eq 'PatronLibrary' ) ? $borrower->{branchcode}
113 : $overdue->{branchcode};
114
115 # In final case, CircControl must be PickupLibrary. (branchcode comes from issues table here).
116 if ( !exists $is_holiday{$branchcode} ) {
117 $is_holiday{$branchcode} = set_holiday( $branchcode, $today );
118 }
119
120 my $datedue = dt_from_string( $overdue->{date_due} );
121 if ( DateTime->compare( $datedue, $today ) == 1 ) {
122 next; # not overdue
123 }
124 ++$counted;
125
126 my ( $amount, $unitcounttotal, $unitcount ) =
127 CalcFine( $overdue, $borrower->{categorycode},
128 $branchcode, $datedue, $today );
129
130 # Don't update the fine if today is a holiday.
131 # This ensures that dropbox mode will remove the correct amount of fine.
132 if ( $mode eq 'production' && !$is_holiday{$branchcode} ) {
133 if ( $amount && $amount > 0 ) {
134 UpdateFine(
135 {
136 issue_id => $overdue->{issue_id},
137 itemnumber => $overdue->{itemnumber},
138 borrowernumber => $overdue->{borrowernumber},
139 amount => $amount,
140 due => output_pref($datedue),
141 }
142 );
143 }
144 }
145 if ($filename) {
146 my @cells;
147 push @cells,
148 map { defined $borrower->{$_} ? $borrower->{$_} : q{} }
149 @borrower_fields;
150 push @cells, map { $overdue->{$_} } @item_fields;
151 push @cells, $unitcounttotal, $amount;
152 say {$fh} join $delim, @cells;
153 }
154 }
155 if ($filename){
156 close $fh;
157 }
158
159 if ($verbose) {
160 my $overdue_items = @{$overdues};
161 print <<"EOM";
162 Fines assessment -- $today
163 EOM
164 if ($filename) {
165 say "Saved to $filename";
166 }
167 print <<"EOM";
168 Number of Overdue Items:
169 counted $overdue_items
170 reported $counted
171
172 EOM
173 }
174
175 sub set_holiday {
176 my ( $branch, $dt ) = @_;
177
178 my $calendar = Koha::Calendar->new( branchcode => $branch );
179 return $calendar->is_holiday($dt);
180 }
181
182 sub get_filename {
183 my $directory = shift;
184 if ( !$directory ) {
185 $directory = C4::Context::temporary_directory;
186 }
187 if ( !-d $directory ) {
188 carp "Could not write to $directory ... does not exist!";
189 }
190 my $name = C4::Context->config('database');
191 $name =~ s/\W//;
192 $name .= join q{}, q{_}, $today->ymd(), '.log';
193 $name = File::Spec->catfile( $directory, $name );
194 if ($verbose && $log) {
195 say "writing to $name";
196 }
197 return $name;
198 }