Jonathan Druart
48bf9b1d91
The idea rely on the KohaDates TT plugin for the date formatting. We should not have any output_pref calls in pl or pm (there are some exceptions, for ILSDI for instance). Also flatpickr will deal with the places where dates are inputed. We will pass the raw SQL value (what we call 'iso' in Koha::DateUtils), and the controller will receive the same value, no need to additional conversion. Note that DBIC has the capability to auto-deflate DateTime objects, which makes things way easier. We can either pass the value we receive from the controller, or pass a DT object to our methods. Signed-off-by: Victor Grousset/tuxayo <victor@tuxayo.net> Signed-off-by: Marcel de Rooy <m.de.rooy@rijksmuseum.nl> Signed-off-by: Tomas Cohen Arazi <tomascohen@theke.io>
359 lines
11 KiB
Perl
Executable file
359 lines
11 KiB
Perl
Executable file
#!/usr/bin/perl
|
|
|
|
# Copyright 2010 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;
|
|
|
|
use CGI qw ( -utf8 );
|
|
|
|
use C4::Auth qw( get_template_and_user );
|
|
use C4::Context;
|
|
use C4::Koha qw( GetAuthorisedValues );
|
|
use C4::Output qw( output_html_with_http_headers );
|
|
use C4::Reports qw( GetDelimiterChoices );
|
|
use C4::Members;
|
|
use Koha::AuthorisedValues;
|
|
use Koha::ItemTypes;
|
|
use Koha::Libraries;
|
|
use Koha::Patron::Categories;
|
|
use List::MoreUtils qw( any );
|
|
|
|
=head1 NAME
|
|
|
|
reports/reserve_stats.pl
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
Plugin that shows reserve stats
|
|
|
|
=cut
|
|
|
|
my $input = CGI->new;
|
|
my $fullreportname = "reports/reserves_stats.tt";
|
|
my $do_it = $input->param('do_it');
|
|
my $line = $input->param("Line");
|
|
my $column = $input->param("Column");
|
|
my $calc = $input->param("Cellvalue");
|
|
my $output = $input->param("output");
|
|
my $basename = $input->param("basename");
|
|
my $hash_params = $input->Vars;
|
|
my $filter_hashref;
|
|
foreach my $filter (grep {$_ =~/^filter/} keys %$hash_params){
|
|
my $filterstring=$filter;
|
|
$filterstring=~s/^filter_//g;
|
|
$$filter_hashref{$filterstring}=$$hash_params{$filter} if (defined $$hash_params{$filter} && $$hash_params{$filter} ne "");
|
|
}
|
|
my ($template, $borrowernumber, $cookie) = get_template_and_user({
|
|
template_name => $fullreportname,
|
|
query => $input,
|
|
type => "intranet",
|
|
flagsrequired => {reports => '*'},
|
|
});
|
|
our $sep = $input->param("sep") || '';
|
|
$sep = "\t" if ($sep eq 'tabulation');
|
|
$template->param(do_it => $do_it,
|
|
);
|
|
|
|
my @patron_categories = Koha::Patron::Categories->search_with_library_limits({}, {order_by => ['description']})->as_list;
|
|
|
|
my $locations = { map { ( $_->{authorised_value} => $_->{lib} ) } Koha::AuthorisedValues->get_descriptions_by_koha_field( { frameworkcode => '', kohafield => 'items.location' }, { order_by => ['description'] } ) };
|
|
my $ccodes = { map { ( $_->{authorised_value} => $_->{lib} ) } Koha::AuthorisedValues->get_descriptions_by_koha_field( { frameworkcode => '', kohafield => 'items.ccode' }, { order_by => ['description'] } ) };
|
|
|
|
my $Bsort1 = GetAuthorisedValues("Bsort1");
|
|
my $Bsort2 = GetAuthorisedValues("Bsort2");
|
|
my ($hassort1,$hassort2);
|
|
$hassort1=1 if $Bsort1;
|
|
$hassort2=1 if $Bsort2;
|
|
|
|
|
|
if ($do_it) {
|
|
# Displaying results
|
|
my $results = calculate($line, $column, $calc, $filter_hashref);
|
|
if ($output eq "screen"){
|
|
# Printing results to screen
|
|
$template->param(mainloop => $results);
|
|
output_html_with_http_headers $input, $cookie, $template->output;
|
|
} else {
|
|
# Printing to a csv file
|
|
print $input->header(-type => 'application/vnd.sun.xml.calc',
|
|
-encoding => 'utf-8',
|
|
-attachment=>"$basename.csv",
|
|
-filename=>"$basename.csv" );
|
|
my $cols = @$results[0]->{loopcol};
|
|
my $lines = @$results[0]->{looprow};
|
|
# header top-right
|
|
print @$results[0]->{line} ."/". @$results[0]->{column} .$sep;
|
|
# Other header
|
|
foreach my $col ( @$cols ) {
|
|
print $col->{coltitle}.$sep;
|
|
}
|
|
print "Total\n";
|
|
# Table
|
|
foreach my $line ( @$lines ) {
|
|
my $x = $line->{loopcell};
|
|
print $line->{rowtitle}.$sep;
|
|
print map {$_->{value}.$sep} @$x;
|
|
print $line->{totalrow}, "\n";
|
|
}
|
|
# footer
|
|
print "TOTAL";
|
|
$cols = @$results[0]->{loopfooter};
|
|
print map {$sep.$_->{totalcol}} @$cols;
|
|
print $sep.@$results[0]->{total};
|
|
}
|
|
exit; # exit either way after $do_it
|
|
}
|
|
|
|
my $dbh = C4::Context->dbh;
|
|
|
|
my $itemtypes = Koha::ItemTypes->search_with_localization;
|
|
|
|
# location list
|
|
my @locations;
|
|
foreach (sort keys %$locations) {
|
|
push @locations, { code => $_, description => "$_ - " . $locations->{$_} };
|
|
}
|
|
|
|
my @ccodes;
|
|
foreach (sort {$ccodes->{$a} cmp $ccodes->{$b}} keys %$ccodes) {
|
|
push @ccodes, { code => $_, description => $ccodes->{$_} };
|
|
}
|
|
|
|
# various
|
|
my $CGIextChoice = ( 'CSV' ); # FIXME translation
|
|
my $CGIsepChoice=GetDelimiterChoices;
|
|
|
|
$template->param(
|
|
categoryloop => \@patron_categories,
|
|
itemtypes => $itemtypes,
|
|
locationloop => \@locations,
|
|
ccodeloop => \@ccodes,
|
|
hassort1=> $hassort1,
|
|
hassort2=> $hassort2,
|
|
Bsort1 => $Bsort1,
|
|
Bsort2 => $Bsort2,
|
|
CGIextChoice => $CGIextChoice,
|
|
CGIsepChoice => $CGIsepChoice,
|
|
);
|
|
output_html_with_http_headers $input, $cookie, $template->output;
|
|
|
|
sub calculate {
|
|
my ($linefield, $colfield, $process, $filters_hashref) = @_;
|
|
my @loopfooter;
|
|
my @loopcol;
|
|
my @loopline;
|
|
my @looprow;
|
|
my %globalline;
|
|
my $grantotal =0;
|
|
# extract parameters
|
|
my $dbh = C4::Context->dbh;
|
|
|
|
# Filters
|
|
# Checking filters
|
|
#
|
|
my @loopfilter;
|
|
foreach my $filter ( keys %$filters_hashref ) {
|
|
$filters_hashref->{$filter} =~ s/\*/%/;
|
|
}
|
|
|
|
#display
|
|
@loopfilter = map {
|
|
{
|
|
crit => $_,
|
|
filter => $filters_hashref->{$_},
|
|
}
|
|
} sort keys %$filters_hashref;
|
|
|
|
|
|
|
|
|
|
my $linesql=changeifreservestatus($linefield);
|
|
my $colsql=changeifreservestatus($colfield);
|
|
#Initialization of cell values.....
|
|
|
|
# preparing calculation
|
|
my $strcalc = "(SELECT $linesql line, $colsql col, ";
|
|
$strcalc .= ($process == 1) ? " COUNT(*) calculation" :
|
|
($process == 2) ? "(COUNT(DISTINCT reserves.borrowernumber)) calculation" :
|
|
($process == 3) ? "(COUNT(DISTINCT reserves.itemnumber)) calculation" :
|
|
($process == 4) ? "(COUNT(DISTINCT reserves.biblionumber)) calculation" : '*';
|
|
$strcalc .= "
|
|
FROM (select * from reserves union select * from old_reserves) reserves
|
|
LEFT JOIN borrowers USING (borrowernumber)
|
|
";
|
|
$strcalc .= "LEFT JOIN biblio ON reserves.biblionumber=biblio.biblionumber "
|
|
if ($linefield =~ /^biblio\./ or $colfield =~ /^biblio\./ or any {$_=~/biblio/}keys %$filters_hashref);
|
|
$strcalc .= "LEFT JOIN items ON reserves.itemnumber=items.itemnumber "
|
|
if ($linefield =~ /^items\./ or $colfield =~ /^items\./ or any {$_=~/items/}keys %$filters_hashref);
|
|
|
|
my @sqlparams;
|
|
my @sqlorparams;
|
|
my @sqlor;
|
|
my @sqlwhere;
|
|
foreach my $filter (keys %$filters_hashref){
|
|
my $string;
|
|
my $stringfield=$filter;
|
|
$stringfield=~s/\_[a-z_]+$//;
|
|
if ($filter=~/ /){
|
|
$string=$stringfield;
|
|
}
|
|
elsif ($filter=~/_or/){
|
|
push @sqlor, qq{( }.changeifreservestatus($filter)." = ? ) ";
|
|
push @sqlorparams, $$filters_hashref{$filter};
|
|
}
|
|
elsif ($filter=~/_endex$/){
|
|
$string = " $stringfield < ? ";
|
|
}
|
|
elsif ($filter=~/_end$/){
|
|
$string = " $stringfield <= ? ";
|
|
}
|
|
elsif ($filter=~/_begin$/){
|
|
$string = " $stringfield >= ? ";
|
|
}
|
|
else {
|
|
$string = " $stringfield LIKE ? ";
|
|
}
|
|
if ($string){
|
|
push @sqlwhere, $string;
|
|
push @sqlparams, $$filters_hashref{$filter};
|
|
}
|
|
}
|
|
|
|
$strcalc .= " WHERE ".join(" AND ",@sqlwhere) if (@sqlwhere);
|
|
$strcalc .= " AND (".join(" OR ",@sqlor).")" if (@sqlor);
|
|
$strcalc .= " GROUP BY line, col )";
|
|
my $dbcalc = $dbh->prepare($strcalc);
|
|
push @loopfilter, {crit=>'SQL =', sql=>1, filter=>$strcalc};
|
|
@sqlparams=(@sqlparams,@sqlorparams);
|
|
$dbcalc->execute(@sqlparams);
|
|
my $data = $dbcalc->fetchall_hashref([qw(line col)]);
|
|
my %cols_hash;
|
|
foreach my $row (keys %$data){
|
|
push @loopline, $row;
|
|
foreach my $col (keys %{$$data{$row}}){
|
|
$$data{$row}{totalrow}+=$$data{$row}{$col}{calculation};
|
|
$grantotal+=$$data{$row}{$col}{calculation};
|
|
$cols_hash{$col}=1 ;
|
|
}
|
|
}
|
|
my $urlbase="do_it=1&".join("&",map{"filter_$_=$$filters_hashref{$_}"} keys %$filters_hashref);
|
|
foreach my $row (sort @loopline) {
|
|
my @loopcell;
|
|
#@loopcol ensures the order for columns is common with column titles
|
|
# and the number matches the number of columns
|
|
foreach my $col (sort keys %cols_hash) {
|
|
push @loopcell, {value =>( $$data{$row}{$col}{calculation} or ""),
|
|
# url_complement=>($urlbase=~/&$/?$urlbase."&":$urlbase)."filter_$linefield=$row&filter_$colfield=$col"
|
|
}
|
|
}
|
|
push @looprow, {
|
|
'rowtitle_display' => display_value($linefield,$row),
|
|
'rowtitle' => $row,
|
|
'loopcell' => \@loopcell,
|
|
'totalrow' => $$data{$row}{totalrow}
|
|
};
|
|
}
|
|
for my $col ( sort keys %cols_hash ) {
|
|
my $total = 0;
|
|
foreach my $row (@loopline) {
|
|
$total += $data->{$row}{$col}{calculation} if $data->{$row}{$col}{calculation};
|
|
}
|
|
push @loopfooter, {'totalcol' => $total};
|
|
push @loopcol, {'coltitle' => $col,
|
|
coltitle_display=>display_value($colfield,$col)};
|
|
}
|
|
# the header of the table
|
|
$globalline{loopfilter}=\@loopfilter;
|
|
# the core of the table
|
|
$globalline{looprow} = \@looprow;
|
|
$globalline{loopcol} = \@loopcol;
|
|
# # the foot (totals by borrower type)
|
|
$globalline{loopfooter} = \@loopfooter;
|
|
$globalline{total} = $grantotal;
|
|
$globalline{line} = $linefield;
|
|
$globalline{column} = $colfield;
|
|
return [(\%globalline)];
|
|
}
|
|
|
|
sub display_value {
|
|
my ( $crit, $value ) = @_;
|
|
my $locations = { map { ( $_->{authorised_value} => $_->{lib} ) } Koha::AuthorisedValues->get_descriptions_by_koha_field( { frameworkcode => '', kohafield => 'items.location' }, { order_by => ['description'] } ) };
|
|
my $ccodes = { map { ( $_->{authorised_value} => $_->{lib} ) } Koha::AuthorisedValues->get_descriptions_by_koha_field( { frameworkcode => '', kohafield => 'items.ccode' }, { order_by => ['description'] } ) };
|
|
my $Bsort1 = GetAuthorisedValues("Bsort1");
|
|
my $Bsort2 = GetAuthorisedValues("Bsort2");
|
|
my $display_value =
|
|
( $crit =~ /ccode/ ) ? $ccodes->{$value}
|
|
: ( $crit =~ /location/ ) ? $locations->{$value}
|
|
: ( $crit =~ /itemtype/ ) ? Koha::ItemTypes->find( $value )->translated_description
|
|
: ( $crit =~ /branch/ ) ? Koha::Libraries->find($value)->branchname
|
|
: ( $crit =~ /reservestatus/ ) ? reservestatushuman($value)
|
|
: $value; # default fallback
|
|
if ($crit =~ /sort1/) {
|
|
foreach (@$Bsort1) {
|
|
($value eq $_->{authorised_value}) or next;
|
|
$display_value = $_->{lib} and last;
|
|
}
|
|
}
|
|
elsif ($crit =~ /sort2/) {
|
|
foreach (@$Bsort2) {
|
|
($value eq $_->{authorised_value}) or next;
|
|
$display_value = $_->{lib} and last;
|
|
}
|
|
}
|
|
elsif ( $crit =~ /category/ ) {
|
|
my @patron_categories = Koha::Patron::Categories->search_with_library_limits({}, {order_by => ['description']})->as_list;
|
|
foreach my $patron_category ( @patron_categories ) {
|
|
( $value eq $patron_category->categorycode ) or next;
|
|
$display_value = $patron_category->description and last;
|
|
}
|
|
}
|
|
return $display_value;
|
|
}
|
|
|
|
sub reservestatushuman{
|
|
my ($val)=@_;
|
|
my %hashhuman=(
|
|
1=>"1- placed",
|
|
2=>"2- processed",
|
|
3=>"3- pending",
|
|
4=>"4- satisfied",
|
|
5=>"5- cancelled",
|
|
6=>"6- not a status"
|
|
);
|
|
$hashhuman{$val};
|
|
}
|
|
|
|
sub changeifreservestatus{
|
|
my ($val)=@_;
|
|
($val=~/reservestatus/
|
|
?$val=qq{ case
|
|
when priority>0 then 1
|
|
when priority=0 then
|
|
(case
|
|
when found='f' then 4
|
|
when found='w' then
|
|
(case
|
|
when cancellationdate is null then 3
|
|
else 5
|
|
end )
|
|
else 2
|
|
end )
|
|
else 6
|
|
end }
|
|
:$val);
|
|
}
|