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 CGI;
  22 use C4::Auth;
  23 use C4::Context;
  24 use C4::Debug;
  25 use C4::Branch; # GetBranches
  26 use C4::Output;
  27 use C4::Koha;
  28 use C4::Reports;
  29 use C4::Circulation;
  30 use Date::Manip;
  31 use Data::Dumper;
  32
  33 =head1 catalogue_out
  34
  35 Report that shows unborrowed items.
  36
  37 =cut
  38
  39 my $input = new CGI;
  40 my $fullreportname = "reports/catalogue_out.tmpl";
  41 my $do_it    = $input->param('do_it');
  42 my $limit    = $input->param("Limit");
  43 my $column   = $input->param("Criteria");
  44 my @filters  = $input->param("Filter");
  45 my $output   = $input->param("output");
  46 my $basename = $input->param("basename") || 'catalogue_out';
  47 my $mime     = $input->param("MIME");
  48 my ($template, $borrowernumber, $cookie)
  49     = get_template_and_user({template_name => $fullreportname,
  50         query => $input,
  51         type => "intranet",
  52         authnotrequired => 0,
  53         flagsrequired => {reports => 1},
  54         debug => 1,
  55     });
  56
  57 our $sep     = $input->param("sep");
  58 $sep = "\t" if ($sep eq 'tabulation');
  59
  60 $template->param(do_it => $do_it);
  61 if ($do_it) {
  62     my $results = calculate($limit, $column, \@filters);
  63     if ($output eq "screen") {
  64                 # Printing results to screen
  65                 $template->param(mainloop => $results);
  66         output_html_with_http_headers $input, $cookie, $template->output;
  67     } else {
  68                 # Printing to a csv file        FIXME: This is broken rather badly, if it ever worked at all here.
  69         print $input->header(
  70                         -type => 'application/vnd.sun.xml.calc',
  71             -encoding  => 'utf-8',
  72             -attachment=>"$basename.csv",
  73             -filename  =>"$basename.csv" );
  74         my $cols  = @$results[0]->{loopcol};
  75         my $lines = @$results[0]->{looprow};
  76 # header
  77         print "num /". @$results[0]->{column} .$sep;
  78 # Other header
  79         foreach my $col ( @$cols ) {
  80             print $col->{coltitle}.$sep;
  81         }
  82         print "Total\n";
  83 # Table
  84         foreach my $line ( @$lines ) {
  85             my $x = $line->{loopcell};  # FIXME: No Such thing.
  86             print $line->{rowtitle}.$sep;
  87             foreach my $cell (@$x) {
  88                 print $cell->{value}.$sep;
  89             }
  90             print $line->{totalrow}, "\n";
  91         }
  92 # footer
  93         print "TOTAL";
  94         foreach my $col ( @$cols ) {
  95             print $sep.$col->{totalcol};
  96         }
  97         print $sep.@$results[0]->{total};
  98     }
  99         exit(1); # in either case, exit after do_it
 100 }
 101
 102 # Displaying choices (i.e., not do_it)
 103 my $dbh = C4::Context->dbh;
 104 my @values;
 105 my %select;
 106
 107 my @mime = (C4::Context->preference("MIME"));
 108 my $CGIextChoice = CGI::scrolling_list(
 109                 -name     => 'MIME',
 110                 -id       => 'MIME',
 111                 -values   => \@mime,
 112                 -size     => 1,
 113                 -multiple => 0 );
 114
 115 my $CGIsepChoice = GetDelimiterChoices;
 116
 117 my $itemtypes = GetItemTypes;
 118 my @itemtypeloop;
 119 foreach (keys %$itemtypes) {
 120         push @itemtypeloop, {
 121                 value => $_,
 122 #               selected => ($_ eq $itemtype) ? 1 : 0,
 123                 description => $itemtypes->{$_}->{'description'},
 124    };
 125 }
 126 my $branches = GetBranches;
 127 my @branchloop;
 128 foreach (keys %$branches) {
 129         push @branchloop, {
 130                 value => $_,
 131 #               selected => ($_ eq $branch) ? 1 : 0,
 132                 branchname => $branches->{$_}->{'branchname'},
 133         };
 134 }
 135
 136 $template->param(
 137         CGIextChoice => $CGIextChoice,
 138         CGIsepChoice => $CGIsepChoice,
 139         itemtypeloop =>\@itemtypeloop,
 140         branchloop   =>\@branchloop,
 141 );
 142 output_html_with_http_headers $input, $cookie, $template->output;
 143
 144
 145 sub calculate {
 146     my ($limit, $column, $filters) = @_;
 147     my @loopline;
 148     my @looprow;
 149     my %globalline;
 150         my %columns = ();
 151     my $dbh = C4::Context->dbh;
 152
 153 # Filters
 154 # Checking filters
 155 #
 156     my @loopfilter;
 157     for (my $i=0;$i<=6;$i++) {
 158         if ( @$filters[$i] ) {
 159                 my %cell = (filter=>@$filters[$i]);
 160             if (($i==1) and (@$filters[$i-1])) {
 161                 $cell{err} = 1 if (@$filters[$i]<@$filters[$i-1]) ;
 162             }
 163             $cell{crit} = "Branch"   if ($i==0);
 164             $cell{crit} = "Doc Type" if ($i==1);
 165             push @loopfilter, \%cell;
 166         }
 167     }
 168         push @loopfilter, {crit=>'limit', filter=>$limit} if ($limit);
 169     if ($column){
 170                 push @loopfilter, {crit=>'by', filter=>$column};
 171                 my $tablename = ($column =~ /branchcode/) ? 'branches' : 'items';
 172                 $column = ($column =~ /branchcode/ or $column =~ /itype/) ? "$tablename.$column" : $column;
 173         my $strsth2 = ($tablename eq 'branches') ?
 174                 "SELECT $column as coltitle, count(items.itemnumber) AS coltitle_count FROM $tablename LEFT JOIN items ON items.homebranch=$column " :
 175                 "SELECT $column as coltitle, count(*)                AS coltitle_count FROM $tablename " ;
 176         if ($tablename eq 'branches') {
 177                         my $f = @$filters[0];
 178             $f =~ s/\*/%/g;
 179             $strsth2 .= " AND $column LIKE '$f' " ;
 180         }
 181         $strsth2 .=" GROUP BY $column ORDER BY $column ";       # needed for count
 182                 push @loopfilter, {crit=>'SQL', sql=>1, filter=>$strsth2};
 183         $debug and warn "catalogue_out SQL: ". $strsth2;
 184         my $sth2 = $dbh->prepare($strsth2);
 185         $sth2->execute;
 186
 187         while (my ($celvalue, $count) = $sth2->fetchrow) {
 188                         ($celvalue) or $celvalue = 'UNKNOWN';
 189                         $columns{$celvalue} = $count;
 190         }
 191     }
 192
 193         my %tables = (map {$_=>[]} keys %columns);
 194
 195 # preparing calculation
 196         my @exe_args = ();
 197     my $query = "
 198         SELECT items.barcode    as barcode,
 199                items.homebranch as branch,
 200                items.itemcallnumber as itemcallnumber,
 201                biblio.title     as title,
 202                biblio.biblionumber  as biblionumber,
 203                biblio.author    as author";
 204         ($column) and $query .= ",\n$column as col ";
 205         $query .= "
 206         FROM items
 207         LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber
 208         LEFT JOIN biblio      ON biblio.biblionumber   = items.biblionumber
 209         LEFT JOIN old_issues  ON old_issues.itemnumber = items.itemnumber
 210         WHERE old_issues.itemnumber IS NULL
 211         ";
 212         if ($filters->[0]) {
 213         $filters->[0]=~ s/\*/%/g;
 214                 push @exe_args, $filters->[0];
 215         $query .= " AND items.homebranch     LIKE ?";
 216         }
 217         if ($filters->[1]) {
 218         $filters->[1]=~ s/\*/%/g;
 219                 push @exe_args, $filters->[1];
 220         $query .= " AND biblioitems.itemtype LIKE ?";
 221         }
 222         if ($column) {
 223                 $query .= " AND $column = ? GROUP BY items.itemnumber, $column ";       # placeholder handled below
 224     } else {
 225                 $query .= " GROUP BY items.itemnumber ";
 226         }
 227         $query .= " ORDER BY items.itemcallnumber DESC, barcode";
 228     $query .= " LIMIT 0,$limit" if ($limit);
 229     $debug and warn "SQL : $query";
 230     # warn "SQL : $query";
 231         push @loopfilter, {crit=>'SQL', sql=>1, filter=>$query};
 232     my $dbcalc = $dbh->prepare($query);
 233
 234         if ($column) {
 235                 foreach (sort keys %columns) {
 236                         my (@more_exe_args) = @exe_args;        # execute(@exe_args,$_) would fail when the array is empty.
 237                         push @more_exe_args, $_;                        # but @more_exe_args will work
 238                         $dbcalc->execute(@more_exe_args) or die "Query execute(@more_exe_args) failed: $query";
 239                 while (my $data = $dbcalc->fetchrow_hashref) {
 240                                 my $col = $data->{col} || 'NULL';
 241                                 $tables{$col} or $tables{$col} = [];
 242                                 push @{$tables{$col}}, $data;
 243                         }
 244                 }
 245         } else {
 246         (scalar @exe_args) ? $dbcalc->execute(@exe_args) : $dbcalc->execute;
 247                 while (my $data = $dbcalc->fetchrow_hashref) {
 248                         my $col = $data->{col} || 'NULL';
 249                         $tables{$col} or $tables{$col} = [];
 250                         push @{$tables{$col}}, $data;
 251                 }
 252         }
 253
 254         foreach my $tablename (sort keys %tables) {
 255                 my (@temptable);
 256                 my $i=0;
 257                 foreach my $cell (@{$tables{$tablename}}) {
 258                         if (0 == $i++ and $debug) {
 259                                 my $dump = Dumper($cell);
 260                                 $dump =~ s/\n/ /gs;
 261                                 $dump =~ s/\s+/ /gs;
 262                                 print STDERR "first cell for $tablename: $dump";
 263                         }
 264                         push @temptable, $cell;
 265                 }
 266                 my $count = scalar(@temptable);
 267                 my $allitems = $columns{$tablename};
 268                 $globalline{total_looptable_count} += $count;
 269                 $globalline{total_coltitle_count}  += $allitems;
 270         push @{$globalline{looptables}}, {
 271                         looprow  => \@temptable,
 272                         coltitle => $tablename,
 273                         coltitle_count  => $allitems,
 274                         looptable_count => $count,
 275                         looptable_first => ($count) ? $temptable[ 0]->{itemcallnumber} : '',
 276                         looptable_last  => ($count) ? $temptable[-1]->{itemcallnumber} : '',
 277                 };
 278         }
 279
 280     # the header of the table
 281     $globalline{loopfilter}=\@loopfilter;
 282     $globalline{limit}   = $limit;
 283     $globalline{column}  = $column;
 284     return [(\%globalline)]; #  reference to array of reference to hash
 285 }
 286
 287 1;
 288 __END__
 289