Koha/reports/catalogue_out.pl
2009-10-16 23:55:50 +02:00

271 lines
8.6 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., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
use strict;
use warnings;
use CGI;
use C4::Auth;
use C4::Context;
use C4::Debug;
use C4::Branch; # GetBranches
use C4::Output;
use C4::Koha; # GetItemTypes
use C4::Reports; # GetDelimiterChoices
use C4::Circulation;
# 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");
my $column = $input->param("Criteria");
my @filters = $input->param("Filter");
my $output = $input->param("output");
my $basename = $input->param("basename") || 'catalogue_out';
my $mime = $input->param("MIME");
my ($template, $borrowernumber, $cookie) = get_template_and_user({
template_name => "reports/catalogue_out.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {reports => '*'},
debug => 1,
});
our $sep = $input->param("sep");
$sep = "\t" if ((! defined $sep) or $sep eq 'tabulation');
$template->param(do_it => $do_it);
if ($do_it) {
my $results = calculate($limit, $column, \@filters);
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 FIXME: This is broken rather badly, if it ever worked at all here.
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
print "num /". @$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}; # FIXME: No Such thing.
print $line->{rowtitle}.$sep;
foreach my $cell (@$x) {
print $cell->{value}.$sep;
}
print $line->{totalrow}, "\n";
}
# footer
print "TOTAL";
foreach my $col ( @$cols ) {
print $sep.$col->{totalcol};
}
print $sep.@$results[0]->{total};
}
exit(1); # in either case, exit after do_it
}
# Displaying choices (i.e., not do_it)
my @values;
my %select;
my @mime = ( map { +{type =>$_} } (split /[;:]/,C4::Context->preference("MIME")) );
my $itemtypes = GetItemTypes;
my @itemtypeloop;
foreach (sort {$itemtypes->{$a}->{description} cmp $itemtypes->{$b}->{description}} keys %$itemtypes) {
push @itemtypeloop, {
value => $_,
description => $itemtypes->{$_}->{'description'},
};
}
$template->param(
CGIextChoice => \@mime,
CGIsepChoice => GetDelimiterChoices,
itemtypeloop => \@itemtypeloop,
branchloop => GetBranchesLoop($input->param("branch") || C4::Context->userenv->{branch}),
);
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) {
my (@more_exe_args) = @exe_args; # execute(@exe_args,$_) would fail when the array is empty.
push @more_exe_args, $_; # but @more_exe_args will work
$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__