reports subdir - Dates.pm integration and warnings fixes.
[koha.git] / reports / catalogue_stats.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
30 =head1 NAME
31
32 plugin that shows a stats on borrowers
33
34 =head1 DESCRIPTION
35
36 =over 2
37
38 =cut
39
40 my $input = new CGI;
41 my $do_it=$input->param('do_it');
42 my $fullreportname = "reports/catalogue_stats.tmpl";
43 my $line = $input->param("Line");
44 my $column = $input->param("Column");
45 my @filters = $input->param("Filter");
46 my $deweydigits = $input->param("deweydigits");
47 my $lccndigits = $input->param("lccndigits");
48 my $cotedigits = $input->param("cotedigits");
49 my $output = $input->param("output");
50 my $basename = $input->param("basename");
51 my $mime = $input->param("MIME");
52 my $del = $input->param("sep");
53
54 my ($template, $borrowernumber, $cookie)
55         = get_template_and_user({template_name => $fullreportname,
56                                 query => $input,
57                                 type => "intranet",
58                                 authnotrequired => 0,
59                                 flagsrequired => {reports => 1},
60                                 debug => 1,
61                                 });
62 $template->param(do_it => $do_it);
63 if ($do_it) {
64         my $results = calculate($line, $column, $deweydigits, $lccndigits, $cotedigits, \@filters);
65         if ($output eq "screen"){
66                 $template->param(mainloop => $results);
67                 output_html_with_http_headers $input, $cookie, $template->output;
68                 exit(1);
69         } else {
70                 print $input->header(-type => 'application/vnd.sun.xml.calc',
71                                      -encoding    => 'utf-8',
72                                                          -attachment=>"$basename.csv",
73                                                          -name=>"$basename.csv" );
74                 my $cols = @$results[0]->{loopcol};
75                 my $lines = @$results[0]->{looprow};
76                 my $sep;
77                 $sep =C4::Context->preference("delimiter");
78                 print @$results[0]->{line} ."/". @$results[0]->{column} .$sep;
79                 foreach my $col ( @$cols ) {
80                         print $col->{coltitle}.$sep;
81                 }
82                 print "Total\n";
83                 foreach my $line ( @$lines ) {
84                         my $x = $line->{loopcell};
85                         print $line->{rowtitle}.$sep;
86                         foreach my $cell (@$x) {
87                                 print $cell->{value}.$sep;
88                         }
89                         print $line->{totalrow};
90                         print "\n";
91                 }
92                 print "TOTAL";
93                 $cols = @$results[0]->{loopfooter};
94                 foreach my $col ( @$cols ) {
95                         print $sep.$col->{totalcol};
96                 }
97                 print $sep.@$results[0]->{total};
98                 exit(1);
99         }
100 } else {
101         my $dbh = C4::Context->dbh;
102         my @values;
103         my %labels;
104         my $count=0;
105         my $req;
106         $req = $dbh->prepare("select count(dewey) from biblioitems ");
107         $req->execute;
108         my $hasdewey;
109         my @select;
110 #       push @select,"";
111         while (my ($value) =$req->fetchrow) {
112                 $hasdewey =1 if (($value>2) and (! $hasdewey));
113                 $count++ if (($value>2) and (! $hasdewey));
114 #               push @select, $value;
115         }
116 #       my $CGIdewey=CGI::scrolling_list( -name     => 'Filter',
117 #                               -id => 'Filter',
118 #                               -values   => \@select,
119 #                               -size     => 1,
120 #                               -multiple => 0 );
121         
122         $req = $dbh->prepare( "select count(lccn) from biblioitems ");
123         $req->execute;
124 #       undef @select;
125 #       push @select,"";
126         my $haslccn;
127         my $hlghtlccn;
128         while (my ($value) =$req->fetchrow) {
129                 $hlghtlccn = !($hasdewey);
130                 $haslccn =1 if (($value>2) and (! $haslccn));
131                 $count++ if (($value) and (! $haslccn));
132 #               push @select, $value;
133         }
134 #       my $CGIlccn=CGI::scrolling_list( -name     => 'Filter',
135 #                               -id => 'Filter',
136 #                               -values   => \@select,
137 #                               -size     => 1,
138 #                               -multiple => 0 );
139         
140         $req = $dbh->prepare("select count(itemcallnumber) from items");
141         $req->execute;
142 #       undef @select;
143 #       push @select,"";
144         my $hascote;
145         my $hlghtcote;
146         while (my ($value) =$req->fetchrow) {
147                 $hascote =1 if (($value>2) and (! $hascote));
148                 $count++ if (($value) and (! $hascote));
149                 $hlghtcote = (($hasdewey) and ($haslccn)) or (!($hasdewey) and !($haslccn));
150 #               push @select, $value;
151         }
152 #       my $CGIcote=CGI::scrolling_list( -name     => 'Filter',
153 #                               -id => 'Filter',
154 #                               -values   => \@select,
155 #                               -size     => 1,
156 #                               -multiple => 0 );
157         $count++;
158         my $hglghtDT =$count % 2;
159 #       warn "highlightDT ".$hglghtDT;
160         $count++;
161         my $hglghtPub =$count % 2;
162 #       warn "highlightPub ".$hglghtPub;
163         $count++;
164         my $hglghtPY =$count % 2;
165 #       warn "highlightPY ".$hglghtPY;
166         $count++;
167         my $hglghtHB =$count % 2;
168 #       warn "highlightHB ".$hglghtHB;
169         $count++;
170         my $hglghtLOC =$count % 2;
171 #       warn "highlightLOC ".$hglghtLOC;
172         
173         
174         $req = $dbh->prepare("select itemtype from itemtypes order by itemtype");
175         $req->execute;
176         undef @select;
177         push @select,"";
178         while (my ($value) =$req->fetchrow) {
179                 push @select, $value;
180         }
181         my $CGIitemtype=CGI::scrolling_list( -name     => 'Filter',
182                                 -id => 'itemtype',
183                                 -values   => \@select,
184                                 -size     => 1,
185                                 -multiple => 0 );
186         
187 #       $req = $dbh->prepare("select distinctrow left(publishercode,75) from biblioitems order by publishercode");
188 #       $req->execute;
189 #       undef @select;
190 #       push @select,"";
191 #       while (my ($value) =$req->fetchrow) {
192 #               push @select, $value;
193 #       }
194 #       my $CGIpublisher=CGI::scrolling_list( -name     => 'Filter',
195 #                               -id => 'Filter',
196 #                               -values   => \@select,
197 #                               -size     => 1,
198 #                               -multiple => 0 );
199
200         undef @select;
201         push @select,"";
202         my $branches=GetBranches();
203         my %select_branches;
204         $select_branches{""} = "";
205         foreach my $branch (keys %$branches) {
206                 push @select, $branch;
207                 $select_branches{$branch} = $branches->{$branch}->{'branchname'};
208         }
209         my $CGIbranch=CGI::scrolling_list( -name     => 'Filter',
210                                 -id => 'branch',
211                                 -values   => \@select,
212                                 -labels   => \%select_branches,
213                                 -size     => 1,
214                                 -multiple => 0 );
215         
216         $req = $dbh->prepare("select distinctrow location from items order by location");
217         $req->execute;
218         undef @select;
219         push @select,"";
220         while (my ($value) =$req->fetchrow) {
221                 push @select, $value;
222         }
223         my $CGIlocation=CGI::scrolling_list( -name     => 'Filter',
224                                 -id => 'location',
225                                 -values   => \@select,
226                                 -size     => 1,
227                                 -multiple => 0 );
228         
229         my @mime = ( C4::Context->preference("MIME") );
230         foreach my $mime (@mime){
231 #               warn "".$mime;
232         }
233         
234         my $CGIextChoice=CGI::scrolling_list(
235                                 -name => 'MIME',
236                                 -id => 'MIME',
237                                 -values   => \@mime,
238                                 -size     => 1,
239                                 -multiple => 0 );
240         
241         my @dels = ( C4::Context->preference("delimiter") );
242         my $CGIsepChoice=CGI::scrolling_list(
243                                 -name => 'sep',
244                                 -id => 'sep',
245                                 -values   => \@dels,
246                                 -size     => 1,
247                                 -multiple => 0 );
248         
249         $template->param(hasdewey=>$hasdewey,
250 #                                       CGIFromDeweyClass => $CGIdewey,
251 #                                       CGIToDeweyClass => $CGIdewey,
252                                         haslccn=> $haslccn,
253                                         hlghtlccn => $hlghtlccn,
254 #                                       CGIFromLoCClass => $CGIlccn,
255 #                                       CGIToLoCClass => $CGIlccn,
256                                         hascote=> $hascote,
257                                         hlghtcote => $hlghtcote,
258                                         hglghtDT => $hglghtDT,
259                                         hglghtPub => $hglghtPub,
260                                         hglghtPY => $hglghtPY,
261                                         hglghtHB => $hglghtHB,
262                                         hglghtLOC => $hglghtLOC,
263 #                                       CGIFromCoteClass => $CGIcote,
264 #                                       CGIToCoteClass => $CGIcote,
265                                         CGIItemType => $CGIitemtype,
266 #                                       CGIFromPublicationYear => $CGIpublicationyear,
267 #                                       CGIToPublicationYear => $CGIpublicationyear,
268 #                                       CGIPublisher => $CGIpublisher,
269                                         CGIBranch => $CGIbranch,
270                                         CGILocation => $CGIlocation,
271                                         CGIextChoice => $CGIextChoice,
272                                         CGIsepChoice => $CGIsepChoice
273                                         );
274
275 }
276 output_html_with_http_headers $input, $cookie, $template->output;
277
278
279
280 sub calculate {
281         my ($line, $column, $deweydigits, $lccndigits, $cotedigits, $filters) = @_;
282         my @mainloop;
283         my @loopfooter;
284         my @loopcol;
285         my @loopline;
286         my @looprow;
287         my %globalline;
288         my $grantotal =0;
289 # extract parameters
290         my $dbh = C4::Context->dbh;
291
292 # Filters
293 # Checking filters
294 #
295         my @loopfilter;
296         for (my $i=0;$i<=11;$i++) {
297                 my %cell;
298                 if ( @$filters[$i] ) {
299                         if ((($i==1) or ($i==3) or ($i==5) or ($i==9)) and (@$filters[$i-1])) {
300                                 $cell{err} = 1 if (@$filters[$i]<@$filters[$i-1]) ;
301                         }
302                         $cell{filter} .= @$filters[$i];
303                         $cell{crit} .="Dewey Classification From" if ($i==0);
304                         $cell{crit} .="Dewey Classification To" if ($i==1);
305                         $cell{crit} .="Lccn Classification From" if ($i==2);
306                         $cell{crit} .="Lccn Classification To" if ($i==3);
307                         $cell{crit} .="Cote Classification From" if ($i==4);
308                         $cell{crit} .="Cote Classification To" if ($i==5);
309                         $cell{crit} .="Document type" if ($i==6);
310                         $cell{crit} .="Publisher" if ($i==7);
311                         $cell{crit} .="Publication year From" if ($i==8);
312                         $cell{crit} .="Publication year To" if ($i==9);
313                         $cell{crit} .="Branch :" if ($i==10);
314                         $cell{crit} .="Location:" if ($i==11);
315                         push @loopfilter, \%cell;
316                 }
317         }
318         
319         my @linefilter;
320 #       warn "filtres ".@filters[0];
321 #       warn "filtres ".@filters[1];
322 #       warn "filtres ".@filters[2];
323 #       warn "filtres ".@filters[3];
324         
325         $linefilter[0] = @$filters[0] if ($line =~ /dewey/ )  ;
326         $linefilter[1] = @$filters[1] if ($line =~ /dewey/ )  ;
327         $linefilter[0] = @$filters[2] if ($line =~ /lccn/ )  ;
328         $linefilter[1] = @$filters[3] if ($line =~ /lccn/ )  ;
329         $linefilter[0] = @$filters[4] if ($line =~ /items.itemcallnumber/ )  ;
330         $linefilter[1] = @$filters[5] if ($line =~ /items.itemcallnumber/ )  ;
331         $linefilter[0] = @$filters[6] if ($line =~ /itemtype/ )  ;
332         $linefilter[0] = @$filters[7] if ($line =~ /publishercode/ ) ;
333         $linefilter[0] = @$filters[8] if ($line =~ /publicationyear/ ) ;
334         $linefilter[1] = @$filters[9] if ($line =~ /publicationyear/ ) ;
335         $linefilter[0] = @$filters[10] if ($line =~ /items.homebranch/ ) ;
336         $linefilter[0] = @$filters[11] if ($line =~ /items.location/ ) ;
337
338         my @colfilter ;
339         $colfilter[0] = @$filters[0] if ($column =~ /dewey/ )  ;
340         $colfilter[1] = @$filters[1] if ($column =~ /dewey/ )  ;
341         $colfilter[0] = @$filters[2] if ($column =~ /lccn/ )  ;
342         $colfilter[1] = @$filters[3] if ($column =~ /lccn/ )  ;
343         $colfilter[0] = @$filters[4] if ($column =~ /itemcallnumber/ )  ;
344         $colfilter[1] = @$filters[5] if ($column =~ /itemcallnumber/ )  ;
345         $colfilter[0] = @$filters[6] if ($column =~ /itemtype/ )  ;
346         $colfilter[0] = @$filters[7] if ($column =~ /publishercode/ ) ;
347         $colfilter[0] = @$filters[8] if ($column =~ /publicationyear/ ) ;
348         $colfilter[1] = @$filters[9] if ($column =~ /publicationyear/ ) ;
349         $colfilter[0] = @$filters[10] if ($column =~ /items.homebranch/ ) ;
350         $colfilter[0] = @$filters[11] if ($column =~ /items.location/ ) ;
351
352 # 1st, loop rows.
353         my $linefield;
354         if (($line =~/dewey/)  and ($deweydigits)) {
355                 $linefield .="left($line,$deweydigits)";
356         } elsif (($line=~/lccn/) and ($lccndigits)) {
357                 $linefield .="left($line,$lccndigits)";
358         } elsif (($line=~/items.itemcallnumber/) and ($cotedigits)) {
359                 $linefield .="left($line,$cotedigits)";
360         }else {
361                 $linefield .= $line;
362         }
363         
364         
365         my $strsth;
366         $strsth .= "select distinctrow $linefield from biblioitems left join items on (items.biblioitemnumber = biblioitems.biblioitemnumber) where $line is not null ";
367         if ( @linefilter ) {
368                 if ($linefilter[1]){
369                         $strsth .= " and $line >= ? " ;
370                         $strsth .= " and $line <= ? " ;
371                 } elsif ($linefilter[0]) {
372                         $linefilter[0] =~ s/\*/%/g;
373                         $strsth .= " and $line LIKE ? " ;
374                 }
375         }
376         $strsth .=" order by $linefield";
377         warn "". $strsth;
378         
379         my $sth = $dbh->prepare( $strsth );
380         if (( @linefilter ) and ($linefilter[1])){
381                 $sth->execute($linefilter[0],$linefilter[1]);
382         } elsif ($linefilter[0]) {
383                 $sth->execute($linefilter[0]);
384         } else {
385                 $sth->execute;
386         }
387         while ( my ($celvalue) = $sth->fetchrow) {
388                 my %cell;
389                 if ($celvalue) {
390                         $cell{rowtitle} = $celvalue;
391 #               } else {
392 #                       $cell{rowtitle} = "";
393                 }
394                 $cell{totalrow} = 0;
395                 push @loopline, \%cell;
396         }
397
398 # 2nd, loop cols.
399         my $colfield;
400         if (($column =~/dewey/)  and ($deweydigits)) {
401                 $colfield .="left($column,$deweydigits)";
402         }elsif (($column=~/lccn/) and ($lccndigits)) {
403                 $colfield .="left($column,$lccndigits)";
404         }elsif (($column=~/itemcallnumber/) and ($cotedigits)) {
405                 $colfield .="left($column,$cotedigits)";
406         }else {
407                 $colfield .= $column;
408         }
409         
410         my $strsth2;
411         $strsth2 .= "select distinctrow $colfield from biblioitems left join items on (items.biblioitemnumber = biblioitems.biblioitemnumber) where $column is not null ";
412         if (( @colfilter ) and ($colfilter[1])) {
413                 $strsth2 .= " and $column> ? and $column< ?";
414         }elsif ($colfilter[0]){
415                 $colfilter[0] =~ s/\*/%/g;
416                 $strsth2 .= " and $column LIKE ? ";
417         } 
418         $strsth2 .= " order by $colfield";
419         warn "". $strsth2;
420         my $sth2 = $dbh->prepare( $strsth2 );
421         if ((@colfilter) and ($colfilter[1])) {
422                 $sth2->execute($colfilter[0],$colfilter[1]);
423         } elsif ($colfilter[0]){
424                 $sth2->execute($colfilter[0]);
425         } else {
426                 $sth2->execute;
427         }
428         while (my ($celvalue) = $sth2->fetchrow) {
429                 my %cell;
430                 my %ft;
431                 if ($celvalue) {
432                         $cell{coltitle} = $celvalue;
433 #               } else {
434 #                       $cell{coltitle} = "";
435                 }
436                 $ft{totalcol} = 0;
437                 push @loopcol, \%cell;
438         }
439         
440
441         my $i=0;
442         my @totalcol;
443         my $hilighted=-1;
444         
445         #Initialization of cell values.....
446         my %table;
447 #       warn "init table";
448         foreach my $row ( @loopline ) {
449                 foreach my $col ( @loopcol ) {
450 #                       warn " init table : $row->{rowtitle} / $col->{coltitle} ";
451                         $table{$row->{rowtitle}}->{$col->{coltitle}}=0;
452                 }
453                 $table{$row->{rowtitle}}->{totalrow}=0;
454         }
455
456 # preparing calculation
457         my $strcalc .= "SELECT $linefield, $colfield, count( * ) FROM biblioitems LEFT JOIN  items ON (items.biblioitemnumber = biblioitems.biblioitemnumber) WHERE 1";
458         if (@$filters[0]){
459                 @$filters[0]=~ s/\*/%/g;
460                 $strcalc .= " AND dewey >" . @$filters[0] ."";
461         }
462         if (@$filters[1]){
463                 @$filters[1]=~ s/\*/%/g ;
464                 $strcalc .= " AND dewey <" . @$filters[1] ."";
465                 
466         }
467         if (@$filters[2]){
468                 @$filters[2]=~ s/\*/%/g ;
469                 $strcalc .= " AND lccn >" . @$filters[2] ."" ;
470         }
471         if (@$filters[3]){
472                 @$filters[3]=~ s/\*/%/g;
473                 $strcalc .= " AND lccn <" . @$filters[3] ."" ;
474         }
475         if (@$filters[4]){
476                 @$filters[4]=~ s/\*/%/g ;
477                 $strcalc .= " AND items.itemcallnumber >=" . $dbh->quote(@$filters[4]) ."" ;
478         }
479         
480         if (@$filters[5]){
481                 @$filters[5]=~ s/\*/%/g;
482                 $strcalc .= " AND items.itemcallnumber <=" . $dbh->quote(@$filters[5]) ."" ;
483         }
484         
485         if (@$filters[6]){
486                 @$filters[6]=~ s/\*/%/g;
487                 $strcalc .= " AND biblioitems.itemtype like '" . @$filters[6] ."'";
488         }
489         
490         if (@$filters[7]){
491                 @$filters[7]=~ s/\*/%/g;
492                 @$filters[7].="%" unless @$filters[7]=~/%/;
493                 $strcalc .= " AND biblioitems.publishercode like \"" . @$filters[7] ."\"";
494         }
495         if (@$filters[8]){
496                 @$filters[8]=~ s/\*/%/g;
497                 $strcalc .= " AND publicationyear >" . @$filters[8] ."" ;
498         }
499         if (@$filters[9]){
500                 @$filters[9]=~ s/\*/%/g;
501                 $strcalc .= " AND publicationyear <" . @$filters[9] ."";
502         }
503         if (@$filters[10]){
504                 @$filters[10]=~ s/\*/%/g;
505                 $strcalc .= " AND items.homebranch like '" . @$filters[10] ."'";
506         }
507         if (@$filters[11]){
508                 @$filters[11]=~ s/\*/%/g;
509                 $strcalc .= " AND items.location like '" . @$filters[11] ."'" if ( @$filters[11] );
510         }
511         
512         $strcalc .= " group by $linefield, $colfield order by $linefield,$colfield";
513         warn "". $strcalc;
514         my $dbcalc = $dbh->prepare($strcalc);
515         $dbcalc->execute;
516 #       warn "filling table";
517         
518         my $emptycol; 
519         while (my ($row, $col, $value) = $dbcalc->fetchrow) {
520 #               warn "filling table $row / $col / $value ";
521                 $emptycol = 1 if ($col eq undef);
522                 $col = "zzEMPTY" if ($col eq undef);
523                 $row = "zzEMPTY" if ($row eq undef);
524                 
525                 $table{$row}->{$col}+=$value;
526                 $table{$row}->{totalrow}+=$value;
527                 $grantotal += $value;
528         }
529
530 #       my %cell = {rowtitle => 'zzROWEMPTY'};
531 #       push @loopline,\%cell;
532 #       undef %cell;
533 #       my %cell;
534 #       %cell = {coltitle => "zzEMPTY"};
535         push @loopcol,{coltitle => "NULL"} if ($emptycol);
536         
537         foreach my $row ( sort keys %table ) {
538                 my @loopcell;
539                 #@loopcol ensures the order for columns is common with column titles
540                 # and the number matches the number of columns
541                 foreach my $col ( @loopcol ) {
542                         my $value =$table{$row}->{($col->{coltitle} eq "NULL")?"zzEMPTY":$col->{coltitle}};
543                         push @loopcell, {value => $value  } ;
544                 }
545                 push @looprow,{ 'rowtitle' => ($row eq "zzEMPTY")?"NULL":$row,
546                                                 'loopcell' => \@loopcell,
547                                                 'hilighted' => ($hilighted >0),
548                                                 'totalrow' => $table{$row}->{totalrow}
549                                         };
550                 $hilighted = -$hilighted;
551         }
552         
553 #       warn "footer processing";
554         foreach my $col ( @loopcol ) {
555                 my $total=0;
556                 foreach my $row ( @looprow ) {
557                         $total += $table{($row->{rowtitle} eq "NULL")?"zzEMPTY":$row->{rowtitle}}->{($col->{coltitle} eq "NULL")?"zzEMPTY":$col->{coltitle}};
558 #                       warn "value added ".$table{$row->{rowtitle}}->{$col->{coltitle}}. "for line ".$row->{rowtitle};
559                 }
560 #               warn "summ for column ".$col->{coltitle}."  = ".$total;
561                 push @loopfooter, {'totalcol' => $total};
562         }
563                         
564
565         # the header of the table
566         $globalline{loopfilter}=\@loopfilter;
567         # the core of the table
568         $globalline{looprow} = \@looprow;
569         $globalline{loopcol} = \@loopcol;
570 #       # the foot (totals by borrower type)
571         $globalline{loopfooter} = \@loopfooter;
572         $globalline{total}= $grantotal;
573         $globalline{line} = $line;
574         $globalline{column} = $column;
575         push @mainloop,\%globalline;
576         return \@mainloop;
577 }
578
579 1;