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 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
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.
17 # You should have received a copy of the GNU General Public License along
18 # with Koha; if not, write to the Free Software Foundation, Inc.,
19 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
22 #use warnings; FIXME - Bug 2505
26 use C4
::Branch
; # GetBranches
31 use C4
::Dates qw
/format_date format_date_in_iso/;
32 use Date
::Calc
qw(Delta_Days);
36 plugin that shows a stats on borrowers
45 my $do_it=$input->param('do_it');
46 my $fullreportname = "reports/issues_avg_stats.tmpl";
47 my $line = $input->param("Line");
48 my $column = $input->param("Column");
49 my @filters = $input->param("Filter");
50 $filters[0]=format_date_in_iso
($filters[0]);
51 $filters[1]=format_date_in_iso
($filters[1]);
52 $filters[2]=format_date_in_iso
($filters[2]);
53 $filters[3]=format_date_in_iso
($filters[3]);
54 my $podsp = $input->param("IssueDisplay");
55 my $rodsp = $input->param("ReturnDisplay");
56 my $calc = $input->param("Cellvalue");
57 my $output = $input->param("output");
58 my $basename = $input->param("basename");
59 #warn "calcul : ".$calc;
60 my ($template, $borrowernumber, $cookie)
61 = get_template_and_user
({template_name
=> $fullreportname,
65 flagsrequired
=> {reports
=> '*'},
68 our $sep = $input->param("sep");
69 $sep = "\t" if ($sep eq 'tabulation');
70 $template->param(do_it
=> $do_it,
74 my $results = calculate
($line, $column, $rodsp, $podsp, $calc, \
@filters);
75 if ($output eq "screen"){
76 # Printing results to screen
77 $template->param(mainloop
=> $results);
78 output_html_with_http_headers
$input, $cookie, $template->output;
81 # Printing to a csv file
82 print $input->header(-type
=> 'application/vnd.sun.xml.calc',
84 -attachment
=>"$basename.csv",
85 -filename
=>"$basename.csv" );
86 my $cols = @
$results[0]->{loopcol
};
87 my $lines = @
$results[0]->{looprow
};
89 print @
$results[0]->{line
} ."/". @
$results[0]->{column
} .$sep;
91 foreach my $col ( @
$cols ) {
92 print $col->{coltitle
}.$sep;
96 foreach my $line ( @
$lines ) {
97 my $x = $line->{loopcell
};
98 print $line->{rowtitle
}.$sep;
99 foreach my $cell (@
$x) {
100 print $cell->{value
}.$sep;
102 print $line->{totalrow
};
107 $cols = @
$results[0]->{loopfooter
};
108 foreach my $col ( @
$cols ) {
109 print $sep.$col->{totalcol
};
111 print $sep.@
$results[0]->{total
};
116 my $dbh = C4
::Context
->dbh;
121 $req = $dbh->prepare("select distinctrow categorycode,description from categories order by description");
126 while (my ($value, $desc) =$req->fetchrow) {
127 push @select, $value;
128 $select{$value}=$desc;
130 my $CGIBorCat=CGI
::scrolling_list
( -name
=> 'Filter',
137 $req = $dbh->prepare( "select distinctrow itemtype,description from itemtypes order by description");
143 while (my ($value,$desc) =$req->fetchrow) {
144 push @select, $value;
145 $select{$value}=$desc;
147 my $CGIItemTypes=CGI
::scrolling_list
( -name
=> 'Filter',
154 $req = $dbh->prepare("select distinctrow sort1 from borrowers where sort1 is not null order by sort1");
159 while (my ($value) =$req->fetchrow) {
160 $hassort1 =1 if ($value);
161 push @select, $value;
163 my $branches=GetBranches
();
166 push @select_branch,"";
167 $select_branches{""} = "";
168 foreach my $branch (keys %$branches) {
169 push @select_branch, $branch;
170 $select_branches{$branch} = $branches->{$branch}->{'branchname'};
172 my $CGIBranch=CGI
::scrolling_list
( -name
=> 'Filter',
174 -values => \
@select_branch,
175 -labels
=> \
%select_branches,
179 my $CGISort1=CGI
::scrolling_list
( -name
=> 'Filter',
185 $req = $dbh->prepare("select distinctrow sort2 from borrowers where sort2 is not null order by sort2");
191 while (my ($value) =$req->fetchrow) {
192 $hassort2 =1 if ($value);
193 $hglghtsort2= !($hassort1);
194 push @select, $value;
196 my $CGISort2=CGI
::scrolling_list
( -name
=> 'Filter',
202 my $CGIextChoice=CGI
::scrolling_list
(
205 -values => ['CSV'], # FIXME translation
209 my $CGIsepChoice=GetDelimiterChoices
;
212 CGIBorCat
=> $CGIBorCat,
213 CGIItemType
=> $CGIItemTypes,
214 CGIBranch
=> $CGIBranch,
215 hassort1
=> $hassort1,
216 hassort2
=> $hassort2,
217 HlghtSort2
=> $hglghtsort2,
218 CGISort1
=> $CGISort1,
219 CGISort2
=> $CGISort2,
220 CGIextChoice
=> $CGIextChoice,
221 CGIsepChoice
=> $CGIsepChoice
223 output_html_with_http_headers
$input, $cookie, $template->output;
230 my ($line, $column, $rodsp, $podsp, $process, $filters) = @_;
239 my $dbh = C4
::Context
->dbh;
245 for (my $i=0;$i<=6;$i++) {
247 if ( @
$filters[$i] ) {
248 if (($i==1) and (@
$filters[$i-1])) {
249 $cell{err
} = 1 if (@
$filters[$i]<@
$filters[$i-1]) ;
251 # format the dates filters, otherwise just fill as is
253 $cell{filter
} .= @
$filters[$i];
255 $cell{filter
} .= format_date
(@
$filters[$i]);
257 $cell{crit
} .="Issue From" if ($i==0);
258 $cell{crit
} .="Issue To" if ($i==1);
259 $cell{crit
} .="Issue Month" if ($i==2);
260 $cell{crit
} .="Issue Day" if ($i==3);
261 $cell{crit
} .="Return From" if ($i==4);
262 $cell{crit
} .="Return To" if ($i==5);
263 $cell{crit
} .="Return Month" if ($i==6);
264 $cell{crit
} .="Return Day" if ($i==7);
265 $cell{crit
} .="Borrower Cat" if ($i==8);
266 $cell{crit
} .="Doc Type" if ($i==9);
267 $cell{crit
} .="Branch" if ($i==10);
268 $cell{crit
} .="Sort1" if ($i==11);
269 $cell{crit
} .="Sort2" if ($i==12);
270 push @loopfilter, \
%cell;
273 push @loopfilter,{crit
=>"Issue Display",filter
=>$rodsp} if ($rodsp);
274 push @loopfilter,{crit
=>"Return Display",filter
=>$podsp} if ($podsp);
279 # warn "filtres ".@filters[0];
280 # warn "filtres ".@filters[1];
281 # warn "filtres ".@filters[2];
282 # warn "filtres ".@filters[3];
283 $line = "old_issues.".$line if ($line=~/branchcode/) or ($line=~/timestamp/);
284 $line = "biblioitems.".$line if $line=~/itemtype/;
286 $linefilter[0] = @
$filters[0] if ($line =~ /timestamp/ ) ;
287 $linefilter[1] = @
$filters[1] if ($line =~ /timestamp/ ) ;
288 $linefilter[2] = @
$filters[2] if ($line =~ /timestamp/ ) ;
289 $linefilter[3] = @
$filters[3] if ($line =~ /timestamp/ ) ;
290 $linefilter[0] = @
$filters[4] if ($line =~ /returndate/ ) ;
291 $linefilter[1] = @
$filters[5] if ($line =~ /returndate/ ) ;
292 $linefilter[2] = @
$filters[6] if ($line =~ /returndate/ ) ;
293 $linefilter[3] = @
$filters[7] if ($line =~ /returndate/ ) ;
294 $linefilter[0] = @
$filters[8] if ($line =~ /category/ ) ;
295 $linefilter[0] = @
$filters[9] if ($line =~ /itemtype/ ) ;
296 $linefilter[0] = @
$filters[10] if ($line =~ /branch/ ) ;
297 # $linefilter[0] = @$filters[11] if ($line =~ /sort2/ ) ;
298 $linefilter[0] = @
$filters[11] if ($line =~ /sort1/ ) ;
299 $linefilter[0] = @
$filters[12] if ($line =~ /sort2/ ) ;
300 #warn "filtre lignes".$linefilter[0]." ".$linefilter[1];
302 $column = "old_issues.".$column if (($column=~/branchcode/) or ($column=~/timestamp/));
303 $column = "biblioitems.".$column if $column=~/itemtype/;
305 $colfilter[0] = @
$filters[0] if ($column =~ /timestamp/ ) ;
306 $colfilter[1] = @
$filters[1] if ($column =~ /timestamp/ ) ;
307 $colfilter[2] = @
$filters[2] if ($column =~ /timestamp/ ) ;
308 $colfilter[3] = @
$filters[3] if ($column =~ /timestamp/ ) ;
309 $colfilter[0] = @
$filters[4] if ($column =~ /returndate/ ) ;
310 $colfilter[1] = @
$filters[5] if ($column =~ /returndate/ ) ;
311 $colfilter[2] = @
$filters[6] if ($column =~ /returndate/ ) ;
312 $colfilter[3] = @
$filters[7] if ($column =~ /returndate/ ) ;
313 $colfilter[0] = @
$filters[8] if ($column =~ /category/ ) ;
314 $colfilter[0] = @
$filters[9] if ($column =~ /itemtype/ ) ;
315 $colfilter[0] = @
$filters[10] if ($column =~ /branch/ ) ;
316 # $colfilter[0] = @$filters[11] if ($column =~ /sort2/ ) ;
317 $colfilter[0] = @
$filters[11] if ($column =~ /sort1/ ) ;
318 $colfilter[0] = @
$filters[12] if ($column =~ /sort2/ ) ;
319 #warn "filtre col ".$colfilter[0]." ".$colfilter[1];
324 if ((($line =~/timestamp/) and ($podsp == 1)) or (($line =~/returndate/) and ($rodsp == 1))) {
326 $linefield .="dayname($line)";
327 $lineorder .="weekday($line)";
328 } elsif ((($line =~/timestamp/) and ($podsp == 2)) or (($line =~/returndate/) and ($rodsp == 2))) {
330 $linefield .="monthname($line)";
331 $lineorder .="month($line)";
332 } elsif ((($line =~/timestamp/) and ($podsp == 3)) or (($line =~/returndate/) and ($rodsp == 3))) {
334 $linefield .="Year($line)";
336 } elsif (($line=~/timestamp/) or ($line=~/returndate/)){
337 $linefield .= "date_format(\'$line\',\"%Y-%m-%d\")";
345 $strsth .= "select distinctrow $linefield
347 LEFT JOIN borrowers ON borrowers.borrowernumber=old_issues.borrowernumber
348 LEFT JOIN items ON old_issues.itemnumber=items.itemnumber
349 LEFT JOIN biblioitems ON (biblioitems.biblioitemnumber=items.biblioitemnumber)
350 LEFT JOIN issuingrules ON
351 (issuingrules.branchcode=old_issues.branchcode
352 AND issuingrules.itemtype=biblioitems.itemtype
353 AND issuingrules.categorycode=borrowers.categorycode)
356 if (($line=~/timestamp/) or ($line=~/returndate/)){
357 if ($linefilter[1] and ($linefilter[0])){
358 $strsth .= " AND $line BETWEEN '$linefilter[0]' AND '$linefilter[1]' " ;
359 } elsif ($linefilter[1]) {
360 $strsth .= " AND $line < \'$linefilter[1]\' " ;
361 } elsif ($linefilter[0]) {
362 $strsth .= " AND $line > \'$linefilter[0]\' " ;
365 $strsth .= " AND dayname($line) = '$linefilter[2]' " ;
368 $strsth .= " AND monthname($line) = '$linefilter[3]' " ;
370 } elsif ($linefilter[0]) {
371 $linefilter[0] =~ s/\*/%/g;
372 $strsth .= " AND $line LIKE '$linefilter[0]' " ;
374 $strsth .=" GROUP BY $linefield";
375 $strsth .=" ORDER BY $lineorder";
377 my $sth = $dbh->prepare( $strsth );
381 while ( my ($celvalue) = $sth->fetchrow) {
384 $cell{rowtitle
} = $celvalue;
386 $cell{rowtitle
} = "";
389 push @loopline, \
%cell;
395 if ((($column =~/timestamp/) and ($podsp == 1)) or (($column =~/returndate/) and ($rodsp == 1))) {
397 $colfield .="dayname($column)";
398 $colorder .="weekday($column)";
399 } elsif ((($column =~/timestamp/) and ($podsp == 2)) or (($column =~/returndate/) and ($rodsp == 2))) {
401 $colfield .="monthname($column)";
402 $colorder .="month($column)";
403 } elsif ((($column =~/timestamp/) and ($podsp == 3)) or (($column =~/returndate/) and ($rodsp == 3))) {
405 $colfield .="Year($column)";
406 $colorder .= $column;
407 } elsif (($column=~/timestamp/) or ($column=~/returndate/)){
408 $colfield .= 'date_format( '."'".$column."'". ', "%Y-%m-%d")';
409 $colorder .= $column;
411 $colfield .= $column;
412 $colorder .= $column;
416 $strsth2 .= "SELECT distinctrow $colfield
418 LEFT JOIN borrowers ON borrowers.borrowernumber=old_issues.borrowernumber
419 LEFT JOIN items ON items.itemnumber=old_issues.itemnumber
420 LEFT JOIN biblioitems ON (biblioitems.biblioitemnumber=items.biblioitemnumber)
421 LEFT JOIN issuingrules ON
422 (issuingrules.branchcode=old_issues.branchcode
423 AND issuingrules.itemtype=biblioitems.itemtype
424 AND issuingrules.categorycode=borrowers.categorycode)
427 if (($column=~/timestamp/) or ($column=~/returndate/)){
428 if ($colfilter[1] and ($colfilter[0])){
429 $strsth2 .= " AND $column BETWEEN '$colfilter[0]' AND '$colfilter[1]' " ;
430 } elsif ($colfilter[1]) {
431 $strsth2 .= " AND $column < '$colfilter[1]' " ;
432 } elsif ($colfilter[0]) {
433 $strsth2 .= " AND $column > '$colfilter[0]' " ;
436 $strsth2 .= " AND dayname($column) = '$colfilter[2]' " ;
439 $strsth2 .= " AND monthname($column) = '$colfilter[3]' " ;
441 } elsif ($colfilter[0]) {
442 $colfilter[0] =~ s/\*/%/g;
443 $strsth2 .= " AND $column LIKE '$colfilter[0]' " ;
445 $strsth2 .=" GROUP BY $colfield";
446 $strsth2 .=" ORDER BY $colorder";
448 my $sth2 = $dbh->prepare( $strsth2 );
449 if (( @colfilter ) and ($colfilter[1])){
450 $sth2->execute("'".$colfilter[0]."'","'".$colfilter[1]."'");
451 } elsif ($colfilter[0]) {
452 $sth2->execute($colfilter[0]);
458 while (my ($celvalue) = $sth2->fetchrow) {
461 # warn "coltitle :".$celvalue;
462 $cell{coltitle
} = $celvalue;
464 push @loopcol, \
%cell;
466 # warn "fin des titres colonnes";
472 #Initialization of cell values.....
478 foreach my $row ( @loopline ) {
479 foreach my $col ( @loopcol ) {
480 # warn " init table : $row->{rowtitle} / $col->{coltitle} ";
481 $table{$row->{rowtitle
}}->{$col->{coltitle
}}=0;
483 $table{$row->{rowtitle
}}->{totalrow
}=0;
486 # preparing calculation
489 # Processing average loanperiods
490 $strcalc .= "SELECT $linefield, $colfield, ";
491 $strcalc .= " issuedate, returndate, old_issues.timestamp, COUNT(*), date_due, old_issues.renewals, issuelength FROM `old_issues`,borrowers,biblioitems LEFT JOIN items ON (biblioitems.biblioitemnumber=items.biblioitemnumber) LEFT JOIN issuingrules ON (issuingrules.branchcode=branchcode AND issuingrules.itemtype=biblioitems.itemtype AND issuingrules.categorycode=categorycode) WHERE old_issues.itemnumber=items.itemnumber AND old_issues.borrowernumber=borrowers.borrowernumber";
493 @
$filters[0]=~ s/\*/%/g if (@
$filters[0]);
494 $strcalc .= " AND old_issues.timestamp > '" . @
$filters[0] ."'" if ( @
$filters[0] );
495 @
$filters[1]=~ s/\*/%/g if (@
$filters[1]);
496 $strcalc .= " AND old_issues.timestamp < '" . @
$filters[1] ."'" if ( @
$filters[1] );
497 @
$filters[4]=~ s/\*/%/g if (@
$filters[4]);
498 $strcalc .= " AND old_issues.returndate > '" . @
$filters[4] ."'" if ( @
$filters[4] );
499 @
$filters[5]=~ s/\*/%/g if (@
$filters[5]);
500 $strcalc .= " AND old_issues.returndate < '" . @
$filters[5] ."'" if ( @
$filters[5] );
501 @
$filters[8]=~ s/\*/%/g if (@
$filters[8]);
502 $strcalc .= " AND borrowers.categorycode like '" . @
$filters[8] ."'" if ( @
$filters[8] );
503 @
$filters[9]=~ s/\*/%/g if (@
$filters[9]);
504 $strcalc .= " AND biblioitems.itemtype like '" . @
$filters[9] ."'" if ( @
$filters[9] );
505 @
$filters[10]=~ s/\*/%/g if (@
$filters[10]);
506 $strcalc .= " AND old_issues.branchcode like '" . @
$filters[10] ."'" if ( @
$filters[10] );
507 @
$filters[11]=~ s/\*/%/g if (@
$filters[11]);
508 $strcalc .= " AND borrowers.sort1 like '" . @
$filters[11] ."'" if ( @
$filters[11] );
509 @
$filters[12]=~ s/\*/%/g if (@
$filters[12]);
510 $strcalc .= " AND borrowers.sort2 like '" . @
$filters[12] ."'" if ( @
$filters[12] );
511 $strcalc .= " AND dayname(timestamp) like '" . @
$filters[2]."'" if (@
$filters[2]);
512 $strcalc .= " AND monthname(timestamp) like '" . @
$filters[3] ."'" if ( @
$filters[3] );
513 $strcalc .= " AND dayname(returndate) like '" . @
$filters[5]."'" if (@
$filters[5]);
514 $strcalc .= " AND monthname(returndate) like '" . @
$filters[6] ."'" if ( @
$filters[6] );
516 $strcalc .= " group by $linefield, $colfield, issuedate, returndate order by $linefield, $colfield";
518 my $dbcalc = $dbh->prepare($strcalc);
520 # warn "filling table";
529 while (my @data = $dbcalc->fetchrow) {
530 my ($row, $col, $issuedate, $returndate, $weight)=@data;
531 # warn "filling table $row / $col / $issuedate / $returndate /$weight";
532 $emptycol=1 if (!defined($col));
533 $col = "zzEMPTY" if (!defined($col));
534 $row = "zzEMPTY" if (!defined($row));
535 # fill returndate to avoid an error with date calc (needed for all non returned issues)
536 $returndate= join '-',Date
::Calc
::Today
if $returndate eq '0000-00-00';
537 # DateCalc returns => 0:0:WK:DD:HH:MM:SS the weeks, days, hours, minutes,
538 # and seconds between the two
539 $loanlength = Delta_Days
(split(/-/,$issuedate),split (/-/,$returndate)) ;
540 # warn "512 Same row and col DateCalc returns :$loanlength with return ". $returndate ."issue ". $issuedate ."weight : ". $weight;
541 # warn "513 row :".$row." column :".$col;
542 $table{$row}->{$col}+=$weight*$loanlength;
543 # $table{$row}->{totalrow}+=$weight*$loanlength;
544 $cnttable{$row}->{$col}= 1;
545 $wgttable{$row}->{$col}+=$weight;
548 push @loopcol,{coltitle
=> "NULL"} if ($emptycol);
550 foreach my $row ( sort keys %table ) {
552 #@loopcol ensures the order for columns is common with column titles
553 # and the number matches the number of columns
555 foreach my $col ( @loopcol ) {
558 ( ( $col->{coltitle
} eq 'NULL' )
559 or ( $col->{coltitle
} eq q{} )
560 ) ?
'zzEMPTY' : $col->{coltitle
}
563 $value = $table{$row}->{
564 ( ( $col->{coltitle
} eq 'NULL' )
565 or ( $col->{coltitle
} eq q{} )
566 ) ?
'zzEMPTY' : $col->{coltitle
}
567 } / $wgttable{$row}->{
568 ( ( $col->{coltitle
} eq 'NULL' )
569 or ( $col->{coltitle
} eq q{} )
570 ) ?
'zzEMPTY' : $col->{coltitle
}
573 $table{$row}->{(($col->{coltitle
} eq "NULL")or ($col->{coltitle
} eq ""))?
"zzEMPTY":$col->{coltitle
}} = $value;
574 $table{$row}->{totalrow
}+=$value;
575 #warn "row : $row col:$col $cnttable{$row}->{(($col->{coltitle} eq \"NULL\")or ($col->{coltitle} eq \"\"))?\"zzEMPTY\":$col->{coltitle}}";
576 $colcount+=$cnttable{$row}->{(($col->{coltitle
} eq "NULL")or ($col->{coltitle
} eq ""))?
"zzEMPTY":$col->{coltitle
}};
577 push @loopcell, {value
=> ($value)?
sprintf("%.2f",$value):0 } ;
579 #warn "row : $row colcount:$colcount";
581 if ( $colcount > 0 ) {
582 $total = $table{$row}->{totalrow
} / $colcount;
585 { 'rowtitle' => ( $row eq "zzEMPTY" ) ?
"NULL" : $row,
586 'loopcell' => \
@loopcell,
587 'hilighted' => ( $hilighted > 0 ),
588 'totalrow' => ($total) ?
sprintf( "%.2f", $total ) : 0
590 $hilighted = -$hilighted;
593 # # warn "footer processing";
594 foreach my $col ( @loopcol ) {
597 foreach my $row ( @looprow ) {
598 $total += $cnttable{($row->{rowtitle
} eq "NULL")?
"zzEMPTY":$row->{rowtitle
}}->{($col->{coltitle
} eq "NULL")?
"zzEMPTY":$col->{coltitle
}}*$table{($row->{rowtitle
} eq "NULL")?
"zzEMPTY":$row->{rowtitle
}}->{($col->{coltitle
} eq "NULL")?
"zzEMPTY":$col->{coltitle
}};
599 $nbrow +=$cnttable{($row->{rowtitle
} eq "NULL")?
"zzEMPTY":$row->{rowtitle
}}->{($col->{coltitle
} eq "NULL")?
"zzEMPTY":$col->{coltitle
}};;
600 # warn "value added ".$table{$row->{rowtitle}}->{$col->{coltitle}}. "for line ".$row->{rowtitle};
602 # warn "summ for column ".$col->{coltitle}." = ".$total;
603 $total = $total/$nbrow if ($nbrow);
604 push @loopfooter, {'totalcol' => ($total)?
sprintf("%.2f",$total):0};
609 # the header of the table
610 $globalline{loopfilter
}=\
@loopfilter;
611 # the core of the table
612 $globalline{looprow
} = \
@looprow;
613 $globalline{loopcol
} = \
@loopcol;
614 # # the foot (totals by borrower type)
615 $globalline{loopfooter
} = \
@loopfooter;
616 $globalline{total
}= $grantotal;
617 $globalline{line
} = $line;
618 $globalline{column
} = $column;
619 push @mainloop,\
%globalline;