4 # Copyright 2000-2002 Katipo Communications
6 # This file is part of Koha.
8 # Koha is free software; you can redistribute it and/or modify it
9 # under the terms of the GNU General Public License as published by
10 # the Free Software Foundation; either version 3 of the License, or
11 # (at your option) any later version.
13 # Koha is distributed in the hope that it will be useful, but
14 # WITHOUT ANY WARRANTY; without even the implied warranty of
15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 # GNU General Public License for more details.
18 # You should have received a copy of the GNU General Public License
19 # along with Koha; if not, see <http://www.gnu.org/licenses>.
22 #use warnings; FIXME - Bug 2505
26 use C4::Branch; # GetBranches
31 use C4::Biblio qw/GetMarcSubfieldStructureFromKohaField/;
35 plugin that shows a stats on borrowers
43 my $fullreportname = "reports/catalogue_stats.tt";
44 my $do_it = $input->param('do_it');
45 my $line = $input->param("Line");
46 my $column = $input->param("Column");
47 my $cellvalue = $input->param("Cellvalue"); # one of 'items', 'biblios', 'deleteditems'
48 my @filters = $input->param("Filter");
49 my $deweydigits = $input->param("deweydigits");
50 my $lccndigits = $input->param("lccndigits");
51 my $cotedigits = $input->param("cotedigits");
52 my $output = $input->param("output");
53 my $basename = $input->param("basename");
54 our $sep = $input->param("sep");
55 $sep = "\t" if ($sep eq 'tabulation');
57 if(C4::Context->preference('item-level_itypes')) {
58 $item_itype = "items\.itype"
60 $item_itype = "itemtype";
62 if(C4::Context->preference('marcflavour') ne "UNIMARC" && ($line=~ /publicationyear/ )) {
63 $line = "copyrightdate";
65 if(C4::Context->preference('marcflavour') ne "UNIMARC" && ($column =~ /publicationyear/ )) {
66 $column = "copyrightdate";
69 my ($template, $borrowernumber, $cookie)
70 = get_template_and_user({template_name => $fullreportname,
74 flagsrequired => {reports => '*'},
77 $template->param(do_it => $do_it);
79 my $results = calculate( $line, $column, $cellvalue, $deweydigits, $lccndigits, $cotedigits, \@filters );
80 if ( $output eq "screen" ) {
81 $template->param( mainloop => $results );
82 output_html_with_http_headers $input, $cookie, $template->output;
86 -type => 'application/vnd.sun.xml.calc',
88 -attachment => "$basename.csv",
89 -name => "$basename.csv"
91 my $cols = @$results[0]->{loopcol};
92 my $lines = @$results[0]->{looprow};
93 print @$results[0]->{line} . "/" . @$results[0]->{column} . $sep;
94 foreach my $col (@$cols) {
95 print $col->{coltitle} . $sep;
98 foreach my $line (@$lines) {
99 my $x = $line->{loopcell};
100 print $line->{rowtitle} . $sep;
101 foreach my $cell (@$x) {
102 print $cell->{value} . $sep;
104 print $line->{totalrow};
108 $cols = @$results[0]->{loopfooter};
109 foreach my $col (@$cols) {
110 print $sep. $col->{totalcol};
112 print $sep. @$results[0]->{total};
116 my $dbh = C4::Context->dbh;
122 # FIXME: no such field "dewey"
123 # $req = $dbh->prepare("select count(dewey) from biblioitems ");
127 # (rch) biblioitems.lccn is mapped to lccn MARC21 010$a in default framework.
128 # This is not the LC Classification. It's the Control Number.
129 # So I'm just going to remove this bit. Call Number is handled in itemcallnumber.
132 # $req = $dbh->prepare( "select count(lccn) from biblioitems ");
135 # while (my ($value) =$req->fetchrow) {
136 # $hlghtlccn = !($hasdewey);
137 # $haslccn =1 if (($value>2) and (! $haslccn));
138 # $count++ if (($value) and (! $haslccn));
139 # push @select, $value;
142 # values => \@select,
145 # No need to test for data here. If you don't have itemcallnumbers, you probably know it.
146 # FIXME: Hardcoding to 5 chars on itemcallnum.
151 my $itemtypes = GetItemTypes( style => 'array' );
153 my $authvals = GetKohaAuthorisedValues("items.ccode");
155 foreach ( sort { $authvals->{$a} cmp $authvals->{$b} || $a cmp $b } keys %$authvals ) {
156 push @authvals, { code => $_, description => $authvals->{$_} };
159 my $locations = GetKohaAuthorisedValues("items.location");
161 foreach ( sort keys %$locations ) {
162 push @locations, { code => $_, description => "$_ - " . $locations->{$_} };
165 foreach my $kohafield (qw(items.notforloan items.materials)) {
166 my $subfield_structure = GetMarcSubfieldStructureFromKohaField($kohafield);
167 if($subfield_structure) {
169 my $avcategory = $subfield_structure->{authorised_value};
171 $avlist = GetAuthorisedValues($avcategory);
177 $kf."_label" => $subfield_structure->{liblibrarian},
178 $kf."_avlist" => $avlist
183 my @mime = ( map { +{type =>$_} } (split /[;:]/, 'CSV') ); # FIXME translation
186 hasdewey => $hasdewey,
189 itemtypes => $itemtypes,
190 CGIBranch => GetBranchesLoop( C4::Context->userenv->{'branch'} ),
191 locationloop => \@locations,
192 authvals => \@authvals,
193 CGIextChoice => \@mime,
194 CGIsepChoice => GetDelimiterChoices,
195 item_itype => $item_itype,
199 output_html_with_http_headers $input, $cookie, $template->output;
205 my ( $line, $column, $cellvalue, $deweydigits, $lccndigits, $cotedigits, $filters ) = @_;
213 my $barcodelike = @$filters[16];
214 my $barcodefilter = @$filters[17];
216 my $itemstable = ($cellvalue eq 'deleteditems') ? 'deleteditems' : 'items';
218 my $dbh = C4::Context->dbh;
220 # if barcodefilter is empty set as %
221 if ($barcodefilter) {
223 # Check if barcodefilter is "like" or "not like"
224 if ( !$barcodelike ) {
229 $barcodefilter =~ s/\*/%/g;
236 for ( my $i = 0 ; $i <= @$filters ; $i++ ) {
238 if ( defined @$filters[$i] and @$filters[$i] ne '' and $i != 15 ) {
239 if ( ( ( $i == 1 ) or ( $i == 3 ) or ( $i == 5 ) or ( $i == 9 ) ) and ( @$filters[ $i - 1 ] ) ) {
240 $cell{err} = 1 if ( @$filters[$i] < @$filters[ $i - 1 ] );
242 $cell{filter} .= @$filters[$i];
244 ( $i == 0 ) ? "Dewey Classification From"
245 : ( $i == 1 ) ? "Dewey Classification To"
246 : ( $i == 2 ) ? "Lccn Classification From"
247 : ( $i == 3 ) ? "Lccn Classification To"
248 : ( $i == 4 ) ? "Item CallNumber From"
249 : ( $i == 5 ) ? "Item CallNumber To"
250 : ( $i == 6 ) ? "Item type"
251 : ( $i == 7 ) ? "Publisher"
252 : ( $i == 8 ) ? "Publication year From"
253 : ( $i == 9 ) ? "Publication year To"
254 : ( $i == 10 ) ? "Library"
255 : ( $i == 11 ) ? "Shelving Location"
256 : ( $i == 12 ) ? "Collection Code"
257 : ( $i == 13 ) ? "Status"
258 : ( $i == 14 ) ? "Materials"
259 : ( $i == 16 and $filters->[15] == 0 ) ? "Barcode (not like)"
260 : ( $i == 16 and $filters->[15] == 1 ) ? "Barcode (like)"
261 : ( $i == 17 ) ? "Acquired date from"
262 : ( $i == 18 ) ? "Acquired date to"
263 : ( $i == 19 ) ? "Removed date from"
264 : ( $i == 20 ) ? "Removed date to"
267 push @loopfilter, \%cell;
271 @$filters[18] = C4::Dates->new(@$filters[18])->output('iso') if @$filters[18];
272 @$filters[19] = C4::Dates->new(@$filters[19])->output('iso') if @$filters[19];
273 @$filters[20] = C4::Dates->new(@$filters[20])->output('iso') if @$filters[20];
274 @$filters[21] = C4::Dates->new(@$filters[21])->output('iso') if @$filters[21];
277 $linefilter[0] = @$filters[0] if ( $line =~ /dewey/ );
278 $linefilter[1] = @$filters[1] if ( $line =~ /dewey/ );
279 $linefilter[0] = @$filters[2] if ( $line =~ /lccn/ );
280 $linefilter[1] = @$filters[3] if ( $line =~ /lccn/ );
281 $linefilter[0] = @$filters[4] if ( $line =~ /items\.itemcallnumber/ );
282 $linefilter[1] = @$filters[5] if ( $line =~ /items\.itemcallnumber/ );
283 if ( C4::Context->preference('item-level_itypes') ) {
284 $linefilter[0] = @$filters[6] if ( $line =~ /items\.itype/ );
286 $linefilter[0] = @$filters[6] if ( $line =~ /itemtype/ );
288 $linefilter[0] = @$filters[7] if ( $line =~ /publishercode/ );
289 $linefilter[0] = @$filters[8] if ( $line =~ /publicationyear/ );
290 $linefilter[1] = @$filters[9] if ( $line =~ /publicationyear/ );
292 $linefilter[0] = @$filters[10] if ( $line =~ /items\.homebranch/ );
293 $linefilter[0] = @$filters[11] if ( $line =~ /items\.location/ );
294 $linefilter[0] = @$filters[12] if ( $line =~ /items\.ccode/ );
295 $linefilter[0] = @$filters[13] if ( $line =~ /items\.notforloan/ );
296 $linefilter[0] = @$filters[14] if ( $line =~ /items\.materials/ );
297 $linefilter[0] = @$filters[17] if ( $line =~ /items\.dateaccessioned/ );
298 $linefilter[1] = @$filters[18] if ( $line =~ /items\.dateaccessioned/ );
299 $linefilter[0] = @$filters[19] if ( $line =~ /deleteditems\.timestamp/ );
300 $linefilter[1] = @$filters[20] if ( $line =~ /deleteditems\.timestamp/ );
303 $colfilter[0] = @$filters[0] if ( $column =~ /dewey/ );
304 $colfilter[1] = @$filters[1] if ( $column =~ /dewey/ );
305 $colfilter[0] = @$filters[2] if ( $column =~ /lccn/ );
306 $colfilter[1] = @$filters[3] if ( $column =~ /lccn/ );
307 $colfilter[0] = @$filters[4] if ( $column =~ /items\.itemcallnumber/ );
308 $colfilter[1] = @$filters[5] if ( $column =~ /items\.itemcallnumber/ );
309 if ( C4::Context->preference('item-level_itypes') ) {
310 $colfilter[0] = @$filters[6] if ( $column =~ /items\.itype/ );
312 $colfilter[0] = @$filters[6] if ( $column =~ /itemtype/ );
314 $colfilter[0] = @$filters[7] if ( $column =~ /publishercode/ );
315 $colfilter[0] = @$filters[8] if ( $column =~ /publicationyear/ );
316 $colfilter[1] = @$filters[9] if ( $column =~ /publicationyear/ );
317 $colfilter[0] = @$filters[10] if ( $column =~ /items\.homebranch/ );
318 $colfilter[0] = @$filters[11] if ( $column =~ /items\.location/ );
319 $colfilter[0] = @$filters[12] if ( $column =~ /items\.ccode/ );
320 $colfilter[0] = @$filters[13] if ( $column =~ /items\.notforloan/ );
321 $colfilter[0] = @$filters[14] if ( $column =~ /items\.materials/ );
322 $colfilter[0] = @$filters[17] if ( $column =~ /items.dateaccessioned/ );
323 $colfilter[1] = @$filters[18] if ( $column =~ /items\.dateaccessioned/ );
324 $colfilter[0] = @$filters[19] if ( $column =~ /deleteditems\.timestamp/ );
325 $colfilter[1] = @$filters[20] if ( $column =~ /deleteditems\.timestamp/ );
328 my $origline = $line;
329 $line =~ s/^items\./deleteditems./ if($cellvalue eq "deleteditems");
331 if ( ( $line =~ /dewey/ ) and ($deweydigits) ) {
332 $linefield = "left($line,$deweydigits)";
333 } elsif ( ( $line =~ /lccn/ ) and ($lccndigits) ) {
334 $linefield = "left($line,$lccndigits)";
335 } elsif ( ( $line =~ /itemcallnumber/ ) and ($cotedigits) ) {
336 $linefield = "left($line,$cotedigits)";
337 } elsif ( $line =~ /^deleteditems\.timestamp$/ ) {
338 $linefield = "DATE($line)";
343 my $strsth = "SELECT DISTINCTROW $linefield FROM $itemstable
344 LEFT JOIN biblioitems USING (biblioitemnumber)
345 LEFT JOIN biblio ON (biblioitems.biblionumber = biblio.biblionumber)
347 $strsth .= " AND barcode $not LIKE ? " if ($barcodefilter);
349 if ( $linefilter[1] ) {
350 $strsth .= " AND $line >= ? ";
351 $strsth .= " AND $line <= ? ";
352 } elsif ( defined $linefilter[0] and $linefilter[0] ne '' ) {
353 $linefilter[0] =~ s/\*/%/g;
354 $strsth .= " AND $line LIKE ? ";
357 $strsth .= " ORDER BY $linefield";
358 $debug and print STDERR "catalogue_stats SQL: $strsth\n";
360 my $sth = $dbh->prepare($strsth);
361 if ( $barcodefilter and (@linefilter) and ( $linefilter[1] ) ) {
362 $sth->execute( $barcodefilter, $linefilter[0], $linefilter[1] );
363 } elsif ( (@linefilter) and ( $linefilter[1] ) ) {
364 $sth->execute( $linefilter[0], $linefilter[1] );
365 } elsif ( $barcodefilter and $linefilter[0] ) {
366 $sth->execute( $barcodefilter, $linefilter[0] );
367 } elsif ( $linefilter[0] ) {
368 $sth->execute($linefilter[0]);
369 } elsif ($barcodefilter) {
370 $sth->execute($barcodefilter);
374 my $rowauthvals = GetKohaAuthorisedValues($origline);
375 while ( my ($celvalue) = $sth->fetchrow ) {
377 if (defined $celvalue and $celvalue ne '') {
378 if($rowauthvals and $rowauthvals->{$celvalue}) {
379 $cell{rowtitle} = $rowauthvals->{$celvalue};
381 $cell{rowtitle} = $celvalue;
383 $cell{value} = $celvalue;
386 $cell{rowtitle} = "NULL";
387 $cell{value} = "zzEMPTY";
390 push @loopline, \%cell;
394 my $origcolumn = $column;
395 $column =~ s/^items\./deleteditems./ if($cellvalue eq "deleteditems");
397 if ( ( $column =~ /dewey/ ) and ($deweydigits) ) {
398 $colfield = "left($column,$deweydigits)";
399 } elsif ( ( $column =~ /lccn/ ) and ($lccndigits) ) {
400 $colfield = "left($column,$lccndigits)";
401 } elsif ( ( $column =~ /itemcallnumber/ ) and ($cotedigits) ) {
402 $colfield = "left($column,$cotedigits)";
403 } elsif ( $column =~ /^deleteditems\.timestamp$/ ) {
404 $colfield = "DATE($column)";
410 SELECT distinctrow $colfield
412 LEFT JOIN biblioitems
413 USING (biblioitemnumber)
415 ON (biblioitems.biblionumber = biblio.biblionumber)
417 $strsth2 .= " AND barcode $not LIKE ?" if $barcodefilter;
419 if ( (@colfilter) and ( $colfilter[1] ) ) {
420 $strsth2 .= " AND $column >= ? AND $column <= ?";
421 } elsif ( defined $colfilter[0] and $colfilter[0] ne '' ) {
422 $colfilter[0] =~ s/\*/%/g;
423 $strsth2 .= " AND $column LIKE ? ";
425 $strsth2 .= " ORDER BY $colfield";
426 $debug and print STDERR "SQL: $strsth2";
427 my $sth2 = $dbh->prepare($strsth2);
428 if ( $barcodefilter and (@colfilter) and ( $colfilter[1] ) ) {
429 $sth2->execute( $barcodefilter, $colfilter[0], $colfilter[1] );
430 } elsif ( (@colfilter) and ( $colfilter[1] ) ) {
431 $sth2->execute( $colfilter[0], $colfilter[1] );
432 } elsif ( $barcodefilter && $colfilter[0] ) {
433 $sth2->execute( $barcodefilter , $colfilter[0] );
434 } elsif ( $colfilter[0]) {
435 $sth2->execute( $colfilter[0] );
436 } elsif ($barcodefilter) {
437 $sth2->execute($barcodefilter);
441 my $colauthvals = GetKohaAuthorisedValues($origcolumn);
442 while ( my ($celvalue) = $sth2->fetchrow ) {
444 if (defined $celvalue and $celvalue ne '') {
445 if($colauthvals and $colauthvals->{$celvalue}) {
446 $cell{coltitle} = $colauthvals->{$celvalue};
448 $cell{coltitle} = $celvalue;
450 $cell{value} = $celvalue;
453 $cell{coltitle} = "NULL";
454 $cell{value} = "zzEMPTY";
457 push @loopcol, \%cell;
464 #Initialization of cell values.....
467 foreach my $row (@loopline) {
468 foreach my $col (@loopcol) {
469 $table{ $row->{value} }->{ $col->{value} } = 0;
471 $table{ $row->{value} }->{totalrow} = 0;
474 # preparing calculation
475 my $select_cellvalue = " COUNT(*) ";
476 $select_cellvalue = " COUNT(DISTINCT biblioitems.biblionumber) " if($cellvalue eq 'biblios');
478 SELECT $linefield, $colfield, $select_cellvalue
480 LEFT JOIN biblioitems ON ($itemstable.biblioitemnumber = biblioitems.biblioitemnumber)
481 LEFT JOIN biblio ON (biblioitems.biblionumber = biblio.biblionumber)
483 $strcalc .= "AND barcode $not like ? " if ($barcodefilter);
485 if ( @$filters[0] ) {
486 @$filters[0] =~ s/\*/%/g;
487 $strcalc .= " AND dewey >" . @$filters[0];
489 if ( @$filters[1] ) {
490 @$filters[1] =~ s/\*/%/g;
491 $strcalc .= " AND dewey <" . @$filters[1];
493 if ( @$filters[2] ) {
494 @$filters[2] =~ s/\*/%/g;
495 $strcalc .= " AND lccn >" . @$filters[2];
497 if ( @$filters[3] ) {
498 @$filters[3] =~ s/\*/%/g;
499 $strcalc .= " AND lccn <" . @$filters[3];
501 if ( @$filters[4] ) {
502 @$filters[4] =~ s/\*/%/g;
503 $strcalc .= " AND $itemstable.itemcallnumber >=" . $dbh->quote( @$filters[4] );
506 if ( @$filters[5] ) {
507 @$filters[5] =~ s/\*/%/g;
508 $strcalc .= " AND $itemstable.itemcallnumber <=" . $dbh->quote( @$filters[5] );
511 if ( @$filters[6] ) {
512 @$filters[6] =~ s/\*/%/g;
513 $strcalc .= " AND " . ( C4::Context->preference('item-level_itypes') ? "$itemstable.itype" : 'biblioitems.itemtype' ) . " LIKE '" . @$filters[6] . "'";
516 if ( @$filters[7] ) {
517 @$filters[7] =~ s/\*/%/g;
518 @$filters[7] .= "%" unless @$filters[7] =~ /%/;
519 $strcalc .= " AND biblioitems.publishercode LIKE \"" . @$filters[7] . "\"";
521 if ( @$filters[8] ) {
522 @$filters[8] =~ s/\*/%/g;
523 $strcalc .= " AND " .
524 (C4::Context->preference('marcflavour') eq 'UNIMARC' ? 'publicationyear' : 'copyrightdate')
525 . ">" . @$filters[8];
527 if ( @$filters[9] ) {
528 @$filters[9] =~ s/\*/%/g;
529 $strcalc .= " AND " .
530 (C4::Context->preference('marcflavour') eq 'UNIMARC' ? 'publicationyear' : 'copyrightdate')
531 . "<" . @$filters[9];
533 if ( @$filters[10] ) {
534 @$filters[10] =~ s/\*/%/g;
535 $strcalc .= " AND $itemstable.homebranch LIKE '" . @$filters[10] . "'";
537 if ( @$filters[11] ) {
538 @$filters[11] =~ s/\*/%/g;
539 $strcalc .= " AND $itemstable.location LIKE '" . @$filters[11] . "'";
541 if ( @$filters[12] ) {
542 @$filters[12] =~ s/\*/%/g;
543 $strcalc .= " AND $itemstable.ccode LIKE '" . @$filters[12] . "'";
545 if ( defined @$filters[13] and @$filters[13] ne '' ) {
546 @$filters[13] =~ s/\*/%/g;
547 $strcalc .= " AND $itemstable.notforloan LIKE '" . @$filters[13] . "'";
549 if ( defined @$filters[14] and @$filters[14] ne '' ) {
550 @$filters[14] =~ s/\*/%/g;
551 $strcalc .= " AND $itemstable.materials LIKE '" . @$filters[14] . "'";
553 if ( @$filters[17] ) {
554 @$filters[17] =~ s/\*/%/g;
555 $strcalc .= " AND $itemstable.dateaccessioned >= '@$filters[17]' ";
557 if ( @$filters[18] ) {
558 @$filters[18] =~ s/\*/%/g;
559 $strcalc .= " AND $itemstable.dateaccessioned <= '@$filters[18]' ";
561 if ( $cellvalue eq 'deleteditems' and @$filters[19] ) {
562 @$filters[19] =~ s/\*/%/g;
563 $strcalc .= " AND DATE(deleteditems.timestamp) >= '@$filters[19]' ";
565 if ( $cellvalue eq 'deleteditems' and @$filters[20] ) {
566 @$filters[20] =~ s/\*/%/g;
567 $strcalc .= " AND DATE(deleteditems.timestamp) <= '@$filters[20]' ";
569 $strcalc .= " group by $linefield, $colfield order by $linefield,$colfield";
570 $debug and warn "SQL: $strcalc";
571 my $dbcalc = $dbh->prepare($strcalc);
572 if ($barcodefilter) {
573 $dbcalc->execute($barcodefilter);
578 while ( my ( $row, $col, $value ) = $dbcalc->fetchrow ) {
580 $col = "zzEMPTY" if ( !defined($col) );
581 $row = "zzEMPTY" if ( !defined($row) );
583 $table{$row}->{$col} += $value;
584 $table{$row}->{totalrow} += $value;
585 $grantotal += $value;
588 foreach my $row ( @loopline ) {
591 #@loopcol ensures the order for columns is common with column titles
592 # and the number matches the number of columns
593 foreach my $col (@loopcol) {
594 my $value = $table{$row->{value}}->{ $col->{value} };
595 push @loopcell, { value => $value };
598 { 'rowtitle' => $row->{rowtitle},
599 'value' => $row->{value},
600 'loopcell' => \@loopcell,
601 'hilighted' => ( $hilighted *= -1 > 0 ),
602 'totalrow' => $table{$row->{value}}->{totalrow}
606 foreach my $col (@loopcol) {
608 foreach my $row (@looprow) {
609 $total += $table{ $row->{value} }->{ $col->{value} };
612 push @loopfooter, { 'totalcol' => $total };
615 # the header of the table
616 $globalline{loopfilter} = \@loopfilter;
618 # the core of the table
619 $globalline{looprow} = \@looprow;
620 $globalline{loopcol} = \@loopcol;
622 # the foot (totals by borrower type)
623 $globalline{loopfooter} = \@loopfooter;
624 $globalline{total} = $grantotal;
625 $globalline{line} = $line;
626 $globalline{column} = $column;
627 push @mainloop, \%globalline;