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