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>
541 lines
17 KiB
Perl
Executable file
541 lines
17 KiB
Perl
Executable file
#!/usr/bin/perl
|
|
|
|
# Copyright 2016 PTFS Europe
|
|
#
|
|
# 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>.
|
|
|
|
=head1 NAME
|
|
|
|
stockrotation.pl
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
--[a]dmin-email An address to which email reports should also be sent
|
|
--[b]ranchcode Select branch to report on for 'email' reports (default: all)
|
|
--e[x]ecute Actually perform stockrotation housekeeping
|
|
--[r]eport Select either 'full' or 'email'
|
|
--[S]end-all Send email reports even if the report body is empty
|
|
--[s]end-email Send reports by email
|
|
--[h]elp Display this help message
|
|
|
|
Cron script implementing scheduled stockrotation functionality.
|
|
|
|
By default this script merely reports on the current status of the
|
|
stockrotation subsystem. In order to actually place items in transit, the
|
|
script must be run with the `execute` argument.
|
|
|
|
`report` allows you to select the type of report that will be emitted. It's
|
|
set to 'full' by default. If the `email` report is selected, you can use the
|
|
`branchcode` parameter to specify which branch's report you would like to see.
|
|
The default is 'all'.
|
|
|
|
`admin-email` is an additional email address to which we will send all email
|
|
reports in addition to sending them to branch email addresses.
|
|
|
|
`send-email` will cause the script to send reports by email, and `send-all`
|
|
will cause even reports with an empty body to be sent.
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
This script is used to move items from one stockrotationstage to the next,
|
|
if they are elible for processing.
|
|
|
|
it should be run from cron like:
|
|
|
|
stockrotation.pl --report email --send-email --execute
|
|
|
|
Prior to that you can run the script from the command line without the
|
|
--execute and --send-email parameters to see what reports the script would
|
|
generate in 'production' mode. This is immensely useful for testing, or for
|
|
getting to understand how the stockrotation module works: you can set up
|
|
different scenarios, and then "query" the system on what it would do.
|
|
|
|
Normally you would want to run this script once per day, probably around
|
|
midnight-ish to move any stockrotationitems along their rotas and to generate
|
|
the email reports for branch libraries.
|
|
|
|
Each library will receive a report with "items of interest" for them for
|
|
today's rota checks. Each item there will be an item that should, according
|
|
to Koha, be located on the shelves of that branch, and which should be picked
|
|
up and checked in. The item will either:
|
|
- have been placed in transit to their new stage library;
|
|
- have been placed in transit to be returned to their current stage library;
|
|
- have just been added to a rota and will already be at the correct library;
|
|
|
|
In the last case the item will be checked in and no message will pop up. In
|
|
the other cases a message will pop up requesting the item be posted to their
|
|
new branch.
|
|
|
|
=head2 What does the --execute flag do?
|
|
|
|
To understand this, you will need to know a little bit about the design of
|
|
this script and the stockrotation modules.
|
|
|
|
This script operates in 3 phases: first it walks the graph of rotas, stages
|
|
and items. For each active rota, it investigates the items in each stage and
|
|
determines whether action is required. It does not perform any actions, it
|
|
just "sieves" all items on active rotas into "actionable" and "non-actionable"
|
|
baskets. We can use these baskets to perform actions against the items, or to
|
|
generate reports.
|
|
|
|
During the second phase this script then loops through the actionable baskets,
|
|
and performs the relevant action (initiate, repatriate, advance) on each item.
|
|
|
|
Finally, during the third phase we revisit the original baskets and we compile
|
|
reports (for instance per branch email reports).
|
|
|
|
When the script is run without the "--execute" flag, we perform phase 1, skip
|
|
phase 2 and move straight onto phase 3.
|
|
|
|
With the "--execute" flag we also perform the database operations.
|
|
|
|
So with or without the flag, the report will look the same (except for the "No
|
|
database updates have been performed.").
|
|
|
|
=cut
|
|
|
|
use Modern::Perl;
|
|
use Getopt::Long qw( GetOptions HelpMessage );
|
|
|
|
use Koha::Script -cron;
|
|
use C4::Context;
|
|
use C4::Letters;
|
|
use Koha::StockRotationRotas;
|
|
|
|
my $admin_email = '';
|
|
my $branch = 0;
|
|
my $execute = 0;
|
|
my $report = 'full';
|
|
my $send_all = 0;
|
|
my $send_email = 0;
|
|
|
|
my $ok = GetOptions(
|
|
'admin-email|a=s' => \$admin_email,
|
|
'branchcode|b=s' => sub {
|
|
my ( $opt_name, $opt_value ) = @_;
|
|
if ( $opt_value eq 'all' ) {
|
|
$branch = 0;
|
|
}
|
|
else {
|
|
my $branches = Koha::Libraries->search( {},
|
|
{ order_by => { -asc => 'branchname' } } );
|
|
my $brnch = $branches->find($opt_value);
|
|
if ($brnch) {
|
|
$branch = $brnch;
|
|
return $brnch;
|
|
}
|
|
else {
|
|
printf("Option $opt_name should be one of (name -> code):\n");
|
|
while ( my $candidate = $branches->next ) {
|
|
printf( " %-40s -> %s\n",
|
|
$candidate->branchname, $candidate->branchcode );
|
|
}
|
|
exit 1;
|
|
}
|
|
}
|
|
},
|
|
'execute|x' => \$execute,
|
|
'report|r=s' => sub {
|
|
my ( $opt_name, $opt_value ) = @_;
|
|
if ( $opt_value eq 'full' || $opt_value eq 'email' ) {
|
|
$report = $opt_value;
|
|
}
|
|
else {
|
|
printf("Option $opt_name should be either 'email' or 'full'.\n");
|
|
exit 1;
|
|
}
|
|
},
|
|
'send-all|S' => \$send_all,
|
|
'send-email|s' => \$send_email,
|
|
'help|h|?' => sub { HelpMessage }
|
|
);
|
|
exit 1 unless ($ok);
|
|
|
|
$send_email++ if ($send_all); # if we send all, then we must want emails.
|
|
|
|
if ( $send_email && !$admin_email && ($report eq 'full')) {
|
|
printf("Sending the full report by email requires --admin-email.\n");
|
|
exit 1;
|
|
}
|
|
|
|
=head2 Helpers
|
|
|
|
=head3 execute
|
|
|
|
undef = execute($report);
|
|
|
|
Perform the database updates, within a transaction, that are reported as
|
|
needing to be performed by $REPORT.
|
|
|
|
$REPORT should be the return value of an invocation of `investigate`.
|
|
|
|
This procedure WILL mess with your database.
|
|
|
|
=cut
|
|
|
|
sub execute {
|
|
my ($data) = @_;
|
|
|
|
# Begin transaction
|
|
my $schema = Koha::Database->new->schema;
|
|
$schema->storage->txn_begin;
|
|
|
|
# Carry out db updates
|
|
foreach my $item ( @{ $data->{items} } ) {
|
|
my $reason = $item->{reason};
|
|
if ( $reason eq 'repatriation' ) {
|
|
$item->{object}->repatriate;
|
|
}
|
|
elsif ( grep { $reason eq $_ } qw/in-demand advancement initiation/ ) {
|
|
$item->{object}->advance;
|
|
}
|
|
}
|
|
|
|
# End transaction
|
|
$schema->storage->txn_commit;
|
|
}
|
|
|
|
=head3 report_full
|
|
|
|
my $full_report = report_full($report);
|
|
|
|
Return an arrayref containing a string containing a detailed report about the
|
|
current state of the stockrotation subsystem.
|
|
|
|
$REPORT should be the return value of `investigate`.
|
|
|
|
No data in the database is manipulated by this procedure.
|
|
|
|
=cut
|
|
|
|
sub report_full {
|
|
my ($data) = @_;
|
|
|
|
my $header = "";
|
|
my $body = "";
|
|
|
|
# Summary
|
|
$header .= "STOCKROTATION REPORT\n";
|
|
$header .= "--------------------\n";
|
|
$body .= sprintf "
|
|
Total number of rotas: %5u
|
|
Inactive rotas: %5u
|
|
Active rotas: %5u
|
|
Total number of items: %5u
|
|
Inactive items: %5u
|
|
Stationary items: %5u
|
|
Actionable items: %5u
|
|
Total items to be initiated: %5u
|
|
Total items to be repatriated: %5u
|
|
Total items to be advanced: %5u
|
|
Total items in demand: %5u\n\n",
|
|
$data->{sum_rotas}, $data->{rotas_inactive}, $data->{rotas_active},
|
|
$data->{sum_items}, $data->{items_inactive}, $data->{stationary},
|
|
$data->{actionable}, $data->{initiable}, $data->{repatriable},
|
|
$data->{advanceable}, $data->{indemand};
|
|
|
|
if ( @{ $data->{rotas} } ) { # Per Rota details
|
|
$body .= "ROTAS DETAIL\n";
|
|
$body .= "------------\n\n";
|
|
foreach my $rota ( @{ $data->{rotas} } ) {
|
|
$body .= sprintf "Details for %s [%s]:\n",
|
|
$rota->{name}, $rota->{id};
|
|
$body .= "\n Items:"; # Rota item details
|
|
if ( @{ $rota->{items} } ) {
|
|
$body .=
|
|
join( "", map { _print_item($_) } @{ $rota->{items} } );
|
|
}
|
|
else {
|
|
$body .= "\n No items to be processed for this rota.\n";
|
|
}
|
|
$body .= "\n Log:"; # Rota log details
|
|
if ( @{ $rota->{log} } ) {
|
|
$body .= join( "", map { _print_item($_) } @{ $rota->{log} } );
|
|
}
|
|
else {
|
|
$body .= "\n No items in log for this rota.\n\n";
|
|
}
|
|
}
|
|
}
|
|
return [
|
|
$header,
|
|
{
|
|
letter => {
|
|
title => 'Stockrotation Report',
|
|
content => $body # The body of the report
|
|
},
|
|
status => 1, # We have a meaningful report
|
|
no_branch_email => 1, # We don't expect branch email in report
|
|
}
|
|
];
|
|
}
|
|
|
|
=head3 report_by_branch
|
|
|
|
my $email_report = report_by_branch($report, [$branch]);
|
|
|
|
Returns an arrayref containing a header string, with basic report information,
|
|
and any number of 'per_branch' strings, containing a detailed report about the
|
|
current state of the stockrotation subsystem, from the perspective of those
|
|
individual branches.
|
|
|
|
=over 2
|
|
|
|
=item $report should be the return value of `investigate`
|
|
|
|
=item $branch is optional and should be either 0 (to indicate 'all'), or a specific Koha::Library object.
|
|
|
|
=back
|
|
|
|
No data in the database is manipulated by this procedure.
|
|
|
|
=cut
|
|
|
|
sub report_by_branch {
|
|
my ( $data, $branch ) = @_;
|
|
|
|
my $out = [];
|
|
my $header = "";
|
|
|
|
# Summary
|
|
my $branched = $data->{branched};
|
|
my $flag = 0;
|
|
|
|
$header .= "BRANCH-BASED STOCKROTATION REPORT\n";
|
|
$header .= "---------------------------------\n";
|
|
push @{$out}, $header;
|
|
|
|
if ($branch) { # Branch limited report
|
|
push @{$out}, _report_per_branch( $branched->{ $branch->branchcode } );
|
|
}
|
|
elsif ( $data->{actionable} ) { # Full email report
|
|
while ( my ( $branchcode_id, $details ) = each %{$branched} ) {
|
|
push @{$out}, _report_per_branch($details)
|
|
if ( @{ $details->{items} } );
|
|
}
|
|
}
|
|
else {
|
|
push @{$out}, {
|
|
body => "No actionable items at any libraries.\n\n", # The body of the report
|
|
no_branch_email => 1, # We don't expect branch email in report
|
|
};
|
|
}
|
|
return $out;
|
|
}
|
|
|
|
=head3 _report_per_branch
|
|
|
|
my $branch_string = _report_per_branch($branch_details);
|
|
|
|
return a string containing details about the stockrotation items and their
|
|
status for the branch identified by $BRANCHCODE.
|
|
|
|
This helper procedure is only used from within `report_by_branch`.
|
|
|
|
No data in the database is manipulated by this procedure.
|
|
|
|
=cut
|
|
|
|
sub _report_per_branch {
|
|
my ($branch) = @_;
|
|
|
|
my $status = 0;
|
|
if ( $branch && @{ $branch->{items} } ) {
|
|
$status = 1;
|
|
}
|
|
|
|
if (
|
|
my $letter = C4::Letters::GetPreparedLetter(
|
|
module => 'circulation',
|
|
letter_code => "SR_SLIP",
|
|
branchcode => $branch->{code},
|
|
message_transport_type => 'email',
|
|
substitute => { branch => $branch }
|
|
)
|
|
)
|
|
{
|
|
return {
|
|
letter => $letter,
|
|
email_address => $branch->{email},
|
|
status => $status
|
|
};
|
|
}
|
|
return;
|
|
}
|
|
|
|
=head3 _print_item
|
|
|
|
my $string = _print_item($item_section);
|
|
|
|
Return a string containing an overview about $ITEM_SECTION.
|
|
|
|
This helper procedure is only used from within `report_full`.
|
|
|
|
No data in the database is manipulated by this procedure.
|
|
|
|
=cut
|
|
|
|
sub _print_item {
|
|
my ($item) = @_;
|
|
return sprintf "
|
|
Title: %s
|
|
Author: %s
|
|
Call number: %s
|
|
Location: %s
|
|
Barcode: %s
|
|
On loan?: %s
|
|
Status: %s
|
|
Current Library: %s [%s]\n\n",
|
|
$item->{title} || "N/A", $item->{author} || "N/A",
|
|
$item->{callnumber} || "N/A", $item->{location} || "N/A",
|
|
$item->{barcode} || "N/A", $item->{onloan} ? 'Yes' : 'No',
|
|
$item->{reason} || "N/A", $item->{branch}->branchname,
|
|
$item->{branch}->branchcode;
|
|
}
|
|
|
|
=head3 emit
|
|
|
|
undef = emit($params);
|
|
|
|
$PARAMS should be a hashref of the following format:
|
|
admin_email: the address to which a copy of all reports should be sent.
|
|
execute: the flag indicating whether we performed db updates
|
|
send_all: the flag indicating whether we should send even empty reports
|
|
send_email: the flag indicating whether we want to emit to stdout or email
|
|
report: the data structure returned from one of the report procedures
|
|
|
|
No data in the database is manipulated by this procedure.
|
|
|
|
The return value is unspecified: we simply emit a message as a side-effect or
|
|
die.
|
|
|
|
=cut
|
|
|
|
sub emit {
|
|
my ($params) = @_;
|
|
|
|
# REPORT is an arrayref of at least 2 elements:
|
|
# - The header for the report, which will be repeated for each part
|
|
# - a "part" for each report we want to emit
|
|
# PARTS are hashrefs:
|
|
# - part->{status}: a boolean indicating whether the reported part is empty or not
|
|
# - part->{email_address}: the email address to send the report to
|
|
# - part->{no_branch_email}: a boolean indicating that we are missing a branch email
|
|
# - part->{letter}: a GetPreparedLetter hash as returned by the C4::Letters module
|
|
my $report = $params->{report};
|
|
my $header = shift @{$report};
|
|
my $parts = $report;
|
|
|
|
my @emails;
|
|
foreach my $part ( @{$parts} ) {
|
|
|
|
if ( $part->{status} || $params->{send_all} ) {
|
|
|
|
# We have a report to send, or we want to send even empty
|
|
# reports.
|
|
|
|
# Select email address to send to
|
|
my $addressee;
|
|
if ( $part->{email_address} ) {
|
|
$addressee = $part->{email_address};
|
|
}
|
|
elsif ( !$part->{no_branch_email} ) {
|
|
$addressee = C4::Context->preference('KohaAdminEmailAddress')
|
|
if ( C4::Context->preference('KohaAdminEmailAddress') );
|
|
}
|
|
|
|
if ( $params->{send_email} ) { # Only email if emails requested
|
|
if ( defined($addressee) ) {
|
|
C4::Letters::EnqueueLetter(
|
|
{
|
|
letter => $part->{letter},
|
|
to_address => $addressee,
|
|
message_transport_type => 'email',
|
|
}
|
|
)
|
|
or warn
|
|
"can't enqueue letter $part->{letter} for $addressee";
|
|
}
|
|
|
|
# Copy to admin?
|
|
if ( $params->{admin_email} ) {
|
|
C4::Letters::EnqueueLetter(
|
|
{
|
|
letter => $part->{letter},
|
|
to_address => $params->{admin_email},
|
|
message_transport_type => 'email',
|
|
}
|
|
)
|
|
or warn
|
|
"can't enqueue letter $part->{letter} for $params->{admin_email}";
|
|
}
|
|
}
|
|
else {
|
|
my $email =
|
|
"-------- Email message --------" . "\n\n";
|
|
$email .= "To: $addressee\n";
|
|
$email .= "Cc: " . $params->{admin_email} . "\n"
|
|
if ( $params->{admin_email} );
|
|
$email .= "Subject: "
|
|
. $part->{letter}->{title} . "\n\n"
|
|
. $part->{letter}->{content};
|
|
push @emails, $email;
|
|
}
|
|
}
|
|
}
|
|
|
|
# Emit to stdout instead of email?
|
|
if ( !$params->{send_email} ) {
|
|
|
|
# The final message is the header + body of this part.
|
|
my $msg = $header;
|
|
$msg .= "No database updates have been performed.\n\n"
|
|
unless ( $params->{execute} );
|
|
|
|
# Append email reports to message
|
|
$msg .= join( "\n\n", @emails );
|
|
printf $msg;
|
|
}
|
|
}
|
|
|
|
#### Main Code
|
|
|
|
# Compile Stockrotation Report data
|
|
my $rotas = Koha::StockRotationRotas->search(undef,{ order_by => { '-asc' => 'title' }});
|
|
my $data = $rotas->investigate;
|
|
|
|
# Perform db updates if requested
|
|
execute($data) if ($execute);
|
|
|
|
# Emit Reports
|
|
my $out_report = {};
|
|
$out_report = report_by_branch( $data, $branch ) if $report eq 'email';
|
|
$out_report = report_full( $data, $branch ) if $report eq 'full';
|
|
emit(
|
|
{
|
|
admin_email => $admin_email,
|
|
execute => $execute,
|
|
report => $out_report,
|
|
send_all => $send_all,
|
|
send_email => $send_email,
|
|
}
|
|
);
|
|
|
|
=head1 AUTHOR
|
|
|
|
Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>
|
|
|
|
=cut
|