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
  17 # with Koha; if not, write to the Free Software Foundation, Inc.,
  18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 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 ($template, $borrowernumber, $cookie) = get_template_and_user({
  49     template_name => "reports/catalogue_out.tmpl",
  50     query => $input,
  51     type => "intranet",
  52     authnotrequired => 0,
  53     flagsrequired => {reports => '*'},
  54     debug => 1,
  55 });
  56
  57 our $sep     = $input->param("sep");
  58 $sep = "\t" if ((! defined $sep) or $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; # in either case, exit after do_it
 100 }
 101
 102 # Displaying choices (i.e., not do_it)
 103 my @values;
 104 my %select;
 105
 106 my @mime  = ( map { +{type =>$_} } (split /[;:]/, 'CSV') ); # FIXME translation
 107 my $itemtypes = GetItemTypes;
 108 my @itemtypeloop;
 109 foreach (sort {$itemtypes->{$a}->{description} cmp $itemtypes->{$b}->{description}} keys %$itemtypes) {
 110         push @itemtypeloop, {
 111                 value => $_,
 112                 description => $itemtypes->{$_}->{'description'},
 113    };
 114 }
 115
 116 $template->param(
 117         CGIextChoice => \@mime,
 118         CGIsepChoice => GetDelimiterChoices,
 119         itemtypeloop => \@itemtypeloop,
 120         branchloop   => GetBranchesLoop($input->param("branch") || C4::Context->userenv->{branch}),
 121 );
 122 output_html_with_http_headers $input, $cookie, $template->output;
 123
 124
 125 sub calculate {
 126     my ($limit, $column, $filters) = @_;
 127     my @loopline;
 128     my @looprow;
 129     my %globalline;
 130         my %columns = ();
 131     my $dbh = C4::Context->dbh;
 132
 133 # Filters
 134 # Checking filters
 135 #
 136     my @loopfilter;
 137     for (my $i=0;$i<=6;$i++) {
 138         if ( @$filters[$i] ) {
 139                 my %cell = (filter=>@$filters[$i]);
 140             if (($i==1) and (@$filters[$i-1])) {
 141                 $cell{err} = 1 if (@$filters[$i]<@$filters[$i-1]) ;
 142             }
 143             $cell{crit} = "Branch"   if ($i==0);
 144             $cell{crit} = "Doc Type" if ($i==1);
 145             push @loopfilter, \%cell;
 146         }
 147     }
 148         push @loopfilter, {crit=>'limit', filter=>$limit} if ($limit);
 149     if ($column){
 150                 push @loopfilter, {crit=>'by', filter=>$column};
 151                 my $tablename = ($column =~ /branchcode/) ? 'branches' : 'items';
 152                 $column = ($column =~ /branchcode/ or $column =~ /itype/) ? "$tablename.$column" : $column;
 153         my $strsth2 = ($tablename eq 'branches') ?
 154                 "SELECT $column as coltitle, count(items.itemnumber) AS coltitle_count FROM $tablename LEFT JOIN items ON items.homebranch=$column " :
 155                 "SELECT $column as coltitle, count(*)                AS coltitle_count FROM $tablename " ;
 156         if ($tablename eq 'branches') {
 157                         my $f = @$filters[0];
 158             $f =~ s/\*/%/g;
 159             $strsth2 .= " AND $column LIKE '$f' " ;
 160         }
 161         $strsth2 .=" GROUP BY $column ORDER BY $column ";       # needed for count
 162                 push @loopfilter, {crit=>'SQL', sql=>1, filter=>$strsth2};
 163         $debug and warn "catalogue_out SQL: ". $strsth2;
 164         my $sth2 = $dbh->prepare($strsth2);
 165         $sth2->execute;
 166
 167         while (my ($celvalue, $count) = $sth2->fetchrow) {
 168                         ($celvalue) or $celvalue = 'UNKNOWN';
 169                         $columns{$celvalue} = $count;
 170         }
 171     }
 172
 173         my %tables = (map {$_=>[]} keys %columns);
 174
 175 # preparing calculation
 176         my @exe_args = ();
 177     my $query = "
 178         SELECT items.barcode        as barcode,
 179                items.homebranch     as branch,
 180                items.itemcallnumber as itemcallnumber,
 181                biblio.title         as title,
 182                biblio.biblionumber  as biblionumber,
 183                biblio.author        as author";
 184         ($column) and $query .= ",\n$column as col ";
 185         $query .= "
 186         FROM items
 187         LEFT JOIN biblio      USING (biblionumber)
 188         LEFT JOIN     issues  USING (itemnumber)
 189         LEFT JOIN old_issues  USING (itemnumber)
 190           WHERE       issues.itemnumber IS NULL
 191            AND    old_issues.itemnumber IS NULL
 192         ";
 193         if ($filters->[0]) {
 194         $filters->[0]=~ s/\*/%/g;
 195                 push @exe_args, $filters->[0];
 196         $query .= " AND items.homebranch LIKE ?";
 197         }
 198         if ($filters->[1]) {
 199         $filters->[1]=~ s/\*/%/g;
 200                 push @exe_args, $filters->[1];
 201         $query .= " AND items.itype      LIKE ?";
 202         }
 203         if ($column) {
 204                 $query .= " AND $column = ? GROUP BY items.itemnumber, $column ";       # placeholder handled below
 205     } else {
 206                 $query .= " GROUP BY items.itemnumber ";
 207         }
 208         $query .= " ORDER BY items.itemcallnumber DESC, barcode";
 209     $query .= " LIMIT 0,$limit" if ($limit);
 210     $debug and warn "SQL : $query";
 211     # warn "SQL : $query";
 212         push @loopfilter, {crit=>'SQL', sql=>1, filter=>$query};
 213     my $dbcalc = $dbh->prepare($query);
 214
 215         if ($column) {
 216                 foreach (sort keys %columns) {
 217                         my (@more_exe_args) = @exe_args;        # execute(@exe_args,$_) would fail when the array is empty.
 218                         push @more_exe_args, $_;                        # but @more_exe_args will work
 219                         $dbcalc->execute(@more_exe_args) or die "Query execute(@more_exe_args) failed: $query";
 220                 while (my $data = $dbcalc->fetchrow_hashref) {
 221                                 my $col = $data->{col} || 'NULL';
 222                                 $tables{$col} or $tables{$col} = [];
 223                                 push @{$tables{$col}}, $data;
 224                         }
 225                 }
 226         } else {
 227         (scalar @exe_args) ? $dbcalc->execute(@exe_args) : $dbcalc->execute;
 228                 while (my $data = $dbcalc->fetchrow_hashref) {
 229                         my $col = $data->{col} || 'NULL';
 230                         $tables{$col} or $tables{$col} = [];
 231                         push @{$tables{$col}}, $data;
 232                 }
 233         }
 234
 235         foreach my $tablename (sort keys %tables) {
 236                 my (@temptable);
 237                 my $i=0;
 238                 foreach my $cell (@{$tables{$tablename}}) {
 239                         if (0 == $i++ and $debug) {
 240                                 my $dump = Dumper($cell);
 241                                 $dump =~ s/\n/ /gs;
 242                                 $dump =~ s/\s+/ /gs;
 243                                 print STDERR "first cell for $tablename: $dump";
 244                         }
 245                         push @temptable, $cell;
 246                 }
 247                 my $count = scalar(@temptable);
 248                 my $allitems = $columns{$tablename};
 249                 $globalline{total_looptable_count} += $count;
 250                 $globalline{total_coltitle_count}  += $allitems;
 251         push @{$globalline{looptables}}, {
 252                         looprow  => \@temptable,
 253                         coltitle => $tablename,
 254                         coltitle_count  => $allitems,
 255                         looptable_count => $count,
 256                         looptable_first => ($count) ? $temptable[ 0]->{itemcallnumber} : '',
 257                         looptable_last  => ($count) ? $temptable[-1]->{itemcallnumber} : '',
 258                 };
 259         }
 260
 261     # the header of the table
 262     $globalline{loopfilter}=\@loopfilter;
 263     $globalline{limit}   = $limit;
 264     $globalline{column}  = $column;
 265     return [(\%globalline)]; #  reference to array of reference to hash
 266 }
 267
 268 1;
 269 __END__
 270