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
   8 # under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 3 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  19
  20 use strict;
  21 use warnings;
  22 use CGI qw ( -utf8 );
  23
  24 use C4::Auth;
  25 use C4::Context;
  26 use C4::Debug;
  27 use C4::Branch;    # GetBranchesLoop
  28 use C4::Output;
  29 use C4::Koha;      # GetItemTypes
  30 # use Date::Manip;  # TODO: add not borrowed since date X criteria
  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 $do_it   = $input->param('do_it');
  41 my $limit   = $input->param("Limit") || 10;
  42 my $column  = $input->param("Criteria");
  43 my @filters = $input->multi_param("Filter");
  44
  45 my ( $template, $borrowernumber, $cookie ) = get_template_and_user(
  46     {
  47         template_name   => "reports/catalogue_out.tt",
  48         query           => $input,
  49         type            => "intranet",
  50         authnotrequired => 0,
  51         flagsrequired   => { reports => 'execute_reports' },
  52         debug           => 1,
  53     }
  54 );
  55
  56 $template->param( do_it => $do_it );
  57 if ($do_it) {
  58     my $results = calculate( $limit, $column, \@filters );
  59     $template->param( mainloop => $results );
  60     output_html_with_http_headers $input, $cookie, $template->output;
  61     exit;    # in either case, exit after do_it
  62 }
  63
  64 # Displaying choices (i.e., not do_it)
  65 my $itemtypes = GetItemTypes();
  66 my @itemtypeloop;
  67 foreach (
  68     sort { $itemtypes->{$a}->{translated_description} cmp $itemtypes->{$b}->{translated_description} }
  69     keys %$itemtypes
  70   )
  71 {
  72     push @itemtypeloop,
  73       {
  74         value       => $_,
  75         description => $itemtypes->{$_}->{translated_description},
  76       };
  77 }
  78
  79 $template->param(
  80     itemtypeloop => \@itemtypeloop,
  81     branchloop   => GetBranchesLoop(),
  82 );
  83 output_html_with_http_headers $input, $cookie, $template->output;
  84
  85 sub calculate {
  86     my ( $limit, $column, $filters ) = @_;
  87     my @loopline;
  88     my @looprow;
  89     my %globalline;
  90     my %columns = ();
  91     my $dbh     = C4::Context->dbh;
  92
  93     # Filters
  94     # Checking filters
  95     #
  96     my @loopfilter;
  97     for ( my $i = 0 ; $i <= 6 ; $i++ ) {
  98         if ( @$filters[$i] ) {
  99             my %cell = ( filter => @$filters[$i] );
 100             if ( ( $i == 1 ) and ( @$filters[ $i - 1 ] ) ) {
 101                 $cell{err} = 1 if ( @$filters[$i] < @$filters[ $i - 1 ] );
 102             }
 103             $cell{crit} = "Branch"   if ( $i == 0 );
 104             $cell{crit} = "Doc Type" if ( $i == 1 );
 105             push @loopfilter, \%cell;
 106         }
 107     }
 108     push @loopfilter, { crit => 'limit', filter => $limit } if ($limit);
 109     if ($column) {
 110         push @loopfilter, { crit => 'by', filter => $column };
 111         my $tablename = ( $column =~ /branchcode/ ) ? 'branches' : 'items';
 112         $column =
 113           ( $column =~ /branchcode/ or $column =~ /itype/ )
 114           ? "$tablename.$column"
 115           : $column;
 116         my $strsth2 =
 117           ( $tablename eq 'branches' )
 118           ? "SELECT $column as coltitle, count(items.itemnumber) AS coltitle_count FROM $tablename LEFT JOIN items ON items.homebranch=$column "
 119           : "SELECT $column as coltitle, count(*)                AS coltitle_count FROM $tablename ";
 120         if ( $tablename eq 'branches' ) {
 121             my $f = @$filters[0];
 122             $f =~ s/\*/%/g;
 123             $strsth2 .= " AND $column LIKE '$f' ";
 124         }
 125         $strsth2 .= " GROUP BY $column ORDER BY $column ";    # needed for count
 126         push @loopfilter, { crit => 'SQL', sql => 1, filter => $strsth2 };
 127         $debug and warn "catalogue_out SQL: " . $strsth2;
 128         my $sth2 = $dbh->prepare($strsth2);
 129         $sth2->execute;
 130
 131         while ( my ( $celvalue, $count ) = $sth2->fetchrow ) {
 132             ($celvalue) or $celvalue = 'UNKNOWN';
 133             $columns{$celvalue} = $count;
 134         }
 135     }
 136
 137     my %tables = ( map { $_ => [] } keys %columns );
 138
 139     # preparing calculation
 140     my @exe_args = ();
 141     my $query    = "
 142         SELECT items.barcode        as barcode,
 143                items.homebranch     as branch,
 144                items.itemcallnumber as itemcallnumber,
 145                biblio.title         as title,
 146                biblio.biblionumber  as biblionumber,
 147                biblio.author        as author";
 148     ($column) and $query .= ",\n$column as col ";
 149     $query .= "
 150         FROM items
 151         LEFT JOIN biblio      USING (biblionumber)
 152         LEFT JOIN     issues  USING (itemnumber)
 153         LEFT JOIN old_issues  USING (itemnumber)
 154           WHERE       issues.itemnumber IS NULL
 155            AND    old_issues.itemnumber IS NULL
 156         ";
 157     if ( $filters->[0] ) {
 158         $filters->[0] =~ s/\*/%/g;
 159         push @exe_args, $filters->[0];
 160         $query .= " AND items.homebranch LIKE ?";
 161     }
 162     if ( $filters->[1] ) {
 163         $filters->[1] =~ s/\*/%/g;
 164         push @exe_args, $filters->[1];
 165         $query .= " AND items.itype      LIKE ?";
 166     }
 167     if ($column) {
 168         $query .= " AND $column = ? GROUP BY items.itemnumber, $column ";
 169         # placeholder handled below
 170     }
 171     else {
 172         $query .= " GROUP BY items.itemnumber ";
 173     }
 174     $query .= " ORDER BY items.itemcallnumber DESC, barcode";
 175     $query .= " LIMIT 0,$limit" if ($limit);
 176     $debug and warn "SQL : $query";
 177
 178     # warn "SQL : $query";
 179     push @loopfilter, { crit => 'SQL', sql => 1, filter => $query };
 180     my $dbcalc = $dbh->prepare($query);
 181
 182     if ($column) {
 183         foreach ( sort keys %columns ) {
 184             # execute(@exe_args,$_) would fail when the array is empty
 185             # but @more_exe_args will work
 186             my (@more_exe_args) = @exe_args;
 187             push @more_exe_args, $_;
 188             $dbcalc->execute(@more_exe_args)
 189               or die "Query execute(@more_exe_args) failed: $query";
 190             while ( my $data = $dbcalc->fetchrow_hashref ) {
 191                 my $col = $data->{col} || 'NULL';
 192                 $tables{$col} or $tables{$col} = [];
 193                 push @{ $tables{$col} }, $data;
 194             }
 195         }
 196     }
 197     else {
 198         ( scalar @exe_args ) ? $dbcalc->execute(@exe_args) : $dbcalc->execute;
 199         while ( my $data = $dbcalc->fetchrow_hashref ) {
 200             my $col = $data->{col} || 'NULL';
 201             $tables{$col} or $tables{$col} = [];
 202             push @{ $tables{$col} }, $data;
 203         }
 204     }
 205
 206     foreach my $tablename ( sort keys %tables ) {
 207         my (@temptable);
 208         my $i = 0;
 209         foreach my $cell ( @{ $tables{$tablename} } ) {
 210             if ( 0 == $i++ and $debug ) {
 211                 my $dump = Dumper($cell);
 212                 $dump =~ s/\n/ /gs;
 213                 $dump =~ s/\s+/ /gs;
 214                 print STDERR "first cell for $tablename: $dump";
 215             }
 216             push @temptable, $cell;
 217         }
 218         my $count    = scalar(@temptable);
 219         my $allitems = $columns{$tablename};
 220         $globalline{total_looptable_count} += $count;
 221         $globalline{total_coltitle_count}  += $allitems;
 222         push @{ $globalline{looptables} },
 223           {
 224             looprow         => \@temptable,
 225             coltitle        => $tablename,
 226             coltitle_count  => $allitems,
 227             looptable_count => $count,
 228             looptable_first => ($count) ? $temptable[0]->{itemcallnumber} : '',
 229             looptable_last  => ($count) ? $temptable[-1]->{itemcallnumber} : '',
 230           };
 231     }
 232
 233     # the header of the table
 234     $globalline{loopfilter} = \@loopfilter;
 235     $globalline{limit}      = $limit;
 236     $globalline{column}     = $column;
 237     return [ ( \%globalline ) ];    # reference to array of reference to hash
 238 }
 239
 240 1;
 241 __END__
 242