reports/catalogue_out.pl

   1 #!/usr/bin/perl
   2
   3 # Copyright 2000-2002 Katipo Communications
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it under the
   8 # terms of the GNU General Public License as published by the Free Software
   9 # Foundation; either version 2 of the License, or (at your option) any later
  10 # version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License along with
  17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  18 # Suite 330, Boston, MA  02111-1307 USA
  19
  20 use strict;
  21 use warnings;
  22 use CGI;
  23
  24 use C4::Auth;
  25 use C4::Context;
  26 use C4::Debug;
  27 use C4::Branch; # GetBranches
  28 use C4::Output;
  29 use C4::Koha;   # GetItemTypes
  30 use C4::Reports;    # GetDelimiterChoices
  31 use C4::Circulation;
  32 # use Date::Manip;  # TODO: add not borrowed since date X criteria
  33 use Data::Dumper;
  34
  35 =head1 catalogue_out
  36
  37 Report that shows unborrowed items.
  38
  39 =cut
  40
  41 my $input = new CGI;
  42 my $do_it    = $input->param('do_it');
  43 my $limit    = $input->param("Limit");
  44 my $column   = $input->param("Criteria");
  45 my @filters  = $input->param("Filter");
  46 my $output   = $input->param("output");
  47 my $basename = $input->param("basename") || 'catalogue_out';
  48 my $mime     = $input->param("MIME");
  49 my ($template, $borrowernumber, $cookie) = get_template_and_user({
  50     template_name => "reports/catalogue_out.tmpl",
  51     query => $input,
  52     type => "intranet",
  53     authnotrequired => 0,
  54     flagsrequired => {reports => 1},
  55     debug => 1,
  56 });
  57
  58 our $sep     = $input->param("sep");
  59 $sep = "\t" if ((! defined $sep) or $sep eq 'tabulation');
  60
  61 $template->param(do_it => $do_it);
  62 if ($do_it) {
  63     my $results = calculate($limit, $column, \@filters);
  64     if ($output eq "screen") {
  65                 # Printing results to screen
  66                 $template->param(mainloop => $results);
  67         output_html_with_http_headers $input, $cookie, $template->output;
  68     } else {
  69                 # Printing to a csv file        FIXME: This is broken rather badly, if it ever worked at all here.
  70         print $input->header(
  71                         -type => 'application/vnd.sun.xml.calc',
  72             -encoding  => 'utf-8',
  73             -attachment=>"$basename.csv",
  74             -filename  =>"$basename.csv" );
  75         my $cols  = @$results[0]->{loopcol};
  76         my $lines = @$results[0]->{looprow};
  77 # header
  78         print "num /". @$results[0]->{column} .$sep;
  79 # Other header
  80         foreach my $col ( @$cols ) {
  81             print $col->{coltitle}.$sep;
  82         }
  83         print "Total\n";
  84 # Table
  85         foreach my $line ( @$lines ) {
  86             my $x = $line->{loopcell};  # FIXME: No Such thing.
  87             print $line->{rowtitle}.$sep;
  88             foreach my $cell (@$x) {
  89                 print $cell->{value}.$sep;
  90             }
  91             print $line->{totalrow}, "\n";
  92         }
  93 # footer
  94         print "TOTAL";
  95         foreach my $col ( @$cols ) {
  96             print $sep.$col->{totalcol};
  97         }
  98         print $sep.@$results[0]->{total};
  99     }
 100         exit(1); # in either case, exit after do_it
 101 }
 102
 103 # Displaying choices (i.e., not do_it)
 104 my @values;
 105 my %select;
 106
 107 my @mime  = ( map { +{type =>$_} } (split /[;:]/,C4::Context->preference("MIME")) );
 108 my $itemtypes = GetItemTypes;
 109 my @itemtypeloop;
 110 foreach (sort {$itemtypes->{$a}->{description} cmp $itemtypes->{$b}->{description}} keys %$itemtypes) {
 111         push @itemtypeloop, {
 112                 value => $_,
 113                 description => $itemtypes->{$_}->{'description'},
 114    };
 115 }
 116
 117 $template->param(
 118         CGIextChoice => \@mime,
 119         CGIsepChoice => GetDelimiterChoices,
 120         itemtypeloop => \@itemtypeloop,
 121         branchloop   => GetBranchesLoop($input->param("branch") || C4::Context->userenv->{branch}),
 122 );
 123 output_html_with_http_headers $input, $cookie, $template->output;
 124
 125
 126 sub calculate {
 127     my ($limit, $column, $filters) = @_;
 128     my @loopline;
 129     my @looprow;
 130     my %globalline;
 131         my %columns = ();
 132     my $dbh = C4::Context->dbh;
 133
 134 # Filters
 135 # Checking filters
 136 #
 137     my @loopfilter;
 138     for (my $i=0;$i<=6;$i++) {
 139         if ( @$filters[$i] ) {
 140                 my %cell = (filter=>@$filters[$i]);
 141             if (($i==1) and (@$filters[$i-1])) {
 142                 $cell{err} = 1 if (@$filters[$i]<@$filters[$i-1]) ;
 143             }
 144             $cell{crit} = "Branch"   if ($i==0);
 145             $cell{crit} = "Doc Type" if ($i==1);
 146             push @loopfilter, \%cell;
 147         }
 148     }
 149         push @loopfilter, {crit=>'limit', filter=>$limit} if ($limit);
 150     if ($column){
 151                 push @loopfilter, {crit=>'by', filter=>$column};
 152                 my $tablename = ($column =~ /branchcode/) ? 'branches' : 'items';
 153                 $column = ($column =~ /branchcode/ or $column =~ /itype/) ? "$tablename.$column" : $column;
 154         my $strsth2 = ($tablename eq 'branches') ?
 155                 "SELECT $column as coltitle, count(items.itemnumber) AS coltitle_count FROM $tablename LEFT JOIN items ON items.homebranch=$column " :
 156                 "SELECT $column as coltitle, count(*)                AS coltitle_count FROM $tablename " ;
 157         if ($tablename eq 'branches') {
 158                         my $f = @$filters[0];
 159             $f =~ s/\*/%/g;
 160             $strsth2 .= " AND $column LIKE '$f' " ;
 161         }
 162         $strsth2 .=" GROUP BY $column ORDER BY $column ";       # needed for count
 163                 push @loopfilter, {crit=>'SQL', sql=>1, filter=>$strsth2};
 164         $debug and warn "catalogue_out SQL: ". $strsth2;
 165         my $sth2 = $dbh->prepare($strsth2);
 166         $sth2->execute;
 167
 168         while (my ($celvalue, $count) = $sth2->fetchrow) {
 169                         ($celvalue) or $celvalue = 'UNKNOWN';
 170                         $columns{$celvalue} = $count;
 171         }
 172     }
 173
 174         my %tables = (map {$_=>[]} keys %columns);
 175
 176 # preparing calculation
 177         my @exe_args = ();
 178     my $query = "
 179         SELECT items.barcode        as barcode,
 180                items.homebranch     as branch,
 181                items.itemcallnumber as itemcallnumber,
 182                biblio.title         as title,
 183                biblio.biblionumber  as biblionumber,
 184                biblio.author        as author";
 185         ($column) and $query .= ",\n$column as col ";
 186         $query .= "
 187         FROM items
 188         LEFT JOIN biblio      USING (biblionumber)
 189         LEFT JOIN     issues  USING (itemnumber)
 190         LEFT JOIN old_issues  USING (itemnumber)
 191           WHERE       issues.itemnumber IS NULL
 192            AND    old_issues.itemnumber IS NULL
 193         ";
 194         if ($filters->[0]) {
 195         $filters->[0]=~ s/\*/%/g;
 196                 push @exe_args, $filters->[0];
 197         $query .= " AND items.homebranch LIKE ?";
 198         }
 199         if ($filters->[1]) {
 200         $filters->[1]=~ s/\*/%/g;
 201                 push @exe_args, $filters->[1];
 202         $query .= " AND items.itype      LIKE ?";
 203         }
 204         if ($column) {
 205                 $query .= " AND $column = ? GROUP BY items.itemnumber, $column ";       # placeholder handled below
 206     } else {
 207                 $query .= " GROUP BY items.itemnumber ";
 208         }
 209         $query .= " ORDER BY items.itemcallnumber DESC, barcode";
 210     $query .= " LIMIT 0,$limit" if ($limit);
 211     $debug and warn "SQL : $query";
 212     # warn "SQL : $query";
 213         push @loopfilter, {crit=>'SQL', sql=>1, filter=>$query};
 214     my $dbcalc = $dbh->prepare($query);
 215
 216         if ($column) {
 217                 foreach (sort keys %columns) {
 218                         my (@more_exe_args) = @exe_args;        # execute(@exe_args,$_) would fail when the array is empty.
 219                         push @more_exe_args, $_;                        # but @more_exe_args will work
 220                         $dbcalc->execute(@more_exe_args) or die "Query execute(@more_exe_args) failed: $query";
 221                 while (my $data = $dbcalc->fetchrow_hashref) {
 222                                 my $col = $data->{col} || 'NULL';
 223                                 $tables{$col} or $tables{$col} = [];
 224                                 push @{$tables{$col}}, $data;
 225                         }
 226                 }
 227         } else {
 228         (scalar @exe_args) ? $dbcalc->execute(@exe_args) : $dbcalc->execute;
 229                 while (my $data = $dbcalc->fetchrow_hashref) {
 230                         my $col = $data->{col} || 'NULL';
 231                         $tables{$col} or $tables{$col} = [];
 232                         push @{$tables{$col}}, $data;
 233                 }
 234         }
 235
 236         foreach my $tablename (sort keys %tables) {
 237                 my (@temptable);
 238                 my $i=0;
 239                 foreach my $cell (@{$tables{$tablename}}) {
 240                         if (0 == $i++ and $debug) {
 241                                 my $dump = Dumper($cell);
 242                                 $dump =~ s/\n/ /gs;
 243                                 $dump =~ s/\s+/ /gs;
 244                                 print STDERR "first cell for $tablename: $dump";
 245                         }
 246                         push @temptable, $cell;
 247                 }
 248                 my $count = scalar(@temptable);
 249                 my $allitems = $columns{$tablename};
 250                 $globalline{total_looptable_count} += $count;
 251                 $globalline{total_coltitle_count}  += $allitems;
 252         push @{$globalline{looptables}}, {
 253                         looprow  => \@temptable,
 254                         coltitle => $tablename,
 255                         coltitle_count  => $allitems,
 256                         looptable_count => $count,
 257                         looptable_first => ($count) ? $temptable[ 0]->{itemcallnumber} : '',
 258                         looptable_last  => ($count) ? $temptable[-1]->{itemcallnumber} : '',
 259                 };
 260         }
 261
 262     # the header of the table
 263     $globalline{loopfilter}=\@loopfilter;
 264     $globalline{limit}   = $limit;
 265     $globalline{column}  = $column;
 266     return [(\%globalline)]; #  reference to array of reference to hash
 267 }
 268
 269 1;
 270 __END__
 271