|
Lines 26-55
Link Here
|
| 26 |
# You should have received a copy of the GNU General Public License |
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>. |
27 |
# along with Koha; if not, see <http://www.gnu.org/licenses>. |
| 28 |
|
28 |
|
| 29 |
use strict; |
29 |
use Modern::Perl; |
| 30 |
use warnings; |
|
|
| 31 |
use 5.010; |
| 32 |
|
30 |
|
| 33 |
use C4::Context; |
|
|
| 34 |
use C4::Overdues; |
| 35 |
use Getopt::Long; |
| 36 |
use Carp; |
31 |
use Carp; |
| 37 |
use File::Spec; |
32 |
use File::Spec; |
|
|
33 |
use Getopt::Long; |
| 34 |
use Parallel::ForkManager; |
| 35 |
|
| 36 |
use C4::Context; |
| 37 |
use C4::Overdues; |
| 38 |
use C4::Log; |
| 38 |
|
39 |
|
| 39 |
use Koha::Calendar; |
40 |
use Koha::Calendar; |
| 40 |
use Koha::DateUtils; |
41 |
use Koha::DateUtils; |
| 41 |
use C4::Log; |
|
|
| 42 |
|
42 |
|
| 43 |
my $help; |
43 |
my $help; |
| 44 |
my $verbose; |
44 |
my $verbose; |
| 45 |
my $output_dir; |
45 |
my $output_dir; |
| 46 |
my $log; |
46 |
my $log; |
|
|
47 |
my $max_processes = 0; |
| 47 |
|
48 |
|
| 48 |
GetOptions( |
49 |
GetOptions( |
| 49 |
'h|help' => \$help, |
50 |
'h|help' => \$help, |
| 50 |
'v|verbose' => \$verbose, |
51 |
'v|verbose' => \$verbose, |
| 51 |
'l|log' => \$log, |
52 |
'l|log' => \$log, |
| 52 |
'o|out:s' => \$output_dir, |
53 |
'o|out:s' => \$output_dir, |
|
|
54 |
'm|max-processes:s' => \$max_processes, |
| 53 |
); |
55 |
); |
| 54 |
my $usage = << 'ENDUSAGE'; |
56 |
my $usage = << 'ENDUSAGE'; |
| 55 |
|
57 |
|
|
Lines 63-68
This script has the following parameters :
Link Here
|
| 63 |
-l --log: log the output to a file (optional if the -o parameter is given) |
65 |
-l --log: log the output to a file (optional if the -o parameter is given) |
| 64 |
-o --out: ouput directory for logs (defaults to env or /tmp if !exist) |
66 |
-o --out: ouput directory for logs (defaults to env or /tmp if !exist) |
| 65 |
-v --verbose |
67 |
-v --verbose |
|
|
68 |
-m --max-processes: The maximum number of concurrent fine calculating processes |
| 66 |
|
69 |
|
| 67 |
ENDUSAGE |
70 |
ENDUSAGE |
| 68 |
|
71 |
|
|
Lines 97-102
if ($filename) {
Link Here
|
| 97 |
} |
100 |
} |
| 98 |
my $counted = 0; |
101 |
my $counted = 0; |
| 99 |
my $overdues = Getoverdues(); |
102 |
my $overdues = Getoverdues(); |
|
|
103 |
|
| 104 |
# Break out overdues per patron, this is needed in case we process overdues |
| 105 |
# in parallel. All overdues for a single patron still need to be handled by |
| 106 |
# a single process in case there are fine limits in place that need to account |
| 107 |
# for previous fines. If they were in parallel the math would be incorrect. |
| 108 |
my $overdues_by_patron; |
| 109 |
map { push( $overdues_by_patron->{ $_->{borrowernumber} }, $_ ) } @{$overdues}; |
| 110 |
|
| 111 |
my $pm = Parallel::ForkManager->new( $max_processes, '/tmp' ); |
| 112 |
$pm->run_on_finish( # called BEFORE the first call to start() |
| 113 |
sub { |
| 114 |
my ( $pid, $exit_code, $ident, $exit_signal, $core_dump, $data ) = @_; |
| 115 |
|
| 116 |
$counted++ if $exit_code; |
| 117 |
} |
| 118 |
); |
| 119 |
|
| 120 |
OVERDUES_LOOP: |
| 100 |
for my $overdue ( @{$overdues} ) { |
121 |
for my $overdue ( @{$overdues} ) { |
| 101 |
next if $overdue->{itemlost}; |
122 |
next if $overdue->{itemlost}; |
| 102 |
|
123 |
|
|
Lines 105-110
for my $overdue ( @{$overdues} ) {
Link Here
|
| 105 |
"ERROR in Getoverdues : issues.borrowernumber IS NULL. Repair 'issues' table now! Skipping record.\n"; |
126 |
"ERROR in Getoverdues : issues.borrowernumber IS NULL. Repair 'issues' table now! Skipping record.\n"; |
| 106 |
next; |
127 |
next; |
| 107 |
} |
128 |
} |
|
|
129 |
|
| 130 |
# Forking a child process now, no sense forking earlier as those children would do almost nothing |
| 131 |
my $pid = $pm->start and next OVERDUES_LOOP; |
| 132 |
|
| 108 |
my $borrower = BorType( $overdue->{borrowernumber} ); |
133 |
my $borrower = BorType( $overdue->{borrowernumber} ); |
| 109 |
my $branchcode = |
134 |
my $branchcode = |
| 110 |
( $control eq 'ItemHomeLibrary' ) ? $overdue->{homebranch} |
135 |
( $control eq 'ItemHomeLibrary' ) ? $overdue->{homebranch} |
|
Lines 118-126
for my $overdue ( @{$overdues} ) {
Link Here
|
| 118 |
|
143 |
|
| 119 |
my $datedue = dt_from_string( $overdue->{date_due} ); |
144 |
my $datedue = dt_from_string( $overdue->{date_due} ); |
| 120 |
if ( DateTime->compare( $datedue, $today ) == 1 ) { |
145 |
if ( DateTime->compare( $datedue, $today ) == 1 ) { |
| 121 |
next; # not overdue |
146 |
$pm->finish(0); # not overdue |
| 122 |
} |
147 |
} |
| 123 |
++$counted; |
|
|
| 124 |
|
148 |
|
| 125 |
my ( $amount, $type, $unitcounttotal ) = |
149 |
my ( $amount, $type, $unitcounttotal ) = |
| 126 |
CalcFine( $overdue, $borrower->{categorycode}, |
150 |
CalcFine( $overdue, $borrower->{categorycode}, |
|
Lines 152-158
for my $overdue ( @{$overdues} ) {
Link Here
|
| 152 |
push @cells, $type, $unitcounttotal, $amount; |
176 |
push @cells, $type, $unitcounttotal, $amount; |
| 153 |
say {$fh} join $delim, @cells; |
177 |
say {$fh} join $delim, @cells; |
| 154 |
} |
178 |
} |
|
|
179 |
$pm->finish(1); |
| 155 |
} |
180 |
} |
|
|
181 |
|
| 182 |
$pm->wait_all_children; |
| 183 |
|
| 156 |
if ($filename){ |
184 |
if ($filename){ |
| 157 |
close $fh; |
185 |
close $fh; |
| 158 |
} |
186 |
} |
| 159 |
- |
|
|