Koha/reports/catalogue_out.pl
Fridolyn SOMERS ec09fe092e Bug 10718: fix items with no checkouts report
Bug 8124 has commented the option to download results items with no
checkouts report into a file.  But the perl code of this page uses
the export into a file has default behavior since the input "output"
is no more present.  The consequence is that there are never results
in page.

This patch removes the code concerning file output from template and perl.
Such a feature exists in guided reports.

Test plan :
Play with cgi-bin/koha/reports/catalogue_out.pl form and see if you get results

Bug 10718 - select user branch as default

In cgi-bin/koha/reports/catalogue_out.pl report, select in library filter the user logged-in.

Test plan :
- Log into intranet with a normal user
- Got to "Items with no checkouts" reports
=> Your branch is selected
- Run report
=> You see "Filtered on : Branch = <your branch>"
- Come back to report
- Select "Any library"
- Run report
=> You do not see "Filtered on : Branch"

Bug 10718 - items with no checkouts report permission is execute_reports

This report only executes SQL to change reports/catalogue_out.pl permissions from all reports subpermissions to reports/execute_reports.

Test plan :
Test you can access and run this report with only execute_reports subpermission into reports permission.

Bug 10718 - redefine limit input

In reports/catalogue_out.pl form, the limit input is by defaut none.
So by default the report queries all the catalogue.
This may take a very long time (fall into timeout) and since now the results are displayed in page, the page may be huge.

This patch modifies limit input to removes the "none" option.
Also reduces the number of options (same options as guided reports results per page).

Test plan:
- Go to reports/catalogue_out.pl
=> first value "10" is selected
- Launch report
=> You see "Filtered on: limit = 10"

Bug 10718 - perltidy on reports/catalogue_out.pl

Signed-off-by: Liz Rea <liz@catalyst.net.nz>
Tested all of these things, all ok - squashed patch for neatness.

Signed-off-by: Katrin Fischer <Katrin.Fischer.83@web.de>
Passes all tests and QA script.
Fixed a tab in one of the comments.
Improves script, but more work needed.

Signed-off-by: Katrin Fischer <Katrin.Fischer.83@web.de>
Signed-off-by: Galen Charlton <gmc@esilibrary.com>
2013-09-08 20:04:43 +00:00

242 lines
7.9 KiB
Perl
Executable file

#!/usr/bin/perl
# Copyright 2000-2002 Katipo Communications
#
# 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 2 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, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
use strict;
use warnings;
use CGI;
use C4::Auth;
use C4::Context;
use C4::Debug;
use C4::Branch; # GetBranchesLoop
use C4::Output;
use C4::Koha; # GetItemTypes
# use Date::Manip; # TODO: add not borrowed since date X criteria
use Data::Dumper;
=head1 catalogue_out
Report that shows unborrowed items.
=cut
my $input = new CGI;
my $do_it = $input->param('do_it');
my $limit = $input->param("Limit") || 10;
my $column = $input->param("Criteria");
my @filters = $input->param("Filter");
my ( $template, $borrowernumber, $cookie ) = get_template_and_user(
{
template_name => "reports/catalogue_out.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => { reports => 'execute_reports' },
debug => 1,
}
);
$template->param( do_it => $do_it );
if ($do_it) {
my $results = calculate( $limit, $column, \@filters );
$template->param( mainloop => $results );
output_html_with_http_headers $input, $cookie, $template->output;
exit; # in either case, exit after do_it
}
# Displaying choices (i.e., not do_it)
my $itemtypes = GetItemTypes();
my @itemtypeloop;
foreach (
sort { $itemtypes->{$a}->{'description'} cmp $itemtypes->{$b}->{'description'} }
keys %$itemtypes
)
{
push @itemtypeloop,
{
value => $_,
description => $itemtypes->{$_}->{'description'},
};
}
$template->param(
itemtypeloop => \@itemtypeloop,
branchloop => GetBranchesLoop(),
);
output_html_with_http_headers $input, $cookie, $template->output;
sub calculate {
my ( $limit, $column, $filters ) = @_;
my @loopline;
my @looprow;
my %globalline;
my %columns = ();
my $dbh = C4::Context->dbh;
# Filters
# Checking filters
#
my @loopfilter;
for ( my $i = 0 ; $i <= 6 ; $i++ ) {
if ( @$filters[$i] ) {
my %cell = ( filter => @$filters[$i] );
if ( ( $i == 1 ) and ( @$filters[ $i - 1 ] ) ) {
$cell{err} = 1 if ( @$filters[$i] < @$filters[ $i - 1 ] );
}
$cell{crit} = "Branch" if ( $i == 0 );
$cell{crit} = "Doc Type" if ( $i == 1 );
push @loopfilter, \%cell;
}
}
push @loopfilter, { crit => 'limit', filter => $limit } if ($limit);
if ($column) {
push @loopfilter, { crit => 'by', filter => $column };
my $tablename = ( $column =~ /branchcode/ ) ? 'branches' : 'items';
$column =
( $column =~ /branchcode/ or $column =~ /itype/ )
? "$tablename.$column"
: $column;
my $strsth2 =
( $tablename eq 'branches' )
? "SELECT $column as coltitle, count(items.itemnumber) AS coltitle_count FROM $tablename LEFT JOIN items ON items.homebranch=$column "
: "SELECT $column as coltitle, count(*) AS coltitle_count FROM $tablename ";
if ( $tablename eq 'branches' ) {
my $f = @$filters[0];
$f =~ s/\*/%/g;
$strsth2 .= " AND $column LIKE '$f' ";
}
$strsth2 .= " GROUP BY $column ORDER BY $column "; # needed for count
push @loopfilter, { crit => 'SQL', sql => 1, filter => $strsth2 };
$debug and warn "catalogue_out SQL: " . $strsth2;
my $sth2 = $dbh->prepare($strsth2);
$sth2->execute;
while ( my ( $celvalue, $count ) = $sth2->fetchrow ) {
($celvalue) or $celvalue = 'UNKNOWN';
$columns{$celvalue} = $count;
}
}
my %tables = ( map { $_ => [] } keys %columns );
# preparing calculation
my @exe_args = ();
my $query = "
SELECT items.barcode as barcode,
items.homebranch as branch,
items.itemcallnumber as itemcallnumber,
biblio.title as title,
biblio.biblionumber as biblionumber,
biblio.author as author";
($column) and $query .= ",\n$column as col ";
$query .= "
FROM items
LEFT JOIN biblio USING (biblionumber)
LEFT JOIN issues USING (itemnumber)
LEFT JOIN old_issues USING (itemnumber)
WHERE issues.itemnumber IS NULL
AND old_issues.itemnumber IS NULL
";
if ( $filters->[0] ) {
$filters->[0] =~ s/\*/%/g;
push @exe_args, $filters->[0];
$query .= " AND items.homebranch LIKE ?";
}
if ( $filters->[1] ) {
$filters->[1] =~ s/\*/%/g;
push @exe_args, $filters->[1];
$query .= " AND items.itype LIKE ?";
}
if ($column) {
$query .= " AND $column = ? GROUP BY items.itemnumber, $column ";
# placeholder handled below
}
else {
$query .= " GROUP BY items.itemnumber ";
}
$query .= " ORDER BY items.itemcallnumber DESC, barcode";
$query .= " LIMIT 0,$limit" if ($limit);
$debug and warn "SQL : $query";
# warn "SQL : $query";
push @loopfilter, { crit => 'SQL', sql => 1, filter => $query };
my $dbcalc = $dbh->prepare($query);
if ($column) {
foreach ( sort keys %columns ) {
# execute(@exe_args,$_) would fail when the array is empty
# but @more_exe_args will work
my (@more_exe_args) = @exe_args;
push @more_exe_args, $_;
$dbcalc->execute(@more_exe_args)
or die "Query execute(@more_exe_args) failed: $query";
while ( my $data = $dbcalc->fetchrow_hashref ) {
my $col = $data->{col} || 'NULL';
$tables{$col} or $tables{$col} = [];
push @{ $tables{$col} }, $data;
}
}
}
else {
( scalar @exe_args ) ? $dbcalc->execute(@exe_args) : $dbcalc->execute;
while ( my $data = $dbcalc->fetchrow_hashref ) {
my $col = $data->{col} || 'NULL';
$tables{$col} or $tables{$col} = [];
push @{ $tables{$col} }, $data;
}
}
foreach my $tablename ( sort keys %tables ) {
my (@temptable);
my $i = 0;
foreach my $cell ( @{ $tables{$tablename} } ) {
if ( 0 == $i++ and $debug ) {
my $dump = Dumper($cell);
$dump =~ s/\n/ /gs;
$dump =~ s/\s+/ /gs;
print STDERR "first cell for $tablename: $dump";
}
push @temptable, $cell;
}
my $count = scalar(@temptable);
my $allitems = $columns{$tablename};
$globalline{total_looptable_count} += $count;
$globalline{total_coltitle_count} += $allitems;
push @{ $globalline{looptables} },
{
looprow => \@temptable,
coltitle => $tablename,
coltitle_count => $allitems,
looptable_count => $count,
looptable_first => ($count) ? $temptable[0]->{itemcallnumber} : '',
looptable_last => ($count) ? $temptable[-1]->{itemcallnumber} : '',
};
}
# the header of the table
$globalline{loopfilter} = \@loopfilter;
$globalline{limit} = $limit;
$globalline{column} = $column;
return [ ( \%globalline ) ]; # reference to array of reference to hash
}
1;
__END__