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