bug 2543: follow-up patch
[koha.git] / reports / cat_issues_top.pl
1 #!/usr/bin/perl
2
3
4 # Copyright 2000-2002 Katipo Communications
5 #
6 # This file is part of Koha.
7 #
8 # Koha is free software; you can redistribute it and/or modify it under the
9 # terms of the GNU General Public License as published by the Free Software
10 # Foundation; either version 2 of the License, or (at your option) any later
11 # version.
12 #
13 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
14 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
15 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
16 #
17 # You should have received a copy of the GNU General Public License along with
18 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
19 # Suite 330, Boston, MA  02111-1307 USA
20
21 use strict;
22 use C4::Auth;
23 use CGI;
24 use C4::Context;
25 use C4::Branch; # GetBranches
26 use C4::Output;
27 use C4::Koha;
28 use C4::Circulation;
29 use C4::Reports;
30 use C4::Dates qw/format_date format_date_in_iso/;
31 use C4::Members;
32
33 =head1 NAME
34
35 plugin that shows a stats on borrowers
36
37 =head1 DESCRIPTION
38
39 =over 2
40
41 =cut
42
43 my $input = new CGI;
44 my $do_it=$input->param('do_it');
45 my $fullreportname = "reports/cat_issues_top.tmpl";
46 my $limit = $input->param("Limit");
47 my $column = $input->param("Criteria");
48 my @filters = $input->param("Filter");
49 $filters[0]=format_date_in_iso($filters[0]);
50 $filters[1]=format_date_in_iso($filters[1]);
51 my $output = $input->param("output");
52 my $basename = $input->param("basename");
53 my $mime = $input->param("MIME");
54 #warn "calcul : ".$calc;
55 my ($template, $borrowernumber, $cookie)
56     = get_template_and_user({template_name => $fullreportname,
57                 query => $input,
58                 type => "intranet",
59                 authnotrequired => 0,
60                 flagsrequired => { reports => 1},
61                 debug => 1,
62                 });
63 our $sep     = $input->param("sep");
64 $sep = "\t" if ($sep eq 'tabulation');
65 $template->param(do_it => $do_it,
66         DHTMLcalendar_dateformat => C4::Dates->DHTMLcalendar(),
67         );
68 if ($do_it) {
69 # Displaying results
70     my $results = calculate($limit, $column, \@filters);
71     if ($output eq "screen"){
72 # Printing results to screen
73         $template->param(mainloop => $results,
74                         limit => $limit);
75         output_html_with_http_headers $input, $cookie, $template->output;
76         exit(1);
77     } else {
78 # Printing to a csv file
79         print $input->header(-type => 'application/vnd.sun.xml.calc',
80                             -encoding    => 'utf-8',
81                             -attachment=>"$basename.csv",
82                             -filename=>"$basename.csv" );
83         my $cols = @$results[0]->{loopcol};
84         my $lines = @$results[0]->{looprow};
85 # header top-right
86         print @$results[0]->{line} ."/". @$results[0]->{column} .$sep;
87 # Other header
88         foreach my $col ( @$cols ) {
89             print $col->{coltitle}.$sep;
90         }
91         print "Total\n";
92 # Table
93         foreach my $line ( @$lines ) {
94             my $x = $line->{loopcell};
95             print $line->{rowtitle}.$sep;
96             foreach my $cell (@$x) {
97                 print $cell->{value}.$sep;
98             }
99             print $line->{totalrow};
100             print "\n";
101         }
102 # footer
103         print "TOTAL";
104         $cols = @$results[0]->{loopfooter};
105         foreach my $col ( @$cols ) {
106             print $sep.$col->{totalcol};
107         }
108         print $sep.@$results[0]->{total};
109         exit(1);
110     }
111 # Displaying choices
112 } else {
113     my $dbh = C4::Context->dbh;
114     my @values;
115     my %labels;
116     my %select;
117     my $req;
118     
119     my @mime = ( C4::Context->preference("MIME") );
120 #       foreach my $mime (@mime){
121 #               warn "".$mime;
122 #       }
123     
124     my $CGIextChoice=CGI::scrolling_list(
125                 -name     => 'MIME',
126                 -id       => 'MIME',
127                 -values   => \@mime,
128                 -size     => 1,
129                 -multiple => 0 );
130     
131     my $CGIsepChoice=GetDelimiterChoices;
132     #branch
133     my $branches = GetBranches;
134     my @branchloop;
135     foreach my $thisbranch (keys %$branches) {
136 #                       my $selected = 1 if $thisbranch eq $branch;
137             my %row =(value => $thisbranch,
138 #                                                                       selected => $selected,
139                                     branchname => $branches->{$thisbranch}->{'branchname'},
140                             );
141             push @branchloop, \%row;
142     }
143
144     #doctype
145     my $itemtypes = GetItemTypes;
146     my @itemtypeloop;
147     foreach my $thisitemtype (keys %$itemtypes) {
148 #                       my $selected = 1 if $thisbranch eq $branch;
149             my %row =(value => $thisitemtype,
150 #                                                                       selected => $selected,
151                                     description => $itemtypes->{$thisitemtype}->{'description'},
152                             );
153             push @itemtypeloop, \%row;
154     }
155     
156     #borcat
157     my ($codes,$labels) = GetborCatFromCatType(undef,undef);
158     my @borcatloop;
159     foreach my $thisborcat (sort keys %$labels) {
160 #                       my $selected = 1 if $thisbranch eq $branch;
161             my %row =(value => $thisborcat,
162 #                                                                       selected => $selected,
163                                     description => $labels->{$thisborcat},
164                             );
165             push @borcatloop, \%row;
166     }
167     
168     #Day
169     #Month
170     $template->param(
171                     CGIextChoice => $CGIextChoice,
172                     CGIsepChoice => $CGIsepChoice,
173                     branchloop =>\@branchloop,
174                     itemtypeloop =>\@itemtypeloop,
175                     borcatloop =>\@borcatloop,
176                     );
177 output_html_with_http_headers $input, $cookie, $template->output;
178 }
179
180
181
182
183 sub calculate {
184     my ($line, $column, $filters) = @_;
185     my @mainloop;
186     my @loopfooter;
187     my @loopcol;
188     my @loopline;
189     my @looprow;
190     my %globalline;
191     my $grantotal =0;
192 # extract parameters
193     my $dbh = C4::Context->dbh;
194
195 # Filters
196 # Checking filters
197 #
198     my @loopfilter;
199     for (my $i=0;$i<=6;$i++) {
200         my %cell;
201         if ( @$filters[$i] ) {
202             if (($i==1) and (@$filters[$i-1])) {
203                 $cell{err} = 1 if (@$filters[$i]<@$filters[$i-1]) ;
204             }
205             # format the dates filters, otherwise just fill as is
206             if ($i>=2) {
207                 $cell{filter} .= @$filters[$i];
208             } else {
209                 $cell{filter} .= format_date(@$filters[$i]);
210             }            $cell{crit} .="Issue From" if ($i==0);
211             $cell{crit} .="Issue To" if ($i==1);
212             $cell{crit} .="Return From" if ($i==2);
213             $cell{crit} .="Return To" if ($i==3);
214             $cell{crit} .="Branch" if ($i==4);
215             $cell{crit} .="Doc Type" if ($i==5);
216             $cell{crit} .="Bor Cat" if ($i==6);
217             $cell{crit} .="Day" if ($i==7);
218             $cell{crit} .="Month" if ($i==8);
219             $cell{crit} .="Year" if ($i==9);
220             push @loopfilter, \%cell;
221         }
222     }
223     my $colfield;
224     my $colorder;
225     if ($column){
226         $column = "old_issues.".$column if (($column=~/branchcode/) or ($column=~/timestamp/));
227         $column = "biblioitems.".$column if $column=~/itemtype/;
228         $column = "borrowers.".$column if $column=~/categorycode/;
229         my @colfilter ;
230         $colfilter[0] = @$filters[0] if ($column =~ /timestamp/ )  ;
231         $colfilter[1] = @$filters[1] if ($column =~ /timestamp/ )  ;
232         $colfilter[0] = @$filters[2] if ($column =~ /returndate/ )  ;
233         $colfilter[1] = @$filters[3] if ($column =~ /returndate/ )  ;
234         $colfilter[0] = @$filters[4] if ($column =~ /branch/ )  ;
235         $colfilter[0] = @$filters[5] if ($column =~ /itemtype/ )  ;
236         $colfilter[0] = @$filters[6] if ($column =~ /category/ )  ;
237     #   $colfilter[0] = @$filters[11] if ($column =~ /sort2/ ) ;
238         $colfilter[0] = @$filters[7] if ($column =~ /timestamp/ ) ;
239         $colfilter[0] = @$filters[8] if ($column =~ /timestamp/ ) ;
240         $colfilter[0] = @$filters[9] if ($column =~ /timestamp/ ) ;
241     #warn "filtre col ".$colfilter[0]." ".$colfilter[1];
242                                                 
243     # loop cols.
244         if ($column eq "Day") {
245             #Display by day
246             $column = "old_issues.timestamp";
247             $colfield .="dayname($column)";  
248             $colorder .="weekday($column)";
249         } elsif ($column eq "Month") {
250             #Display by Month
251             $column = "old_issues.timestamp";
252             $colfield .="monthname($column)";  
253             $colorder .="month($column)";  
254         } elsif ($column eq "Year") {
255             #Display by Year
256             $column = "old_issues.timestamp";
257             $colfield .="Year($column)";
258             $colorder .= $column;
259         } else {
260             $colfield .= $column;
261             $colorder .= $column;
262         }  
263         
264         my $strsth2;
265         $strsth2 .= "SELECT distinctrow $colfield 
266                      FROM `old_issues` 
267                      LEFT JOIN borrowers ON borrowers.borrowernumber=old_issues.borrowernumber 
268                      LEFT JOIN items ON old_issues.itemnumber=items.itemnumber 
269                      LEFT JOIN biblioitems  ON biblioitems.biblioitemnumber=items.biblioitemnumber 
270                      WHERE 1";
271         if (($column=~/timestamp/) or ($column=~/returndate/)){
272             if ($colfilter[1] and ($colfilter[0])){
273                 $strsth2 .= " and $column between '$colfilter[0]' and '$colfilter[1]' " ;
274             } elsif ($colfilter[1]) {
275                     $strsth2 .= " and $column < '$colfilter[1]' " ;
276             } elsif ($colfilter[0]) {
277                 $strsth2 .= " and $column > '$colfilter[0]' " ;
278             }
279         } elsif ($colfilter[0]) {
280             $colfilter[0] =~ s/\*/%/g;
281             $strsth2 .= " and $column LIKE '$colfilter[0]' " ;
282         }
283         $strsth2 .=" group by $colfield";
284         $strsth2 .=" order by $colorder";
285         warn "". $strsth2;
286         
287         my $sth2 = $dbh->prepare( $strsth2 );
288         if (( @colfilter ) and ($colfilter[1])){
289             $sth2->execute("'".$colfilter[0]."'","'".$colfilter[1]."'");
290         } elsif ($colfilter[0]) {
291             $sth2->execute($colfilter[0]);
292         } else {
293             $sth2->execute;
294         }
295         
296     
297         while (my ($celvalue) = $sth2->fetchrow) {
298             my %cell;
299             $cell{coltitle} = ($celvalue?$celvalue:"NULL");
300             push @loopcol, \%cell;
301         }
302     #   warn "fin des titres colonnes";
303     }
304     
305     my $i=0;
306 #       my @totalcol;
307     my $hilighted=-1;
308     
309     #Initialization of cell values.....
310     my @table;
311     
312 #       warn "init table";
313     for (my $i=1;$i<=$line;$i++) {
314         foreach my $col ( @loopcol ) {
315 #                       warn " init table : $row->{rowtitle} / $col->{coltitle} ";
316             $table[$i]->{($col->{coltitle})?$col->{coltitle}:"total"}->{'name'}=0;
317         }
318     }
319
320
321 # preparing calculation
322     my $strcalc ;
323     
324 # Processing average loanperiods
325     $strcalc .= "SELECT DISTINCT biblio.title, COUNT(biblio.biblionumber) AS RANK, biblio.biblionumber AS ID";
326     $strcalc .= " , $colfield " if ($colfield);
327     $strcalc .= " FROM `old_issues` 
328                   LEFT JOIN borrowers ON old_issues.borrowernumber=borrowers.borrowernumber 
329                   LEFT JOIN (items 
330                          LEFT JOIN biblioitems ON biblioitems.biblioitemnumber=items.biblioitemnumber) 
331                     ON items.itemnumber=old_issues.itemnumber 
332                   LEFT JOIN biblio ON (biblio.biblionumber=items.biblionumber) 
333                   WHERE 1";
334
335     @$filters[0]=~ s/\*/%/g if (@$filters[0]);
336     $strcalc .= " AND old_issues.timestamp > '" . @$filters[0] ."'" if ( @$filters[0] );
337     @$filters[1]=~ s/\*/%/g if (@$filters[1]);
338     $strcalc .= " AND old_issues.timestamp < '" . @$filters[1] ."'" if ( @$filters[1] );
339     @$filters[2]=~ s/\*/%/g if (@$filters[2]);
340     $strcalc .= " AND old_issues.returndate > '" . @$filters[2] ."'" if ( @$filters[2] );
341     @$filters[3]=~ s/\*/%/g if (@$filters[3]);
342     $strcalc .= " AND old_issues.returndate < '" . @$filters[3] ."'" if ( @$filters[3] );
343     @$filters[4]=~ s/\*/%/g if (@$filters[4]);
344     $strcalc .= " AND old_issues.branchcode like '" . @$filters[4] ."'" if ( @$filters[4] );
345     @$filters[5]=~ s/\*/%/g if (@$filters[5]);
346     $strcalc .= " AND biblioitems.itemtype like '" . @$filters[5] ."'" if ( @$filters[5] );
347     @$filters[6]=~ s/\*/%/g if (@$filters[6]);
348     $strcalc .= " AND borrowers.categorycode like '" . @$filters[6] ."'" if ( @$filters[6] );
349     @$filters[7]=~ s/\*/%/g if (@$filters[7]);
350     $strcalc .= " AND dayname(old_issues.timestamp) like '" . @$filters[7]."'" if (@$filters[7]);
351     @$filters[8]=~ s/\*/%/g if (@$filters[8]);
352     $strcalc .= " AND monthname(old_issues.timestamp) like '" . @$filters[8]."'" if (@$filters[8]);
353     @$filters[9]=~ s/\*/%/g if (@$filters[9]);
354     $strcalc .= " AND year(old_issues.timestamp) like '" . @$filters[9] ."'" if ( @$filters[9] );
355     
356     $strcalc .= " group by biblio.biblionumber";
357     $strcalc .= ", $colfield" if ($column);
358     $strcalc .= " order by RANK DESC";
359     $strcalc .= ", $colfield " if ($colfield);
360
361 #       my $max;
362 #       if (@loopcol) {
363 #               $max = $line*@loopcol;
364 #       } else { $max=$line;}
365 #       $strcalc .= " LIMIT 0,$max";
366     warn "SQL :". $strcalc;
367     
368     my $dbcalc = $dbh->prepare($strcalc);
369     $dbcalc->execute;
370 #       warn "filling table";
371     my $previous_col;
372     my %indice;
373     while (my  @data = $dbcalc->fetchrow) {
374         my ($row, $rank, $id, $col )=@data;
375         $col = "zzEMPTY" if (!defined($col));
376         $indice{$col}=1 if (not($indice{$col}));
377         $table[$indice{$col}]->{$col}->{'name'}=$row;
378         $table[$indice{$col}]->{$col}->{'count'}=$rank;
379         $table[$indice{$col}]->{$col}->{'link'}=$id;
380 #               warn " ".$i." ".$col. " ".$row;
381         $indice{$col}++;
382     }
383     
384     push @loopcol,{coltitle => "Global"} if not($column);
385     
386     for ($i=1; $i<=$line;$i++) {
387         my @loopcell;
388         warn " $i";
389         #@loopcol ensures the order for columns is common with column titles
390         # and the number matches the number of columns
391         my $colcount=0;
392         foreach my $col ( @loopcol ) {
393 #                       warn " colonne :$col->{coltitle}";
394             my $value;
395             my $count=0;
396             my $link;
397             if (@loopcol){
398                 $value =$table[$i]->{(($col->{coltitle} eq "NULL") or ($col->{coltitle} eq "Global"))?"zzEMPTY":$col->{coltitle}}->{'name'};
399                 $count =$table[$i]->{(($col->{coltitle} eq "NULL") or ($col->{coltitle} eq "Global"))?"zzEMPTY":$col->{coltitle}}->{'count'};
400                 $link =$table[$i]->{(($col->{coltitle} eq "NULL") or ($col->{coltitle} eq "Global"))?"zzEMPTY":$col->{coltitle}}->{'link'};
401             } else {
402                 $value =$table[$i]->{"zzEMPTY"}->{'name'};
403                 $count =$table[$i]->{"zzEMPTY"}->{'count'};
404                 $link =$table[$i]->{"zzEMPTY"}->{'link'};
405             }
406 #                       warn " ".$i ." value:$value count:$count reference:$link";
407             push @loopcell, {value => $value, count =>$count, reference => $link} ;
408         }
409         #warn "row : $row colcount:$colcount";
410         #my $total = $table[$i]->{totalrow}/$colcount if ($colcount>0);
411         push @looprow,{ 'rowtitle' => $i ,
412                         'loopcell' => \@loopcell,
413                         'hilighted' => ($hilighted >0),
414                         #'totalrow' => ($total)?sprintf("%.2f",$total):0
415                     };
416         $hilighted = -$hilighted;
417     }
418 #       
419             
420
421     # the header of the table
422     $globalline{loopfilter}=\@loopfilter;
423     # the core of the table
424     $globalline{looprow} = \@looprow;
425     $globalline{loopcol} = \@loopcol;
426 #       # the foot (totals by borrower type)
427     $globalline{loopfooter} = \@loopfooter;
428     $globalline{total}= $grantotal;
429     $globalline{line} = $line;
430     $globalline{column} = $column;
431     push @mainloop,\%globalline;
432     return \@mainloop;
433 }
434
435 1;