Bug 28572: Remove C4::Debug
[koha.git] / 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 Modern::Perl;
21 use CGI qw ( -utf8 );
22
23 use C4::Auth;
24 use C4::Context;
25 use C4::Output;
26 # use Date::Manip;  # TODO: add not borrowed since date X criteria
27 use Data::Dumper;
28
29 =head1 catalogue_out
30
31 Report that shows unborrowed items.
32
33 =cut
34
35 my $input   = CGI->new;
36 my $do_it   = $input->param('do_it');
37 my $limit   = $input->param("Limit") || 10;
38 my $column  = $input->param("Criteria");
39 my @filters = $input->multi_param("Filter");
40
41 my ( $template, $borrowernumber, $cookie ) = get_template_and_user(
42     {
43         template_name   => "reports/catalogue_out.tt",
44         query           => $input,
45         type            => "intranet",
46         flagsrequired   => { reports => 'execute_reports' },
47     }
48 );
49
50 $template->param( do_it => $do_it );
51 if ($do_it) {
52     my $results = calculate( $limit, $column, \@filters );
53     $template->param( mainloop => $results );
54     output_html_with_http_headers $input, $cookie, $template->output;
55     exit;    # in either case, exit after do_it
56 }
57
58 my $itemtypes = Koha::ItemTypes->search_with_localization;
59 $template->param(
60     itemtypes => $itemtypes,
61 );
62 output_html_with_http_headers $input, $cookie, $template->output;
63
64 sub calculate {
65     my ( $limit, $column, $filters ) = @_;
66     my %globalline;
67     my %columns = ();
68     my $dbh     = C4::Context->dbh;
69
70     # Filters
71     # Checking filters
72     #
73     my @loopfilter;
74     for ( my $i = 0 ; $i <= 6 ; $i++ ) {
75         if ( @$filters[$i] ) {
76             my %cell = ( filter => @$filters[$i] );
77             if ( ( $i == 1 ) and ( @$filters[ $i - 1 ] ) ) {
78                 $cell{err} = 1 if ( @$filters[$i] < @$filters[ $i - 1 ] );
79             }
80             $cell{crit} = "Branch"   if ( $i == 0 );
81             $cell{crit} = "Doc Type" if ( $i == 1 );
82             push @loopfilter, \%cell;
83         }
84     }
85     push @loopfilter, { crit => 'limit', filter => $limit } if ($limit);
86     if ($column) {
87         push @loopfilter, { crit => 'by', filter => $column };
88         my $tablename = ( $column =~ /branchcode/ ) ? 'branches' : 'items';
89         $column =
90           ( $column =~ /branchcode/ or $column =~ /itype/ )
91           ? "$tablename.$column"
92           : $column;
93         my $strsth2 =
94           ( $tablename eq 'branches' )
95           ? "SELECT $column as coltitle, count(items.itemnumber) AS coltitle_count FROM $tablename LEFT JOIN items ON items.homebranch=$column "
96           : "SELECT $column as coltitle, count(*)                AS coltitle_count FROM $tablename ";
97         if ( $tablename eq 'branches' ) {
98             my $f = @$filters[0];
99             $f =~ s/\*/%/g;
100             $strsth2 .= " AND $column LIKE '$f' ";
101         }
102         $strsth2 .= " GROUP BY $column ORDER BY $column ";    # needed for count
103         push @loopfilter, { crit => 'SQL', sql => 1, filter => $strsth2 };
104         my $sth2 = $dbh->prepare($strsth2);
105         $sth2->execute;
106
107         while ( my ( $celvalue, $count ) = $sth2->fetchrow ) {
108             ($celvalue) or $celvalue = 'UNKNOWN';
109             $columns{$celvalue} = $count;
110         }
111     }
112
113     my %tables = ( map { $_ => [] } keys %columns );
114
115     # preparing calculation
116     my @exe_args = ();
117     my $query    = "
118         SELECT items.barcode        as barcode,
119                items.homebranch     as branch,
120                items.itemcallnumber as itemcallnumber,
121                biblio.title         as title,
122                biblio.biblionumber  as biblionumber,
123                biblio.author        as author";
124     ($column) and $query .= ",\n$column as col ";
125     $query .= "
126         FROM items
127         LEFT JOIN biblio      USING (biblionumber)
128         LEFT JOIN     issues  USING (itemnumber)
129         LEFT JOIN old_issues  USING (itemnumber)
130           WHERE       issues.itemnumber IS NULL
131            AND    old_issues.itemnumber IS NULL
132         ";
133     if ( $filters->[0] ) {
134         $filters->[0] =~ s/\*/%/g;
135         push @exe_args, $filters->[0];
136         $query .= " AND items.homebranch LIKE ?";
137     }
138     if ( $filters->[1] ) {
139         $filters->[1] =~ s/\*/%/g;
140         push @exe_args, $filters->[1];
141         $query .= " AND items.itype      LIKE ?";
142     }
143     if ($column) {
144         $query .= " AND $column = ? GROUP BY items.itemnumber, $column ";
145         # placeholder handled below
146     }
147     else {
148         $query .= " GROUP BY items.itemnumber ";
149     }
150     $query .= " ORDER BY items.itemcallnumber DESC, barcode";
151     $query .= " LIMIT 0,$limit" if ($limit);
152
153     push @loopfilter, { crit => 'SQL', sql => 1, filter => $query };
154     my $dbcalc = $dbh->prepare($query);
155
156     if ($column) {
157         foreach ( sort keys %columns ) {
158             # execute(@exe_args,$_) would fail when the array is empty
159             # but @more_exe_args will work
160             my (@more_exe_args) = @exe_args;
161             push @more_exe_args, $_;
162             $dbcalc->execute(@more_exe_args)
163               or die "Query execute(@more_exe_args) failed: $query";
164             while ( my $data = $dbcalc->fetchrow_hashref ) {
165                 my $col = $data->{col} || 'NULL';
166                 $tables{$col} or $tables{$col} = [];
167                 push @{ $tables{$col} }, $data;
168             }
169         }
170     }
171     else {
172         ( scalar @exe_args ) ? $dbcalc->execute(@exe_args) : $dbcalc->execute;
173         while ( my $data = $dbcalc->fetchrow_hashref ) {
174             my $col = $data->{col} || 'NULL';
175             $tables{$col} or $tables{$col} = [];
176             push @{ $tables{$col} }, $data;
177         }
178     }
179
180     foreach my $tablename ( sort keys %tables ) {
181         my (@temptable);
182         my $i = 0;
183         foreach my $cell ( @{ $tables{$tablename} } ) {
184             push @temptable, $cell;
185         }
186         my $count    = scalar(@temptable);
187         my $allitems = $columns{$tablename};
188         $globalline{total_looptable_count} += $count;
189         $globalline{total_coltitle_count}  += $allitems;
190         push @{ $globalline{looptables} },
191           {
192             looprow         => \@temptable,
193             coltitle        => $tablename,
194             coltitle_count  => $allitems,
195             looptable_count => $count,
196             looptable_first => ($count) ? $temptable[0]->{itemcallnumber} : '',
197             looptable_last  => ($count) ? $temptable[-1]->{itemcallnumber} : '',
198           };
199     }
200
201     # the header of the table
202     $globalline{loopfilter} = \@loopfilter;
203     $globalline{limit}      = $limit;
204     $globalline{column}     = $column;
205     return [ ( \%globalline ) ];    # reference to array of reference to hash
206 }
207
208 1;
209 __END__
210