Jonathan Druart
9d6d641d1f
On bug 17591 we discovered that there was something weird going on with the way we export and use subroutines/modules. This patch tries to standardize our EXPORT to use EXPORT_OK only. That way we will need to explicitely define the subroutine we want to use from a module. This patch is a squashed version of: Bug 17600: After export.pl Bug 17600: After perlimport Bug 17600: Manual changes Bug 17600: Other manual changes after second perlimports run Bug 17600: Fix tests And a lot of other manual changes. export.pl is a dirty script that can be found on bug 17600. "perlimport" is: git clone https://github.com/oalders/App-perlimports.git cd App-perlimports/ cpanm --installdeps . export PERL5LIB="$PERL5LIB:/kohadevbox/koha/App-perlimports/lib" find . \( -name "*.pl" -o -name "*.pm" \) -exec perl App-perlimports/script/perlimports --inplace-edit --no-preserve-unused --filename {} \; The ideas of this patch are to: * use EXPORT_OK instead of EXPORT * perltidy the EXPORT_OK list * remove '&' before the subroutine names * remove some uneeded use statements * explicitely import the subroutines we need within the controllers or modules Note that the private subroutines (starting with _) should not be exported (and not used from outside of the module except from tests). EXPORT vs EXPORT_OK (from https://www.thegeekstuff.com/2010/06/perl-exporter-examples/) """ Export allows to export the functions and variables of modules to user’s namespace using the standard import method. This way, we don’t need to create the objects for the modules to access it’s members. @EXPORT and @EXPORT_OK are the two main variables used during export operation. @EXPORT contains list of symbols (subroutines and variables) of the module to be exported into the caller namespace. @EXPORT_OK does export of symbols on demand basis. """ If this patch caused a conflict with a patch you wrote prior to its push: * Make sure you are not reintroducing a "use" statement that has been removed * "$subroutine" is not exported by the C4::$MODULE module means that you need to add the subroutine to the @EXPORT_OK list * Bareword "$subroutine" not allowed while "strict subs" means that you didn't imported the subroutine from the module: - use $MODULE qw( $subroutine list ); You can also use the fully qualified namespace: C4::$MODULE::$subroutine Signed-off-by: Jonathan Druart <jonathan.druart@bugs.koha-community.org>
248 lines
9.5 KiB
Perl
Executable file
248 lines
9.5 KiB
Perl
Executable file
#!/usr/bin/perl
|
|
|
|
# This script loops through each overdue item, determines the fine,
|
|
# and updates the total amount of fines due by each user. It relies on
|
|
# the existence of /tmp/fines, which is created by ???
|
|
# Doesn't really rely on it, it relies on being able to write to /tmp/
|
|
# It creates the fines file
|
|
#
|
|
# This script is meant to be run nightly out of cron.
|
|
|
|
# Copyright 2011-2012 BibLibre
|
|
#
|
|
# This file is part of Koha.
|
|
#
|
|
# Koha is free software; you can redistribute it and/or modify it
|
|
# under the terms of the GNU General Public License as published by
|
|
# the Free Software Foundation; either version 3 of the License, or
|
|
# (at your option) any later version.
|
|
#
|
|
# Koha is distributed in the hope that it will be useful, but
|
|
# WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
# GNU General Public License for more details.
|
|
#
|
|
# You should have received a copy of the GNU General Public License
|
|
# along with Koha; if not, see <http://www.gnu.org/licenses>.
|
|
|
|
use Modern::Perl;
|
|
|
|
BEGIN {
|
|
|
|
# find Koha's Perl modules
|
|
# test carefully before changing this
|
|
use FindBin ();
|
|
eval { require "$FindBin::Bin/kohalib.pl" };
|
|
}
|
|
|
|
use Date::Calc qw( Date_to_Days );
|
|
|
|
use Koha::Script -cron;
|
|
use C4::Context;
|
|
use C4::Overdues qw( CalcFine checkoverdues GetFine Getoverdues );
|
|
use C4::Calendar qw(); # don't need any exports from Calendar
|
|
use C4::Log qw( cronlogaction );
|
|
use Getopt::Long qw( GetOptions );
|
|
use List::MoreUtils qw( none );
|
|
use Koha::DateUtils qw( dt_from_string output_pref );
|
|
use Koha::Patrons;
|
|
|
|
my $help = 0;
|
|
my $verbose = 0;
|
|
my @pcategories;
|
|
my @categories;
|
|
my %catamounts;
|
|
my @libraries;
|
|
my $delay;
|
|
my $useborrowerlibrary;
|
|
my $borrowernumberlimit;
|
|
my $borrowersalreadyapplied; # hashref of borrowers for whom we already applied the fine, so it's only applied once
|
|
my $debug = 0;
|
|
my $bigdebug = 0;
|
|
|
|
GetOptions(
|
|
'h|help' => \$help,
|
|
'v|verbose' => \$verbose,
|
|
'c|category:s'=> \@pcategories,
|
|
'l|library:s' => \@libraries,
|
|
'd|delay:i' => \$delay,
|
|
'u|use-borrower-library' => \$useborrowerlibrary,
|
|
'b|borrower:i' => \$borrowernumberlimit
|
|
);
|
|
my $usage = << 'ENDUSAGE';
|
|
|
|
This script calculates and charges overdue fines to patron accounts.
|
|
|
|
If the Koha System Preference 'finesMode' is set to 'production', the fines are charged to the patron accounts.
|
|
|
|
Please note that the fines won't be applied on a holiday.
|
|
|
|
This script has the following parameters :
|
|
-h --help: this message
|
|
-v --verbose
|
|
-c --category borrower_category,amount (repeatable)
|
|
-l --library (repeatable)
|
|
-d --delay
|
|
-u --use-borrower-library: use borrower's library, regardless of the CircControl syspref
|
|
-b --borrower borrowernumber: only for one given borrower
|
|
|
|
ENDUSAGE
|
|
die $usage if $help;
|
|
|
|
cronlogaction();
|
|
|
|
my $dbh = C4::Context->dbh;
|
|
|
|
# Processing categories
|
|
foreach (@pcategories) {
|
|
my ($category, $amount) = split(',', $_);
|
|
push @categories, $category;
|
|
$catamounts{$category} = $amount;
|
|
}
|
|
|
|
use vars qw(@borrower_fields @item_fields @other_fields);
|
|
use vars qw($fldir $libname $control $mode $delim $dbname $today $today_iso $today_days);
|
|
use vars qw($filename);
|
|
|
|
CHECK {
|
|
@borrower_fields = qw(cardnumber categorycode surname firstname email phone address citystate);
|
|
@item_fields = qw(itemnumber barcode date_due);
|
|
@other_fields = qw(type days_overdue fine);
|
|
$libname = C4::Context->preference('LibraryName');
|
|
$control = C4::Context->preference('CircControl');
|
|
$mode = C4::Context->preference('finesMode');
|
|
$dbname = C4::Context->config('database');
|
|
$delim = "\t"; # ? C4::Context->preference('delimiter') || "\t";
|
|
|
|
}
|
|
|
|
INIT {
|
|
$debug and print "Each line will contain the following fields:\n",
|
|
"From borrowers : ", join( ', ', @borrower_fields ), "\n",
|
|
"From items : ", join( ', ', @item_fields ), "\n",
|
|
"Per overdue: ", join( ', ', @other_fields ), "\n",
|
|
"Delimiter: '$delim'\n";
|
|
}
|
|
$debug and (defined $borrowernumberlimit) and print "--borrower limitation: borrower $borrowernumberlimit\n";
|
|
my ($numOverdueItems, $data);
|
|
if (defined $borrowernumberlimit) {
|
|
($numOverdueItems, $data) = checkoverdues($borrowernumberlimit);
|
|
} else {
|
|
$data = Getoverdues();
|
|
$numOverdueItems = scalar @$data;
|
|
}
|
|
my $overdueItemsCounted = 0;
|
|
my %calendars = ();
|
|
$today = dt_from_string;
|
|
$today_iso = output_pref( { dt => $today, dateonly => 1, dateformat => 'iso' } );
|
|
my ($tyear, $tmonth, $tday) = split( /-/, $today_iso );
|
|
$today_days = Date_to_Days( $tyear, $tmonth, $tday );
|
|
|
|
for ( my $i = 0 ; $i < scalar(@$data) ; $i++ ) {
|
|
next if $data->[$i]->{'itemlost'};
|
|
my ( $datedue, $datedue_days );
|
|
eval {
|
|
$datedue = dt_from_string( $data->[$i]->{'date_due'} );
|
|
my $datedue_iso = output_pref( { dt => $datedue, dateonly => 1, dateformat => 'iso' } );
|
|
$datedue_days = Date_to_Days( split( /-/, $datedue_iso ) );
|
|
};
|
|
if ($@) {
|
|
warn "Error on date for borrower " . $data->[$i]->{'borrowernumber'} . ": $@date_due: " . $data->[$i]->{'date_due'} . "\ndatedue_days: " . $datedue_days . "\nSkipping";
|
|
next;
|
|
}
|
|
my $due_str = output_pref( { dt => $datedue, dateonly => 1 } );
|
|
unless ( defined $data->[$i]->{'borrowernumber'} ) {
|
|
print STDERR "ERROR in Getoverdues line $i: issues.borrowernumber IS NULL. Repair 'issues' table now! Skipping record.\n";
|
|
next; # Note: this doesn't solve everything. After NULL borrowernumber, multiple issues w/ real borrowernumbers can pile up.
|
|
}
|
|
my $patron = Koha::Patrons->find( $data->[$i]->{'borrowernumber'} );
|
|
|
|
# Skipping borrowers that are not in @categories
|
|
$bigdebug and warn "Skipping borrower from category " . $patron->categorycode if none { $patron->categorycode eq $_ } @categories;
|
|
next if none { $patron->categorycode eq $_ } @categories;
|
|
|
|
my $branchcode =
|
|
( $useborrowerlibrary ) ? $patron->branchcode
|
|
: ( $control eq 'ItemHomeLibrary' ) ? $data->[$i]->{homebranch}
|
|
: ( $control eq 'PatronLibrary' ) ? $patron->branchcode
|
|
: $data->[$i]->{branchcode};
|
|
# In final case, CircControl must be PickupLibrary. (branchcode comes from issues table here).
|
|
|
|
# Skipping branchcodes that are not in @libraries
|
|
$bigdebug and warn "Skipping library $branchcode" if none { $branchcode eq $_ } @libraries;
|
|
next if none { $branchcode eq $_ } @libraries;
|
|
|
|
my $calendar;
|
|
unless ( defined( $calendars{$branchcode} ) ) {
|
|
$calendars{$branchcode} = C4::Calendar->new( branchcode => $branchcode );
|
|
}
|
|
$calendar = $calendars{$branchcode};
|
|
my $isHoliday = $calendar->isHoliday( $tday, $tmonth, $tyear );
|
|
|
|
# Reassing datedue_days if -delay specified in commandline
|
|
$bigdebug and warn "Using commandline supplied delay : $delay" if ($delay);
|
|
$datedue_days += $delay if ($delay);
|
|
|
|
( $datedue_days <= $today_days ) or next; # or it's not overdue, right?
|
|
|
|
$overdueItemsCounted++;
|
|
my ( $amount, $unitcounttotal, $unitcount ) = CalcFine(
|
|
$data->[$i],
|
|
$patron->categorycode,
|
|
$branchcode,
|
|
$datedue,
|
|
$today,
|
|
);
|
|
|
|
# Reassign fine's amount if specified in command-line
|
|
$amount = $catamounts{$patron->categorycode} if (defined $catamounts{$patron->categorycode});
|
|
|
|
# We check if there is already a fine for the given borrower
|
|
my $fine = GetFine(undef, $data->[$i]->{'borrowernumber'});
|
|
if ($fine > 0) {
|
|
$debug and warn "There is already a fine for borrower " . $data->[$i]->{'borrowernumber'} . ". Nothing to do here. Skipping this borrower";
|
|
next;
|
|
}
|
|
|
|
# Don't update the fine if today is a holiday.
|
|
# This ensures that dropbox mode will remove the correct amount of fine.
|
|
if ( $mode eq 'production' and !$borrowersalreadyapplied->{$data->[$i]->{'borrowernumber'}}) {
|
|
# If we're on a holiday, warn the user (if debug) that no fine will be applied
|
|
if($isHoliday) {
|
|
$debug and warn "Today is a holiday. The fine for borrower " . $data->[$i]->{'borrowernumber'} . " will not be applied";
|
|
} else {
|
|
$debug and warn "Creating fine for borrower " . $data->[$i]->{'borrowernumber'} . " with amount : $amount";
|
|
|
|
# We mark this borrower as already processed
|
|
$borrowersalreadyapplied->{$data->[$i]->{'borrowernumber'}} = 1;
|
|
|
|
my $borrowernumber = $data->[$i]->{'borrowernumber'};
|
|
my $itemnumber = $data->[$i]->{'itemnumber'};
|
|
|
|
# And we create the fine
|
|
my $sth4 = $dbh->prepare( "SELECT title FROM biblio LEFT JOIN items ON biblio.biblionumber=items.biblionumber WHERE items.itemnumber=?" );
|
|
$sth4->execute($itemnumber);
|
|
my $title = $sth4->fetchrow;
|
|
|
|
my $desc = "staticfine";
|
|
my $query = "INSERT INTO accountlines
|
|
(borrowernumber,itemnumber,date,amount,description,debit_type_code,status,amountoutstanding)
|
|
VALUES (?,?,now(),?,?,'OVERDUE','RETURNED',?)";
|
|
my $sth2 = $dbh->prepare($query);
|
|
$bigdebug and warn "query: $query\nw/ args: $borrowernumber, $itemnumber, $amount, $desc, $amount\n";
|
|
$sth2->execute( $borrowernumber, $itemnumber, $amount, $desc, $amount );
|
|
|
|
}
|
|
}
|
|
}
|
|
|
|
if ($verbose) {
|
|
print <<EOM;
|
|
Fines assessment -- $today_iso
|
|
Number of Overdue Items:
|
|
counted $overdueItemsCounted
|
|
reported $numOverdueItems
|
|
|
|
EOM
|
|
}
|
|
|